compiler: add resource timestamp in generated index

Add a timestamp to resource paths in the gallery index to invalidate
elements in the browser's cache when necessary.

Timestamps are added to resource URLs as a dummy numeric parameter.

GitHub: closes #40

2 files changed, 38 insertions, 18 deletions

diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index 1c4a791..2abdec5 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -38,7 +38,7 @@ import Codec.Picture.Extra -- TODO: compare DCT and bilinear (and Lanczos, but i
 
 import Resource
   ( ItemProcessor, ThumbnailProcessor
-  , GalleryItemProps(..), Resolution(..) )
+  , GalleryItemProps(..), Resolution(..), Resource(..) )
 
 import Files
 
@@ -150,6 +150,10 @@ withCached processor inputPath outputPath =
     skip = putStrLn $ "Skipping:\t" ++ outputPath
 
 
+resourceAt :: FilePath -> Path -> IO Resource
+resourceAt fsPath resPath = getModificationTime fsPath >>= return . Resource resPath
+
+
 type ItemFileProcessor =
      FileName        -- ^ Input base path
   -> FileName        -- ^ Output base path
@@ -159,14 +163,15 @@ type ItemFileProcessor =
 itemFileProcessor :: Maybe Resolution -> LossyExportQuality -> Cache -> ItemFileProcessor
 itemFileProcessor maxResolution jpegExportQuality cached inputBase outputBase resClass inputRes =
   cached processor inPath outPath
-  >> return (props relOutPath)
+  >> resourceAt outPath relOutPath
+  >>= return . props
   where
     relOutPath = resClass /> inputRes
     inPath = localPath $ inputBase /> inputRes
     outPath = localPath $ outputBase /> relOutPath
     (processor, props) = processorFor maxResolution $ formatFromPath inputRes
 
-    processorFor :: Maybe Resolution -> Format -> (FileProcessor, Path -> GalleryItemProps)
+    processorFor :: Maybe Resolution -> Format -> (FileProcessor, Resource -> GalleryItemProps)
     processorFor Nothing _ =
       (copyFileProcessor, Other)
     processorFor _ (PictureFormat Gif) =
@@ -192,11 +197,12 @@ thumbnailFileProcessor maxRes jpegExportQuality cached inputBase outputBase resC
     inPath = localPath $ inputBase /> inputRes
     outPath = localPath $ outputBase /> relOutPath
 
-    process :: Maybe FileProcessor -> IO (Maybe Path)
+    process :: Maybe FileProcessor -> IO (Maybe Resource)
     process Nothing = return Nothing
     process (Just proc) =
       proc inPath outPath
-      >> return (Just relOutPath)
+      >> resourceAt outPath relOutPath
+      >>= return . Just
 
     processorFor :: Format -> Maybe FileProcessor
     processorFor (PictureFormat picFormat) =
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 56f7a3f..c0ef317 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -18,7 +18,7 @@
 
 module Resource
   ( ItemProcessor, ThumbnailProcessor
-  , GalleryItem(..), GalleryItemProps(..), Resolution(..)
+  , GalleryItem(..), GalleryItemProps(..), Resolution(..), Resource(..)
   , buildGalleryTree, galleryCleanupResourceDir
   ) where
 
@@ -30,8 +30,10 @@ import Data.Char (toLower)
 import Data.Maybe (mapMaybe, fromMaybe, maybeToList)
 import Data.Function ((&))
 import qualified Data.Set as Set
+import Data.Text (pack)
 import Data.Time.Clock (UTCTime)
 import Data.Time.LocalTime (ZonedTime, utc, utcToZonedTime, zonedTimeToUTC)
+import Data.Time.Format (formatTime, defaultTimeLocale)
 import Safe.Foldable (maximumByMay)
 
 import GHC.Generics (Generic)
@@ -65,10 +67,22 @@ instance ToJSON Resolution where
   toEncoding = genericToEncoding encodingOptions
 
 
+data Resource = Resource
+  { resourcePath :: Path
+  , modTime :: UTCTime
+  } deriving (Generic, Show)
+
+instance ToJSON Resource where
+  toJSON Resource{resourcePath, modTime} =
+    JSON.String $ pack (webPath resourcePath ++ "?" ++ timestamp)
+    where
+      timestamp = formatTime defaultTimeLocale "%s" modTime
+
+
 data GalleryItemProps =
     Directory { items :: [GalleryItem] }
-  | Picture { resource :: Path }
-  | Other { resource :: Path }
+  | Picture { resource :: Resource }
+  | Other { resource :: Resource }
   deriving (Generic, Show)
 
 instance ToJSON GalleryItemProps where
@@ -82,7 +96,7 @@ data GalleryItem = GalleryItem
   , description :: String
   , tags :: [Tag]
   , path :: Path
-  , thumbnail :: Maybe Path
+  , thumbnail :: Maybe Resource
   , properties :: GalleryItemProps
   } deriving (Generic, Show)
 
@@ -92,7 +106,7 @@ instance ToJSON GalleryItem where
 
 
 type ItemProcessor = Path -> IO GalleryItemProps
-type ThumbnailProcessor = Path -> IO (Maybe Path)
+type ThumbnailProcessor = Path -> IO (Maybe Resource)
 
 
 buildGalleryTree ::
@@ -136,7 +150,7 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
         subItemsParents :: [String]
         subItemsParents = (maybeToList $ fileName path) ++ parentTitles
 
-    maybeThumbnail :: Maybe Path -> IO (Maybe Path)
+    maybeThumbnail :: Maybe Path -> IO (Maybe Resource)
     maybeThumbnail Nothing = return Nothing
     maybeThumbnail (Just thumbnailPath) = processThumbnail thumbnailPath
 
@@ -175,18 +189,18 @@ galleryOutputDiff resources ref =
 
     compiledPaths :: [GalleryItem] -> [Path]
     compiledPaths items =
-      resourcePaths items ++ thumbnailPaths items
+      resPaths items ++ thumbnailPaths items
       & concatMap subPaths
 
-    resourcePaths :: [GalleryItem] -> [Path]
-    resourcePaths = mapMaybe (resourcePath . properties)
+    resPaths :: [GalleryItem] -> [Path]
+    resPaths = mapMaybe (resPath . properties)
 
-    resourcePath :: GalleryItemProps -> Maybe Path
-    resourcePath Directory{} = Nothing
-    resourcePath resourceProps = Just $ resource resourceProps
+    resPath :: GalleryItemProps -> Maybe Path
+    resPath Directory{} = Nothing
+    resPath resourceProps = Just (resourcePath $ resource resourceProps)
 
     thumbnailPaths :: [GalleryItem] -> [Path]
-    thumbnailPaths = mapMaybe thumbnail
+    thumbnailPaths = (map resourcePath) . (mapMaybe thumbnail)
 
 
 galleryCleanupResourceDir :: GalleryItem -> FileName -> IO ()