diff options
-rw-r--r-- | compiler/src/Input.hs | 19 | ||||
-rw-r--r-- | compiler/src/Resource.hs | 19 |
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 ((&)) | |||
30 | import Data.Maybe (catMaybes) | 30 | import Data.Maybe (catMaybes) |
31 | import Data.Bool (bool) | 31 | import Data.Bool (bool) |
32 | import Data.List (find) | 32 | import Data.List (find) |
33 | import Data.Time.Clock (UTCTime) | ||
33 | import Data.Time.LocalTime (ZonedTime) | 34 | import Data.Time.LocalTime (ZonedTime) |
34 | import Data.Yaml (ParseException, decodeFileEither) | 35 | import Data.Yaml (ParseException, decodeFileEither) |
35 | import Data.Aeson (FromJSON) | 36 | import Data.Aeson (FromJSON) |
36 | import System.FilePath (isExtensionOf, dropExtension) | 37 | import System.FilePath (isExtensionOf, dropExtension) |
37 | import System.Directory (doesFileExist) | 38 | import System.Directory (doesFileExist, getModificationTime) |
38 | 39 | ||
39 | import Files | 40 | import Files |
40 | 41 | ||
@@ -52,9 +53,11 @@ decodeYamlFile path = | |||
52 | data InputTree = | 53 | data 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) | |||
30 | import Data.Maybe (mapMaybe, fromMaybe) | 30 | import Data.Maybe (mapMaybe, fromMaybe) |
31 | import Data.Function ((&)) | 31 | import Data.Function ((&)) |
32 | import qualified Data.Set as Set | 32 | import qualified Data.Set as Set |
33 | import Data.Time.Clock (UTCTime) | ||
33 | import Data.Time.LocalTime (ZonedTime, utc, utcToZonedTime, zonedTimeToUTC) | 34 | import Data.Time.LocalTime (ZonedTime, utc, utcToZonedTime, zonedTimeToUTC) |
34 | import System.Directory (getModificationTime) | ||
35 | import Safe.Foldable (maximumByMay) | 35 | import Safe.Foldable (maximumByMay) |
36 | 36 | ||
37 | import GHC.Generics (Generic) | 37 | import 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 | ||
172 | flattenGalleryTree :: GalleryItem -> [GalleryItem] | 167 | flattenGalleryTree :: GalleryItem -> [GalleryItem] |