compiler: refactor resource transformation pipeline

6 files changed, 138 insertions, 210 deletions

diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 0a3e540..048afc1 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -37,8 +37,7 @@ import qualified Data.Aeson as JSON
 
 import Config
 import Input (decodeYamlFile, readInputTree)
-import Resource (ResourceTree, buildResourceTree, cleanupResourceDir)
-import Gallery (buildGallery)
+import Resource (GalleryItem, buildGalleryTree, galleryCleanupResourceDir)
 import Files
   ( FileName
   , FSNode(..)
@@ -75,17 +74,15 @@ compileGallery inputDirPath outputDirPath rebuildAll =
 
     invalidateCache <- isOutdated False inputGalleryConf outputIndex
     let cache = if invalidateCache || rebuildAll then skipCached else withCached
+
     let itemProc = itemProcessor (pictureMaxResolution config) cache
     let thumbnailProc = thumbnailProcessor (thumbnailResolution config) cache
-    resourceTree <- buildResourceTree dirProcessor itemProc thumbnailProc inputTree
-
-    cleanupResourceDir resourceTree outputDirPath
-
-    buildGallery (galleryName config) resourceTree
-      & writeJSON outputIndex
+    let galleryBuilder = buildGalleryTree dirProcessor itemProc thumbnailProc
+    resources <- galleryBuilder (galleryName config) inputTree
 
-    viewer fullConfig
-      & writeJSON outputViewerConf
+    galleryCleanupResourceDir resources outputDirPath
+    writeJSON outputIndex resources
+    writeJSON outputViewerConf $ viewer fullConfig
 
   where
     galleryConf = "gallery.yaml"
diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs
index 044a155..c75ab01 100644
--- a/compiler/src/Config.hs
+++ b/compiler/src/Config.hs
@@ -37,7 +37,7 @@ import qualified Data.Aeson as JSON
 
 import Files (FileName)
 import Input (decodeYamlFile)
-import Processors (Resolution(..))
+import Resource (Resolution(..))
 
 
 data CompilerConfig = CompilerConfig
diff --git a/compiler/src/Gallery.hs b/compiler/src/Gallery.hs
deleted file mode 100644
index a1b1674..0000000
--- a/compiler/src/Gallery.hs
+++ /dev/null
@@ -1,134 +0,0 @@
--- ldgallery - A static generator which turns a collection of tagged
---             pictures into a searchable web gallery.
---
--- Copyright (C) 2019  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
--- published by the Free Software Foundation, either version 3 of the
--- License, or (at your option) any later version.
---
--- This program is distributed in the hope that it will be useful,
--- but WITHOUT ANY WARRANTY; without even the implied warranty of
--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--- GNU Affero General Public License for more details.
---
--- You should have received a copy of the GNU Affero General Public License
--- along with this program.  If not, see <https://www.gnu.org/licenses/>.
-
-{-# LANGUAGE
-    DuplicateRecordFields
-  , DeriveGeneric
-  , DeriveAnyClass
-#-}
-
-module Gallery
-  ( GalleryItem(..), buildGallery
-  ) where
-
-
-import GHC.Generics (Generic)
-import Data.Char (toLower)
-import Data.Function ((&))
-import Data.Maybe (fromMaybe)
-
-import Data.Aeson (ToJSON, genericToJSON, genericToEncoding)
-import qualified Data.Aeson as JSON
-
-import qualified Data.Set as Set
-
-import Files
-import Input
-import Resource
-
-
-encodingOptions :: JSON.Options
-encodingOptions = JSON.defaultOptions
-  { JSON.fieldLabelModifier = map toLower
-  , JSON.constructorTagModifier = map toLower
-  , JSON.sumEncoding = JSON.defaultTaggedObject
-      { JSON.tagFieldName = "type"
-      , JSON.contentsFieldName = "contents"
-      }
-  }
-
-
-type ResourcePath = String
-type Tag = String
-type FileSizeKB = Int
-
-
-data Resolution = Resolution
-  { width :: Int
-  , height :: Int
-  } deriving (Generic, Show)
-
-instance ToJSON Resolution where
-  toJSON = genericToJSON encodingOptions
-  toEncoding = genericToEncoding encodingOptions
-
-
-data GalleryItemProps =
-    Directory { items :: [GalleryItem] }
---  | Image { resolution :: Resolution, filesize :: FileSizeKB }
---  | Video { filesize :: FileSizeKB }
-  | Unknown
-  deriving (Generic, Show)
-
-instance ToJSON GalleryItemProps where
-  toJSON = genericToJSON encodingOptions
-  toEncoding = genericToEncoding encodingOptions
-
-
--- TODO: fuse GalleryItem and GalleryItemProps
-data GalleryItem = GalleryItem
-  { title :: String
-  , date :: String -- TODO: checked ISO8601 date
-  , description :: String
-  , tags :: [Tag]
-  , path :: Path
-  , thumbnail :: Maybe Path
-  , properties :: GalleryItemProps
-  } deriving (Generic, Show)
-
-instance ToJSON GalleryItem where
-  toJSON = genericToJSON encodingOptions
-  toEncoding = genericToEncoding encodingOptions
-
-
-buildGalleryTree :: ResourceTree -> GalleryItem
-buildGalleryTree (ItemResource sidecar path thumbnail) =
-  GalleryItem
-    { title = optMeta title $ fileName path
-    , date = optMeta date "" -- TODO: check and normalise dates
-    , description = optMeta description ""
-    , tags = optMeta tags []
-    , path = path
-    , thumbnail = thumbnail
-    , properties = Unknown } -- TODO
-  where
-    optMeta :: (Sidecar -> Maybe a) -> a -> a
-    optMeta get fallback = fromMaybe fallback $ get sidecar
-
-buildGalleryTree (DirResource dirItems path thumbnail) =
-  map buildGalleryTree dirItems
-  & \items -> GalleryItem
-    { title = fileName path
-      -- TODO: consider using the most recent item's date? what if empty?
-    , date = ""
-      -- TODO: consider allowing metadata sidecars for directories too
-    , description = ""
-    , tags = aggregateChildTags items
-    , path = path
-    , thumbnail = thumbnail
-    , properties = Directory items }
-  where
-    aggregateChildTags :: [GalleryItem] -> [Tag]
-    aggregateChildTags = unique . concatMap (\item -> tags (item::GalleryItem))
-
-    unique :: Ord a => [a] -> [a]
-    unique = Set.toList . Set.fromList
-
-buildGallery :: String -> ResourceTree -> GalleryItem
-buildGallery galleryName resourceTree =
-  (buildGalleryTree resourceTree) { title = galleryName }
diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs
index cb9fc60..2e11ebe 100644
--- a/compiler/src/Input.hs
+++ b/compiler/src/Input.hs
@@ -24,7 +24,7 @@
 
 module Input
   ( decodeYamlFile
-  , Sidecar, title, date, description, tags
+  , Sidecar(..)
   , InputTree(..), readInputTree
   ) where
 
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index ded3cc5..df05c24 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -37,9 +37,6 @@ import Data.Function ((&))
 import Data.Ratio ((%))
 import Data.Char (toLower)
 
-import GHC.Generics (Generic)
-import Data.Aeson (FromJSON)
-
 import System.Directory hiding (copyFile)
 import qualified System.Directory
 import System.FilePath
@@ -60,7 +57,7 @@ data Format =
   | Other
 
 formatFromPath :: Path -> Format
-formatFromPath = aux . (map toLower) . fileName
+formatFromPath = aux . (map toLower) . takeExtension . fileName
   where
     aux ".bmp" = Bmp
     aux ".jpg" = Jpg
@@ -71,9 +68,6 @@ formatFromPath = aux . (map toLower) . fileName
     aux ".gif" = Gif
     aux _ = Other
 
-data Resolution = Resolution
-  { width :: Int
-  , height :: Int } deriving (Show, Generic, FromJSON)