1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
{-# 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 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 :: 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))
unique :: Ord a => [a] -> [a]
unique = Set.toList . Set.fromList
|