aboutsummaryrefslogtreecommitdiff
path: root/compiler/src/Gallery.hs
diff options
context:
space:
mode:
authorpacien2019-12-25 21:04:31 +0100
committerpacien2019-12-25 21:04:31 +0100
commit0b2f6fb420d213b4ee718b9ac79cc3f9fa7678d5 (patch)
tree496a268b92a46f8952d9792cb5565ebdde5fbfa4 /compiler/src/Gallery.hs
parent819ec9bfb9674375f696741816184fef06af68ed (diff)
downloadldgallery-0b2f6fb420d213b4ee718b9ac79cc3f9fa7678d5.tar.gz
compiler: refactor transform stages
Diffstat (limited to 'compiler/src/Gallery.hs')
-rw-r--r--compiler/src/Gallery.hs123
1 files changed, 123 insertions, 0 deletions
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 @@
1{-# LANGUAGE DuplicateRecordFields, DeriveGeneric, DeriveAnyClass #-}
2
3-- ldgallery - A static generator which turns a collection of tagged
4-- pictures into a searchable web gallery.
5--
6-- Copyright (C) 2019 Pacien TRAN-GIRARD
7--
8-- This program is free software: you can redistribute it and/or modify
9-- it under the terms of the GNU Affero General Public License as
10-- published by the Free Software Foundation, either version 3 of the
11-- License, or (at your option) any later version.
12--
13-- This program is distributed in the hope that it will be useful,
14-- but WITHOUT ANY WARRANTY; without even the implied warranty of
15-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16-- GNU Affero General Public License for more details.
17--
18-- You should have received a copy of the GNU Affero General Public License
19-- along with this program. If not, see <https://www.gnu.org/licenses/>.
20
21
22module Gallery
23 ( GalleryItem(..), buildGalleryTree
24 ) where
25
26
27import GHC.Generics (Generic)
28import Data.Char (toLower)
29import Data.Function ((&))
30import Data.Maybe (fromMaybe)
31
32import Data.Aeson (ToJSON, genericToJSON, genericToEncoding)
33import qualified Data.Aeson as JSON
34
35importĀ Utils
36import Files
37import Input
38import Resource
39
40
41encodingOptions :: JSON.Options
42encodingOptions = JSON.defaultOptions
43 { JSON.fieldLabelModifier = map toLower
44 , JSON.constructorTagModifier = map toLower
45 , JSON.sumEncoding = JSON.defaultTaggedObject
46 { JSON.tagFieldName = "type"
47 , JSON.contentsFieldName = "contents"
48 }
49 }
50
51
52type ResourcePath = String
53type Tag = String
54type FileSizeKB = Int
55
56
57data Resolution = Resolution
58 { width :: Int
59 , height :: Int
60 } deriving (Generic, Show)
61
62instance ToJSON Resolution where
63 toJSON = genericToJSON encodingOptions
64 toEncoding = genericToEncoding encodingOptions
65
66
67data GalleryItemProps =
68 Directory { items :: [GalleryItem] }
69-- | Image { resolution :: Resolution, filesize :: FileSizeKB }
70-- | Video { filesize :: FileSizeKB }
71 | Unknown
72 deriving (Generic, Show)
73
74instance ToJSON GalleryItemProps where
75 toJSON = genericToJSON encodingOptions
76 toEncoding = genericToEncoding encodingOptions
77
78
79-- TODO: fuse GalleryItem and GalleryItemProps
80data GalleryItem = GalleryItem
81 { title :: String
82 , date :: String -- TODO: checked ISO8601 date
83 , description :: String
84 , tags :: [Tag]
85 , path :: ResourcePath
86 , thumbnail :: Maybe ResourcePath
87 , properties :: GalleryItemProps
88 } deriving (Generic, Show)
89
90instance ToJSON GalleryItem where
91 toJSON = genericToJSON encodingOptions
92 toEncoding = genericToEncoding encodingOptions
93
94
95buildGalleryTree :: ResourceTree -> GalleryItem
96buildGalleryTree (ItemResource sidecar path@(filename:_) thumbnailPath) =
97 GalleryItem
98 { title = optMeta title filename
99 , date = optMeta date "" -- TODO: check and normalise dates
100 , description = optMeta description ""
101 , tags = optMeta tags []
102 , path = webPath path
103 , thumbnail = Just $ webPath thumbnailPath
104 , properties = Unknown } -- TODO
105 where
106 optMeta :: (Sidecar -> Maybe a) -> a -> a
107 optMeta get fallback = fromMaybe fallback $ get sidecar
108
109buildGalleryTree (DirResource dirItems path@(dirname:_) thumbnailPath) =
110 map buildGalleryTree dirItems
111 & \items -> GalleryItem
112 { title = dirname
113 -- TODO: consider using the most recent item's date? what if empty?
114 , date = ""
115 -- TODO: consider allowing metadata sidecars for directories too
116 , description = ""
117 , tags = aggregateChildTags items
118 , path = webPath path
119 , thumbnail = fmap webPath thumbnailPath
120 , properties = Directory items }
121 where
122 aggregateChildTags :: [GalleryItem] -> [Tag]
123 aggregateChildTags = unique . concatMap (\item -> tags (item::GalleryItem))