aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/src/Compiler.hs17
-rw-r--r--compiler/src/Config.hs2
-rw-r--r--compiler/src/Gallery.hs134
-rw-r--r--compiler/src/Input.hs2
-rw-r--r--compiler/src/Processors.hs8
-rw-r--r--compiler/src/Resource.hs185
6 files changed, 138 insertions, 210 deletions
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 0a3e540..048afc1 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -37,8 +37,7 @@ import qualified Data.Aeson as JSON
37 37
38import Config 38import Config
39import Input (decodeYamlFile, readInputTree) 39import Input (decodeYamlFile, readInputTree)
40import Resource (ResourceTree, buildResourceTree, cleanupResourceDir) 40import Resource (GalleryItem, buildGalleryTree, galleryCleanupResourceDir)
41import Gallery (buildGallery)
42import Files 41import Files
43 ( FileName 42 ( FileName
44 , FSNode(..) 43 , FSNode(..)
@@ -75,17 +74,15 @@ compileGallery inputDirPath outputDirPath rebuildAll =
75 74
76 invalidateCache <- isOutdated False inputGalleryConf outputIndex 75 invalidateCache <- isOutdated False inputGalleryConf outputIndex
77 let cache = if invalidateCache || rebuildAll then skipCached else withCached 76 let cache = if invalidateCache || rebuildAll then skipCached else withCached
77
78 let itemProc = itemProcessor (pictureMaxResolution config) cache 78 let itemProc = itemProcessor (pictureMaxResolution config) cache
79 let thumbnailProc = thumbnailProcessor (thumbnailResolution config) cache 79 let thumbnailProc = thumbnailProcessor (thumbnailResolution config) cache
80 resourceTree <- buildResourceTree dirProcessor itemProc thumbnailProc inputTree 80 let galleryBuilder = buildGalleryTree dirProcessor itemProc thumbnailProc
81 81 resources <- galleryBuilder (galleryName config) inputTree
82 cleanupResourceDir resourceTree outputDirPath
83
84 buildGallery (galleryName config) resourceTree
85 & writeJSON outputIndex
86 82
87 viewer fullConfig 83 galleryCleanupResourceDir resources outputDirPath
88 & writeJSON outputViewerConf 84 writeJSON outputIndex resources
85 writeJSON outputViewerConf $ viewer fullConfig
89 86
90 where 87 where
91 galleryConf = "gallery.yaml" 88 galleryConf = "gallery.yaml"
diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs
index 044a155..c75ab01 100644
--- a/compiler/src/Config.hs
+++ b/compiler/src/Config.hs
@@ -37,7 +37,7 @@ import qualified Data.Aeson as JSON
37 37
38import Files (FileName) 38import Files (FileName)
39import Input (decodeYamlFile) 39import Input (decodeYamlFile)
40import Processors (Resolution(..)) 40import Resource (Resolution(..))
41 41
42 42
43data CompilerConfig = CompilerConfig 43data CompilerConfig = CompilerConfig
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 }
diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs
index cb9fc60..2e11ebe 100644
--- a/compiler/src/Input.hs
+++ b/compiler/src/Input.hs
@@ -24,7 +24,7 @@
24 24
25module Input 25module Input
26 ( decodeYamlFile 26 ( decodeYamlFile
27 , Sidecar, title, date, description, tags 27 , Sidecar(..)
28 , InputTree(..), readInputTree 28 , InputTree(..), readInputTree
29 ) where 29 ) where
30 30
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index ded3cc5..df05c24 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -37,9 +37,6 @@ import Data.Function ((&))
37import Data.Ratio ((%)) 37import Data.Ratio ((%))
38import Data.Char (toLower) 38import Data.Char (toLower)
39 39
40import GHC.Generics (Generic)
41import Data.Aeson (FromJSON)
42
43import System.Directory hiding (copyFile) 40import System.Directory hiding (copyFile)
44import qualified System.Directory 41import qualified System.Directory
45import System.FilePath 42import System.FilePath
@@ -60,7 +57,7 @@ data Format =
60 | Other 57 | Other
61 58
62formatFromPath :: Path -> Format 59formatFromPath :: Path -> Format
63formatFromPath = aux . (map toLower) . fileName 60formatFromPath = aux . (map toLower) . takeExtension . fileName
64 where 61 where
65 aux ".bmp" = Bmp 62 aux ".bmp" = Bmp
66 aux ".jpg" = Jpg 63 aux ".jpg" = Jpg
@@ -71,9 +68,6 @@ formatFromPath = aux . (map toLower) . fileName
71 aux ".gif" = Gif 68 aux ".gif" = Gif
72 aux _ = Other 69 aux _ = Other
73 70
74data Resolution = Resolution
75 { width :: Int
76 , height :: Int } deriving (Show, Generic, FromJSON)
77 71
78type FileProcessor = 72type FileProcessor =
79 FileName -- ^ Input path 73 FileName -- ^ Input path
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index afc8203..dcf9422 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -20,15 +20,13 @@
20 DuplicateRecordFields 20 DuplicateRecordFields