aboutsummaryrefslogtreecommitdiff
path: root/compiler/src/Gallery.hs
blob: ce52523deb08856292ce33d78fb411bbaf76dbfe (plain)
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