compiler: fix file mod time reading from other directory

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 ((&))
 import Data.Maybe (catMaybes)
 import Data.Bool (bool)
 import Data.List (find)
+import Data.Time.Clock (UTCTime)
 import Data.Time.LocalTime (ZonedTime)
 import Data.Yaml (ParseException, decodeFileEither)
 import Data.Aeson (FromJSON)
 import System.FilePath (isExtensionOf, dropExtension)
-import System.Directory (doesFileExist)
+import System.Directory (doesFileExist, getModificationTime)
 
 import Files
 
@@ -52,9 +53,11 @@ decodeYamlFile path =
 data InputTree =
     InputFile
       { path :: Path
+      , modTime :: UTCTime
       , sidecar :: Sidecar }
     | InputDir
       { path :: Path
+      , modTime :: UTCTime
       , dirThumbnailPath :: Maybe Path
       , items :: [InputTree] }
   deriving Show
@@ -91,18 +94,20 @@ readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root
     mkInputNode :: FSNode -> IO (Maybe InputTree)
     mkInputNode file@File{path}
       | (not $ isSidecar file) && (not $ isThumbnail file) =
-        readSidecarFile (localPath $ anchor /> path <.> sidecarExt)
-        >>= return . InputFile path
-        >>= return . Just
+        do
+          sidecar <- readSidecarFile $ localPath (anchor /> path <.> sidecarExt)
+          modTime <- getModificationTime $ localPath (anchor /> path)
+          return $ Just $ InputFile path modTime sidecar
     mkInputNode File{} = return Nothing
     mkInputNode dir@Dir{} = mkDirNode dir >>= return . Just
 
     mkDirNode :: FSNode -> IO InputTree
     mkDirNode File{} = throw $ AssertionFailed "Input directory is a file"
     mkDirNode Dir{path, items} =
-      mapM mkInputNode items
-      >>= return . catMaybes
-      >>= return . InputDir path (findThumbnail items)
+      do
+        dirItems <- mapM mkInputNode items
+        modTime <- getModificationTime $ localPath (anchor /> path)
+        return $ InputDir path modTime (findThumbnail items) (catMaybes dirItems)
 
     isSidecar :: FSNode -> Bool
     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)
 import Data.Maybe (mapMaybe, fromMaybe)
 import Data.Function ((&))
 import qualified Data.Set as Set
+import Data.Time.Clock (UTCTime)
 import Data.Time.LocalTime (ZonedTime, utc, utcToZonedTime, zonedTimeToUTC)
-import System.Directory (getModificationTime)
 import Safe.Foldable (maximumByMay)
 
 import GHC.Generics (Generic)
@@ -102,14 +102,13 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
   mkGalleryItem (Just galleryName) (Path []) inputTree
   where
     mkGalleryItem :: Maybe String -> Path -> InputTree -> IO GalleryItem
-    mkGalleryItem _ parents InputFile{path, sidecar} =
+    mkGalleryItem _ parents InputFile{path, modTime, sidecar} =
       do
         properties <- processItem path
         processedThumbnail <- processThumbnail path
-        fileModTime <- lastModTime path
         return GalleryItem
           { title = itemTitle
-          , datetime = fromMaybe fileModTime $ Input.datetime sidecar
+          , datetime = fromMaybe (toZonedTime modTime) (Input.datetime sidecar)
           , description = optMeta description ""
           , tags = (optMeta tags []) ++ implicitParentTags parents
           , path = parents </ itemTitle
@@ -122,14 +121,13 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
         optMeta :: (Sidecar -> Maybe a) -> a -> a
         optMeta get fallback = fromMaybe fallback $ get sidecar
 
-    mkGalleryItem rootTitle parents InputDir{path, dirThumbnailPath, items} =
+    mkGalleryItem rootTitle parents InputDir{path, modTime, dirThumbnailPath, items} =
       do
         processedThumbnail <- maybeThumbnail dirThumbnailPath
         processedItems <- parallel $ map (mkGalleryItem Nothing itemPath) items
-        dirModTime <- lastModTime path
         return GalleryItem
           { title = itemTitle
-          , datetime = fromMaybe dirModTime $ mostRecentChildModTime processedItems
+          , datetime = fromMaybe (toZonedTime modTime) (mostRecentChildModTime processedItems)
           , description = ""
           , tags = (aggregateChildTags processedItems) ++ implicitParentTags parents
           , path = itemPath
@@ -162,11 +160,8 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
     implicitParentTags :: Path -> [Tag]
     implicitParentTags (Path elements) = take tagsFromDirectories elements
 
-    lastModTime :: Path -> IO ZonedTime
-    lastModTime path =
-      localPath path
-      &   getModificationTime
-      >>= return . utcToZonedTime utc
+    toZonedTime :: UTCTime -> ZonedTime
+    toZonedTime = utcToZonedTime utc
 
 
 flattenGalleryTree :: GalleryItem -> [GalleryItem]