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