1 files changed, 60 insertions, 45 deletions

diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index e134468..e8ca58c 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -1,7 +1,7 @@
 -- ldgallery - A static generator which turns a collection of tagged
 --             pictures into a searchable web gallery.
 --
--- Copyright (C) 2019-2020  Pacien TRAN-GIRARD
+-- Copyright (C) 2019-2022  Pacien TRAN-GIRARD
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of the GNU Affero General Public License as
@@ -17,9 +17,15 @@
 -- along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 module Resource
-  ( ItemProcessor, ThumbnailProcessor
-  , GalleryItem(..), GalleryItemProps(..), Resolution(..), Resource(..), Thumbnail(..)
-  , buildGalleryTree, galleryCleanupResourceDir
+  ( ItemProcessor
+  , GalleryItem(..)
+  , GalleryItemProps(..)
+  , Resolution(..)
+  , Resource(..)
+  , Thumbnail(..)
+  , buildGalleryTree
+  , galleryCleanupResourceDir
+  , flattenGalleryTree
   ) where
 
 
@@ -29,15 +35,16 @@ import Data.List.Ordered (minusBy)
 import Data.Char (toLower)
 import Data.Maybe (mapMaybe, fromMaybe)
 import Data.Function ((&))
+import Data.Functor ((<&>))
 import qualified Data.Set as Set
-import Data.Text (pack)
+import Data.Text (pack, unpack, breakOn)
 import Data.Time.Clock (UTCTime)
 import Data.Time.LocalTime (ZonedTime, utc, utcToZonedTime, zonedTimeToUTC)
-import Data.Time.Format (formatTime, defaultTimeLocale)
+import Data.Time.Format (formatTime, parseTimeM, defaultTimeLocale)
 import Safe.Foldable (maximumByMay)
 
 import GHC.Generics (Generic)
-import Data.Aeson (ToJSON, genericToJSON, genericToEncoding)
+import Data.Aeson (ToJSON, FromJSON, genericToJSON, genericToEncoding, genericParseJSON)
 import qualified Data.Aeson as JSON
 
 import Files
@@ -49,7 +56,7 @@ encodingOptions :: JSON.Options
 encodingOptions = JSON.defaultOptions
   { JSON.fieldLabelModifier = map toLower
   , JSON.constructorTagModifier = map toLower
-  , JSON.sumEncoding = JSON.defaultTaggedObject
+  , JSON.sumEncoding = JSON.TaggedObject
       { JSON.tagFieldName = "type"
       , JSON.contentsFieldName = "contents"
       }
@@ -69,12 +76,25 @@ instance ToJSON Resource where
     where
       timestamp = formatTime defaultTimeLocale "%s" modTime
 
+instance FromJSON Resource where
+  parseJSON = JSON.withText "Resource" (unpackRes . breakOn "?")
+    where
+      unpackRes (resPathStr, modTimeStr) =
+        Resource (fromWebPath $ unpack resPathStr)
+        <$> parseTimeM True defaultTimeLocale "?%s" (unpack modTimeStr)
+
 
 data GalleryItemProps =
     Directory { items :: [GalleryItem] }
   | Picture
     { resource :: Resource
     , resolution :: Resolution }
+  | PlainText { resource :: Resource }
+  | Markdown { resource :: Resource }
+  | PDF { resource :: Resource }
+  | EPUB { resource :: Resource }
+  | Video { resource :: Resource }
+  | Audio { resource :: Resource }
   | Other { resource :: Resource }
   deriving (Generic, Show)
 
@@ -82,15 +102,14 @@ instance ToJSON GalleryItemProps where
   toJSON = genericToJSON encodingOptions
   toEncoding = genericToEncoding encodingOptions
 
+instance FromJSON GalleryItemProps where
+  parseJSON = genericParseJSON encodingOptions
+
 
 data Thumbnail = Thumbnail
   { resource :: Resource
   , resolution :: Resolution
-  } deriving (Generic, Show)
-
-instance ToJSON Thumbnail where
-  toJSON = genericToJSON encodingOptions
-  toEncoding = genericToEncoding encodingOptions
+  } deriving (Generic, Show, ToJSON, FromJSON)
 
 
 data GalleryItem = GalleryItem
@@ -101,49 +120,49 @@ data GalleryItem = GalleryItem
   , path :: Path
   , thumbnail :: Maybe Thumbnail
   , properties :: GalleryItemProps
-  } deriving (Generic, Show)
-
-instance ToJSON GalleryItem where
-  toJSON = genericToJSON encodingOptions
-  toEncoding = genericToEncoding encodingOptions
+  } deriving (Generic, Show, ToJSON, FromJSON)
 
 
-type ItemProcessor = Path -> IO GalleryItemProps
-type ThumbnailProcessor = Path -> IO (Maybe Thumbnail)
+type ItemProcessor a =
+     Path -- Item path
+  -> Path -- Resource Path
+  -> IO a
 
 
 buildGalleryTree ::
-     ItemProcessor -> ThumbnailProcessor -> TagsFromDirectoriesConfig
+     ItemProcessor GalleryItemProps -> ItemProcessor (Maybe Thumbnail) -> TagsFromDirectoriesConfig
   -> InputTree -> IO GalleryItem
-buildGalleryTree processItem processThumbnail tagsFromDirsConfig inputTree =
-  mkGalleryItem [] inputTree
+buildGalleryTree processItem processThumbnail tagsFromDirsConfig =
+  mkGalleryItem []
   where
     mkGalleryItem :: [Tag] -> InputTree -> IO GalleryItem
-    mkGalleryItem inheritedTags InputFile{path, modTime, sidecar} =
+    mkGalleryItem inheritedTags InputFile{path, modTime, sidecar, thumbnailPath} =
       do
-        properties <- processItem path
-        processedThumbnail <- processThumbnail path
+        let itemPath = "/" /> path
+        properties <- processItem itemPath path
+        processedThumbnail <- processThumbnail itemPath (thumbnailPath ?? path)
         return GalleryItem
           { title = Input.title sidecar ?? fileName path ?? ""
           , datetime = Input.datetime sidecar ?? toZonedTime modTime
           , description = Input.description sidecar ?? ""
           , tags = unique ((Input.tags sidecar ?? []) ++ inheritedTags ++ parentDirTags path)
-          , path = "/" /> path
+          , path = itemPath
           , thumbnail = processedThumbnail
           , properties = properties }
 
-    mkGalleryItem inheritedTags InputDir{path, modTime, sidecar, dirThumbnailPath, items} =
+    mkGalleryItem inheritedTags InputDir{path, modTime, sidecar, thumbnailPath, items} =
       do
+        let itemPath = "/" /> path
         let dirTags = (Input.tags sidecar ?? []) ++ inheritedTags
         processedItems <- parallel $ map (mkGalleryItem dirTags) items
-        processedThumbnail <- maybeThumbnail dirThumbnailPath
+        processedThumbnail <- maybeThumbnail itemPath thumbnailPath
         return GalleryItem
           { title = Input.title sidecar ?? fileName path ?? ""
           , datetime = Input.datetime sidecar ?? mostRecentModTime processedItems
                                               ?? toZonedTime modTime
           , description = Input.description sidecar ?? ""
           , tags = unique (aggregateTags processedItems ++ parentDirTags path)
-          , path = "/" /> path
+          , path = itemPath
           , thumbnail = processedThumbnail
           , properties = Directory processedItems }
 
@@ -161,15 +180,15 @@ buildGalleryTree processItem processThumbnail tagsFromDirsConfig inputTree =
       & map (prefix tagsFromDirsConfig ++)
 
     aggregateTags :: [GalleryItem] -> [Tag]
-    aggregateTags = concatMap (\item -> tags (item::GalleryItem))
+    aggregateTags = concatMap Resource.tags
 
-    maybeThumbnail :: Maybe Path -> IO (Maybe Thumbnail)
-    maybeThumbnail Nothing = return Nothing
-    maybeThumbnail (Just thumbnailPath) = processThumbnail thumbnailPath
+    maybeThumbnail :: Path -> Maybe Path -> IO (Maybe Thumbnail)
+    maybeThumbnail _ Nothing = return Nothing
+    maybeThumbnail itemPath (Just thumbnailPath) = processThumbnail itemPath thumbnailPath
 
     mostRecentModTime :: [GalleryItem] -> Maybe ZonedTime
     mostRecentModTime =
-      maximumByMay comparingTime . map (datetime::(GalleryItem -> ZonedTime))
+      maximumByMay comparingTime . map Resource.datetime
 
     comparingTime :: ZonedTime -> ZonedTime -> Ordering
     comparingTime l r = compare (zonedTimeToUTC l) (zonedTimeToUTC r)
@@ -186,7 +205,7 @@ flattenGalleryTree simple = [simple]
 
 galleryOutputDiff :: GalleryItem -> FSNode -> [Path]
 galleryOutputDiff resources ref =
-  (filesystemPaths ref) \\ (compiledPaths $ flattenGalleryTree resources)
+  filesystemPaths ref \\ compiledPaths (flattenGalleryTree resources)
   where
     filesystemPaths :: FSNode -> [Path]
     filesystemPaths = map Files.path . tail . flattenDir
@@ -201,15 +220,11 @@ galleryOutputDiff resources ref =