diff options
Diffstat (limited to 'compiler/src')
-rw-r--r-- | compiler/src/Compiler.hs | 14 | ||||
-rw-r--r-- | compiler/src/Config.hs | 5 | ||||
-rw-r--r-- | compiler/src/Files.hs | 5 | ||||
-rw-r--r-- | compiler/src/Input.hs | 9 | ||||
-rw-r--r-- | compiler/src/Processors.hs | 17 | ||||
-rw-r--r-- | compiler/src/Resource.hs | 8 |
6 files changed, 34 insertions, 24 deletions
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs index 5d30a26..f4b38d0 100644 --- a/compiler/src/Compiler.hs +++ b/compiler/src/Compiler.hs | |||
@@ -29,7 +29,6 @@ module Compiler | |||
29 | 29 | ||
30 | 30 | ||
31 | import Control.Monad (liftM2) | 31 | import Control.Monad (liftM2) |
32 | import Data.Function ((&)) | ||
33 | import Data.List (any) | 32 | import Data.List (any) |
34 | import Data.Maybe (isJust, fromMaybe) | 33 | import Data.Maybe (isJust, fromMaybe) |
35 | import Text.Regex (Regex, mkRegex, matchRegex) | 34 | import Text.Regex (Regex, mkRegex, matchRegex) |
@@ -39,7 +38,7 @@ import Data.Aeson (ToJSON) | |||
39 | import qualified Data.Aeson as JSON | 38 | import qualified Data.Aeson as JSON |
40 | 39 | ||
41 | import Config | 40 | import Config |
42 | import Input (decodeYamlFile, readInputTree) | 41 | import Input (readInputTree) |
43 | import Resource (buildGalleryTree, galleryCleanupResourceDir) | 42 | import Resource (buildGalleryTree, galleryCleanupResourceDir) |
44 | import Files | 43 | import Files |
45 | ( FileName | 44 | ( FileName |
@@ -55,11 +54,22 @@ import Processors | |||
55 | , skipCached, withCached ) | 54 | , skipCached, withCached ) |
56 | 55 | ||
57 | 56 | ||
57 | galleryConf :: String | ||
58 | galleryConf = "gallery.yaml" | 58 | galleryConf = "gallery.yaml" |
59 | |||
60 | indexFile :: String | ||
59 | indexFile = "index.json" | 61 | indexFile = "index.json" |
62 | |||
63 | viewerMainFile :: String | ||
60 | viewerMainFile = "index.html" | 64 | viewerMainFile = "index.html" |
65 | |||
66 | viewerConfFile :: String | ||
61 | viewerConfFile = "viewer.json" | 67 | viewerConfFile = "viewer.json" |
68 | |||
69 | itemsDir :: String | ||
62 | itemsDir = "items" | 70 | itemsDir = "items" |
71 | |||
72 | thumbnailsDir :: String | ||
63 | thumbnailsDir = "thumbnails" | 73 | thumbnailsDir = "thumbnails" |
64 | 74 | ||
65 | 75 | ||
diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs index 9bb2860..c6d77af 100644 --- a/compiler/src/Config.hs +++ b/compiler/src/Config.hs | |||
@@ -1,7 +1,7 @@ | |||
1 | -- ldgallery - A static generator which turns a collection of tagged | 1 | -- ldgallery - A static generator which turns a collection of tagged |
2 | -- pictures into a searchable web gallery. | 2 | -- pictures into a searchable web gallery. |
3 | -- | 3 | -- |
4 | -- Copyright (C) 2019 Pacien TRAN-GIRARD | 4 | -- Copyright (C) 2019-2020 Pacien TRAN-GIRARD |
5 | -- | 5 | -- |
6 | -- This program is free software: you can redistribute it and/or modify | 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 | 7 | -- it under the terms of the GNU Affero General Public License as |
@@ -30,9 +30,8 @@ module Config | |||
30 | ) where | 30 | ) where |
31 | 31 | ||
32 | 32 | ||
33 | import Data.Text (Text) | ||
34 | import GHC.Generics (Generic) | 33 | import GHC.Generics (Generic) |
35 | import Data.Aeson (ToJSON, FromJSON, withObject, (.:?), (.!=)) | 34 | import Data.Aeson (FromJSON, withObject, (.:?), (.!=)) |
36 | import qualified Data.Aeson as JSON | 35 | import qualified Data.Aeson as JSON |
37 | 36 | ||
38 | import Files (FileName) | 37 | import Files (FileName) |
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs index 53f9c9e..291a1c5 100644 --- a/compiler/src/Files.hs +++ b/compiler/src/Files.hs | |||
@@ -34,9 +34,9 @@ module Files | |||
34 | ) where | 34 | ) where |
35 | 35 | ||
36 | 36 | ||
37 | import Control.Monad (filterM, mapM) | 37 | import Control.Monad (mapM) |
38 | import Data.Bool (bool) | 38 | import Data.Bool (bool) |
39 | import Data.List (isPrefixOf, length, deleteBy, subsequences) | 39 | import Data.List (isPrefixOf, length, subsequences) |
40 | import Data.Function ((&)) | 40 | import Data.Function ((&)) |
41 | import Data.Text (pack) | 41 | import Data.Text (pack) |
42 | import Data.Aeson (ToJSON) | 42 | import Data.Aeson (ToJSON) |
@@ -80,6 +80,7 @@ file /> (Path path) = Path (path ++ [file]) | |||
80 | (<.>) :: Path -> String -> Path | 80 | (<.>) :: Path -> String -> Path |
81 | (Path (filename:pathto)) <.> ext = | 81 | (Path (filename:pathto)) <.> ext = |
82 | Path $ System.FilePath.addExtension filename ext : pathto | 82 | Path $ System.FilePath.addExtension filename ext : pathto |
83 | (Path _) <.> ext = Path [ext] | ||
83 | 84 | ||
84 | fileName :: Path -> Maybe FileName | 85 | fileName :: Path -> Maybe FileName |
85 | fileName (Path (name:_)) = Just name | 86 | fileName (Path (name:_)) = Just name |
diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs index 7e1b169..ab2bc3c 100644 --- a/compiler/src/Input.hs +++ b/compiler/src/Input.hs | |||
@@ -31,10 +31,10 @@ module Input | |||
31 | 31 | ||
32 | 32 | ||
33 | import GHC.Generics (Generic) | 33 | import GHC.Generics (Generic) |
34 | import Control.Exception (Exception, throwIO) | 34 | import Control.Exception (Exception, AssertionFailed(..), throw, throwIO) |
35 | import Control.Monad.IO.Class (MonadIO, liftIO) | 35 | import Control.Monad.IO.Class (MonadIO, liftIO) |
36 | import Data.Function ((&)) | 36 | import Data.Function ((&)) |
37 | import Data.Maybe (mapMaybe, catMaybes) | 37 | import Data.Maybe (catMaybes) |
38 | import Data.Bool (bool) | 38 | import Data.Bool (bool) |
39 | import Data.List (find) | 39 | import Data.List (find) |
40 | import Data.Yaml (ParseException, decodeFileEither) | 40 | import Data.Yaml (ParseException, decodeFileEither) |
@@ -90,6 +90,8 @@ readSidecarFile filepath = | |||
90 | 90 | ||
91 | 91 | ||
92 | readInputTree :: AnchoredFSNode -> IO InputTree | 92 | readInputTree :: AnchoredFSNode -> IO InputTree |
93 | readInputTree (AnchoredFSNode _ File{}) = | ||
94 | throw $ AssertionFailed "Input directory is a file" | ||
93 | readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root | 95 | readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root |
94 | where | 96 | where |
95 | mkInputNode :: FSNode -> IO (Maybe InputTree) | 97 | mkInputNode :: FSNode -> IO (Maybe InputTree) |
@@ -101,7 +103,8 @@ readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root | |||
101 | mkInputNode dir@Dir{} = mkDirNode dir >>= return . Just | 103 | mkInputNode dir@Dir{} = mkDirNode dir >>= return . Just |
102 | 104 | ||
103 | mkDirNode :: FSNode -> IO InputTree | 105 | mkDirNode :: FSNode -> IO InputTree |
104 | mkDirNode (Dir path items) = | 106 | mkDirNode File{} = throw $ AssertionFailed "Input directory is a file" |
107 | mkDirNode Dir{path, items} = | ||
105 | mapM mkInputNode items | 108 | mapM mkInputNode items |
106 | >>= return . catMaybes | 109 | >>= return . catMaybes |
107 | >>= return . InputDir path (findThumbnail items) | 110 | >>= return . InputDir path (findThumbnail items) |
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index 2525af4..6ee8c78 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs | |||
@@ -32,7 +32,7 @@ module Processors | |||
32 | ) where | 32 | ) where |
33 | 33 | ||
34 | 34 | ||
35 | import Control.Exception (Exception, throwIO) | 35 | import Control.Exception (Exception, PatternMatchFail(..), throw, throwIO) |
36 | import Data.Function ((&)) | 36 | import Data.Function ((&)) |
37 | import Data.Ratio ((%)) | 37 | import Data.Ratio ((%)) |
38 | import Data.Char (toLower) | 38 | import Data.Char (toLower) |
@@ -90,12 +90,13 @@ resizeStaticImageUpTo Jpg = resizeStaticGeneric readJpeg (saveJpgImage 80) | |||
90 | resizeStaticImageUpTo Png = resizeStaticGeneric readPng savePngImage | 90 | resizeStaticImageUpTo Png = resizeStaticGeneric readPng savePngImage |
91 | resizeStaticImageUpTo Tiff = resizeStaticGeneric readTiff saveTiffImage | 91 | resizeStaticImageUpTo Tiff = resizeStaticGeneric readTiff saveTiffImage |
92 | resizeStaticImageUpTo Hdr = resizeStaticGeneric readHDR saveRadianceImage | 92 | resizeStaticImageUpTo Hdr = resizeStaticGeneric readHDR saveRadianceImage |
93 | resizeStaticImageUpTo Gif = resizeStaticGeneric readGif writeGifImage | 93 | resizeStaticImageUpTo Gif = resizeStaticGeneric readGif saveGifImage' |
94 | where | 94 | where |
95 | writeGifImage :: StaticImageWriter | 95 | saveGifImage' :: StaticImageWriter |
96 | writeGifImage outputPath image = | 96 | saveGifImage' outputPath image = |
97 | saveGifImage outputPath image | 97 | saveGifImage outputPath image |
98 | & either (throwIO . ProcessingException outputPath) id | 98 | & either (throwIO . ProcessingException outputPath) id |
99 | resizeStaticImageUpTo _ = throw $ PatternMatchFail "Unhandled format" | ||
99 | 100 | ||
100 | 101 | ||
101 | type StaticImageReader = FilePath -> IO (Either String DynamicImage) | 102 | type StaticImageReader = FilePath -> IO (Either String DynamicImage) |
@@ -166,14 +167,14 @@ type ItemFileProcessor = | |||
166 | -> ItemProcessor | 167 | -> ItemProcessor |
167 | 168 | ||
168 | itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor | 169 | itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor |
169 | itemFileProcessor maxRes cached inputBase outputBase resClass inputRes = | 170 | itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes = |
170 | cached processor inPath outPath | 171 | cached processor inPath outPath |
171 | >> return (relOutPath, props) | 172 | >> return (relOutPath, props) |
172 | where | 173 | where |
173 | relOutPath = resClass /> inputRes | 174 | relOutPath = resClass /> inputRes |
174 | inPath = localPath $ inputBase /> inputRes | 175 | inPath = localPath $ inputBase /> inputRes |
175 | outPath = localPath $ outputBase /> relOutPath | 176 | outPath = localPath $ outputBase /> relOutPath |
176 | (processor, props) = formatProcessor maxRes $ formatFromPath inputRes | 177 | (processor, props) = formatProcessor maxResolution $ formatFromPath inputRes |
177 | 178 | ||
178 | formatProcessor :: Maybe Resolution -> Format -> (FileProcessor, GalleryItemProps) | 179 | formatProcessor :: Maybe Resolution -> Format -> (FileProcessor, GalleryItemProps) |
179 | formatProcessor Nothing _ = (copyFileProcessor, Other) | 180 | formatProcessor Nothing _ = (copyFileProcessor, Other) |
@@ -203,8 +204,8 @@ thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes = | |||
203 | 204 | ||
204 | process :: Maybe FileProcessor -> IO (Maybe Path) | 205 | process :: Maybe FileProcessor -> IO (Maybe Path) |
205 | process Nothing = return Nothing | 206 | process Nothing = return Nothing |
206 | process (Just processor) = | 207 | process (Just proc) = |
207 | processor inPath outPath | 208 | proc inPath outPath |
208 | >> return (Just relOutPath) | 209 | >> return (Just relOutPath) |
209 | 210 | ||
210 | processor :: Format -> Maybe FileProcessor | 211 | processor :: Format -> Maybe FileProcessor |
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs index b52522c..c09b77a 100644 --- a/compiler/src/Resource.hs +++ b/compiler/src/Resource.hs | |||
@@ -31,8 +31,7 @@ module Resource | |||
31 | 31 | ||
32 | 32 | ||
33 | import Control.Concurrent.ParallelIO.Global (parallel) | 33 | import Control.Concurrent.ParallelIO.Global (parallel) |
34 | import Data.Function ((&)) | 34 | import Data.List ((\\), sortBy) |
35 | import Data.List ((\\), subsequences, sortBy) | ||
36 | import Data.Ord (comparing) | 35 | import Data.Ord (comparing) |
37 | import Data.Char (toLower) | 36 | import Data.Char (toLower) |
38 | import Data.Maybe (mapMaybe, fromMaybe) | 37 | import Data.Maybe (mapMaybe, fromMaybe) |
@@ -57,10 +56,7 @@ encodingOptions = JSON.defaultOptions | |||
57 | } | 56 | } |
58 | 57 | ||
59 | 58 | ||
60 | |||
61 | type Tag = String | 59 | type Tag = String |
62 | type FileSizeKB = Int | ||
63 | |||
64 | 60 | ||
65 | data Resolution = Resolution |