diff options
Diffstat (limited to 'compiler/src')
-rw-r--r-- | compiler/src/Compiler.hs | 17 | ||||
-rw-r--r-- | compiler/src/Config.hs | 2 | ||||
-rw-r--r-- | compiler/src/Gallery.hs | 134 | ||||
-rw-r--r-- | compiler/src/Input.hs | 2 | ||||
-rw-r--r-- | compiler/src/Processors.hs | 8 | ||||
-rw-r--r-- | compiler/src/Resource.hs | 185 |
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 | ||
38 | import Config | 38 | import Config |
39 | import Input (decodeYamlFile, readInputTree) | 39 | import Input (decodeYamlFile, readInputTree) |
40 | import Resource (ResourceTree, buildResourceTree, cleanupResourceDir) | 40 | import Resource (GalleryItem, buildGalleryTree, galleryCleanupResourceDir) |
41 | import Gallery (buildGallery) | ||
42 | import Files | 41 | import 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 | ||
38 | import Files (FileName) | 38 | import Files (FileName) |
39 | import Input (decodeYamlFile) | 39 | import Input (decodeYamlFile) |
40 | import Processors (Resolution(..)) | 40 | import Resource (Resolution(..)) |
41 | 41 | ||
42 | 42 | ||
43 | data CompilerConfig = CompilerConfig | 43 | data 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 | |||
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 } | ||
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 | ||
25 | module Input | 25 | module 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 ((&)) | |||
37 | import Data.Ratio ((%)) | 37 | import Data.Ratio ((%)) |
38 | import Data.Char (toLower) | 38 | import Data.Char (toLower) |
39 | 39 | ||
40 | import GHC.Generics (Generic) | ||
41 | import Data.Aeson (FromJSON) | ||
42 | |||
43 | import System.Directory hiding (copyFile) | 40 | import System.Directory hiding (copyFile) |
44 | import qualified System.Directory | 41 | import qualified System.Directory |
45 | import System.FilePath | 42 | import System.FilePath |
@@ -60,7 +57,7 @@ data Format = | |||
60 | | Other | 57 | | Other |
61 | 58 | ||
62 | formatFromPath :: Path -> Format | 59 | formatFromPath :: Path -> Format |
63 | formatFromPath = aux . (map toLower) . fileName | 60 | formatFromPath = 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 | ||
74 | data Resolution = Resolution | ||
75 | { width :: Int | ||
76 | , height :: Int } deriving (Show, Generic, FromJSON) | ||
77 | 71 | ||
78 | type FileProcessor = | 72 | type 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 |