aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/src/Input.hs19
-rw-r--r--compiler/src/Resource.hs19
2 files changed, 19 insertions, 19 deletions
diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs
index 95d8132..cb837e3 100644
--- a/compiler/src/Input.hs
+++ b/compiler/src/Input.hs
@@ -30,11 +30,12 @@ import Data.Function ((&))
30import Data.Maybe (catMaybes) 30import Data.Maybe (catMaybes)
31import Data.Bool (bool) 31import Data.Bool (bool)
32import Data.List (find) 32import Data.List (find)
33import Data.Time.Clock (UTCTime)
33import Data.Time.LocalTime (ZonedTime) 34import Data.Time.LocalTime (ZonedTime)
34import Data.Yaml (ParseException, decodeFileEither) 35import Data.Yaml (ParseException, decodeFileEither)
35import Data.Aeson (FromJSON) 36import Data.Aeson (FromJSON)
36import System.FilePath (isExtensionOf, dropExtension) 37import System.FilePath (isExtensionOf, dropExtension)
37import System.Directory (doesFileExist) 38import System.Directory (doesFileExist, getModificationTime)
38 39
39import Files 40import Files
40 41
@@ -52,9 +53,11 @@ decodeYamlFile path =
52data InputTree = 53data InputTree =
53 InputFile 54 InputFile
54 { path :: Path 55 { path :: Path
56 , modTime :: UTCTime
55 , sidecar :: Sidecar } 57 , sidecar :: Sidecar }
56 | InputDir 58 | InputDir
57 { path :: Path 59 { path :: Path
60 , modTime :: UTCTime
58 , dirThumbnailPath :: Maybe Path 61 , dirThumbnailPath :: Maybe Path
59 , items :: [InputTree] } 62 , items :: [InputTree] }
60 deriving Show 63 deriving Show
@@ -91,18 +94,20 @@ readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root
91 mkInputNode :: FSNode -> IO (Maybe InputTree) 94 mkInputNode :: FSNode -> IO (Maybe InputTree)
92 mkInputNode file@File{path} 95 mkInputNode file@File{path}
93 | (not $ isSidecar file) && (not $ isThumbnail file) = 96 | (not $ isSidecar file) && (not $ isThumbnail file) =
94 readSidecarFile (localPath $ anchor /> path <.> sidecarExt) 97 do
95 >>= return . InputFile path 98 sidecar <- readSidecarFile $ localPath (anchor /> path <.> sidecarExt)
96 >>= return . Just 99 modTime <- getModificationTime $ localPath (anchor /> path)
100 return $ Just $ InputFile path modTime sidecar
97 mkInputNode File{} = return Nothing 101 mkInputNode File{} = return Nothing
98 mkInputNode dir@Dir{} = mkDirNode dir >>= return . Just 102 mkInputNode dir@Dir{} = mkDirNode dir >>= return . Just
99 103
100 mkDirNode :: FSNode -> IO InputTree 104 mkDirNode :: FSNode -> IO InputTree
101 mkDirNode File{} = throw $ AssertionFailed "Input directory is a file" 105 mkDirNode File{} = throw $ AssertionFailed "Input directory is a file"
102 mkDirNode Dir{path, items} = 106 mkDirNode Dir{path, items} =
103 mapM mkInputNode items 107 do
104 >>= return . catMaybes 108 dirItems <- mapM mkInputNode items
105 >>= return . InputDir path (findThumbnail items) 109 modTime <- getModificationTime $ localPath (anchor /> path)
110 return $ InputDir path modTime (findThumbnail items) (catMaybes dirItems)
106 111
107 isSidecar :: FSNode -> Bool 112 isSidecar :: FSNode -> Bool
108 isSidecar Dir{} = False 113 isSidecar Dir{} = False
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 29906b7..79fe354 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -30,8 +30,8 @@ import Data.Char (toLower)
30import Data.Maybe (mapMaybe, fromMaybe) 30import Data.Maybe (mapMaybe, fromMaybe)
31import Data.Function ((&)) 31import Data.Function ((&))
32import qualified Data.Set as Set 32import qualified Data.Set as Set
33import Data.Time.Clock (UTCTime)
33import Data.Time.LocalTime (ZonedTime, utc, utcToZonedTime, zonedTimeToUTC) 34import Data.Time.LocalTime (ZonedTime, utc, utcToZonedTime, zonedTimeToUTC)
34import System.Directory (getModificationTime)
35import Safe.Foldable (maximumByMay) 35import Safe.Foldable (maximumByMay)
36 36
37import GHC.Generics (Generic) 37import GHC.Generics (Generic)
@@ -102,14 +102,13 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
102 mkGalleryItem (Just galleryName) (Path []) inputTree 102 mkGalleryItem (Just galleryName) (Path []) inputTree
103 where 103 where
104 mkGalleryItem :: Maybe String -> Path -> InputTree -> IO GalleryItem 104 mkGalleryItem :: Maybe String -> Path -> InputTree -> IO GalleryItem
105 mkGalleryItem _ parents InputFile{path, sidecar} = 105 mkGalleryItem _ parents InputFile{path, modTime, sidecar} =
106 do 106 do
107 properties <- processItem path 107 properties <- processItem path
108 processedThumbnail <- processThumbnail path 108 processedThumbnail <- processThumbnail path
109 fileModTime <- lastModTime path
110 return GalleryItem 109 return GalleryItem
111 { title = itemTitle 110 { title = itemTitle
112 , datetime = fromMaybe fileModTime $ Input.datetime sidecar 111 , datetime = fromMaybe (toZonedTime modTime) (Input.datetime sidecar)
113 , description = optMeta description "" 112 , description = optMeta description ""
114 , tags = (optMeta tags []) ++ implicitParentTags parents 113 , tags = (optMeta tags []) ++ implicitParentTags parents
115 , path = parents </ itemTitle 114 , path = parents </ itemTitle
@@ -122,14 +121,13 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
122 optMeta :: (Sidecar -> Maybe a) -> a -> a 121 optMeta :: (Sidecar -> Maybe a) -> a -> a
123 optMeta get fallback = fromMaybe fallback $ get sidecar 122 optMeta get fallback = fromMaybe fallback $ get sidecar
124 123
125 mkGalleryItem rootTitle parents InputDir{path, dirThumbnailPath, items} = 124 mkGalleryItem rootTitle parents InputDir{path, modTime, dirThumbnailPath, items} =
126 do 125 do
127 processedThumbnail <- maybeThumbnail dirThumbnailPath 126 processedThumbnail <- maybeThumbnail dirThumbnailPath
128 processedItems <- parallel $ map (mkGalleryItem Nothing itemPath) items 127 processedItems <- parallel $ map (mkGalleryItem Nothing itemPath) items
129 dirModTime <- lastModTime path
130 return GalleryItem 128 return GalleryItem
131 { title = itemTitle 129 { title = itemTitle
132 , datetime = fromMaybe dirModTime $ mostRecentChildModTime processedItems 130 , datetime = fromMaybe (toZonedTime modTime) (mostRecentChildModTime processedItems)
133 , description = "" 131 , description = ""
134 , tags = (aggregateChildTags processedItems) ++ implicitParentTags parents 132 , tags = (aggregateChildTags processedItems) ++ implicitParentTags parents
135 , path = itemPath 133 , path = itemPath
@@ -162,11 +160,8 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
162 implicitParentTags :: Path -> [Tag] 160 implicitParentTags :: Path -> [Tag]
163 implicitParentTags (Path elements) = take tagsFromDirectories elements 161 implicitParentTags (Path elements) = take tagsFromDirectories elements
164 162
165 lastModTime :: Path -> IO ZonedTime 163 toZonedTime :: UTCTime -> ZonedTime
166 lastModTime path = 164 toZonedTime = utcToZonedTime utc
167 localPath path
168 & getModificationTime
169 >>= return . utcToZonedTime utc
170 165
171 166
172flattenGalleryTree :: GalleryItem -> [GalleryItem] 167flattenGalleryTree :: GalleryItem -> [GalleryItem]