diff options
Diffstat (limited to 'compiler/src/Gallery.hs')
-rw-r--r-- | compiler/src/Gallery.hs | 134 |
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 | |||
25 | module Gallery | ||
26 | ( GalleryItem(..), buildGallery | ||
27 | ) where | ||
28 | |||
29 | |||
30 | import GHC.Generics (Generic) | ||
31 | import Data.Char (toLower) | ||
32 | import Data.Function ((&)) | ||
33 | import Data.Maybe (fromMaybe) | ||
34 | |||
35 | import Data.Aeson (ToJSON, genericToJSON, genericToEncoding) | ||
36 | import qualified Data.Aeson as JSON | ||
37 | |||
38 | import qualified Data.Set as Set | ||
39 | |||
40 | import Files | ||
41 | import Input | ||
42 | import Resource | ||
43 | |||
44 | |||
45 | encodingOptions :: JSON.Options | ||
46 | encodingOptions = 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 | |||
56 | type ResourcePath = String | ||
57 | type Tag = String | ||
58 | type FileSizeKB = Int | ||
59 | |||
60 | |||
61 | data Resolution = Resolution | ||
62 | { width :: Int | ||
63 | , height :: Int | ||
64 | } deriving (Generic, Show) | ||
65 | |||
66 | instance ToJSON Resolution where | ||
67 | toJSON = genericToJSON encodingOptions | ||
68 | toEncoding = genericToEncoding encodingOptions | ||
69 | |||
70 | |||
71 | data GalleryItemProps = | ||
72 | Directory { items :: [GalleryItem] } | ||
73 | -- | Image { resolution :: Resolution, filesize :: FileSizeKB } | ||
74 | -- | Video { filesize :: FileSizeKB } | ||
75 | | Unknown | ||
76 | deriving (Generic, Show) | ||
77 | |||
78 | instance ToJSON GalleryItemProps where | ||
79 | toJSON = genericToJSON encodingOptions | ||
80 | toEncoding = genericToEncoding encodingOptions | ||
81 | |||
82 | |||
83 | -- TODO: fuse GalleryItem and GalleryItemProps | ||
84 | data 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 | |||
94 | instance ToJSON GalleryItem where | ||
95 | toJSON = genericToJSON encodingOptions | ||
96 | toEncoding = genericToEncoding encodingOptions | ||
97 | |||
98 | |||
99 | buildGalleryTree :: ResourceTree -> GalleryItem | ||
100 | buildGalleryTree (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 | |||
113 | buildGalleryTree (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 | |||
132 | buildGallery :: String -> ResourceTree -> GalleryItem | ||
133 | buildGallery galleryName resourceTree = | ||
134 | (buildGalleryTree resourceTree) { title = galleryName } | ||