From 0b2f6fb420d213b4ee718b9ac79cc3f9fa7678d5 Mon Sep 17 00:00:00 2001
From: pacien
Date: Wed, 25 Dec 2019 21:04:31 +0100
Subject: compiler: refactor transform stages

---
 compiler/src/Gallery.hs | 123 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 123 insertions(+)
 create mode 100644 compiler/src/Gallery.hs

(limited to 'compiler/src/Gallery.hs')

diff --git a/compiler/src/Gallery.hs b/compiler/src/Gallery.hs
new file mode 100644
index 0000000..3be62ad
--- /dev/null
+++ b/compiler/src/Gallery.hs
@@ -0,0 +1,123 @@
+{-# LANGUAGE DuplicateRecordFields, DeriveGeneric, DeriveAnyClass #-}
+
+-- 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/>.
+
+
+module Gallery
+  ( GalleryItem(..), buildGalleryTree
+  ) 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 Utils
+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 :: ResourcePath
+  , thumbnail :: Maybe ResourcePath
+  , properties :: GalleryItemProps
+  } deriving (Generic, Show)
+
+instance ToJSON GalleryItem where
+  toJSON = genericToJSON encodingOptions
+  toEncoding = genericToEncoding encodingOptions
+
+
+buildGalleryTree :: ResourceTree -> GalleryItem
+buildGalleryTree (ItemResource sidecar path@(filename:_) thumbnailPath) =
+  GalleryItem
+    { title = optMeta title filename
+    , date = optMeta date "" -- TODO: check and normalise dates
+    , description = optMeta description ""
+    , tags = optMeta tags []
+    , path = webPath path
+    , thumbnail = Just $ webPath thumbnailPath
+    , properties = Unknown } -- TODO
+  where
+    optMeta :: (Sidecar -> Maybe a) -> a -> a
+    optMeta get fallback = fromMaybe fallback $ get sidecar
+
+buildGalleryTree (DirResource dirItems path@(dirname:_) thumbnailPath) =
+  map buildGalleryTree dirItems
+  & \items -> GalleryItem
+    { title = dirname
+      -- 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 = webPath path
+    , thumbnail = fmap webPath thumbnailPath
+    , properties = Directory items }
+  where
+    aggregateChildTags :: [GalleryItem] -> [Tag]
+    aggregateChildTags = unique . concatMap (\item -> tags (item::GalleryItem))
-- 
cgit v1.2.3