aboutsummaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-rw-r--r--compiler/app/Main.hs3
-rw-r--r--compiler/package.yaml7
-rw-r--r--compiler/src/Compiler.hs14
-rw-r--r--compiler/src/Config.hs5
-rw-r--r--compiler/src/Files.hs5
-rw-r--r--compiler/src/Input.hs9
-rw-r--r--compiler/src/Processors.hs17
-rw-r--r--compiler/src/Resource.hs8
8 files changed, 43 insertions, 25 deletions
diff --git a/compiler/app/Main.hs b/compiler/app/Main.hs
index 319e984..43a8aeb 100644
--- a/compiler/app/Main.hs
+++ b/compiler/app/Main.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
@@ -38,6 +38,7 @@ data Options = Options
38 , withViewer :: Bool 38 , withViewer :: Bool
39 } deriving (Show, Data, Typeable) 39 } deriving (Show, Data, Typeable)
40 40
41options :: Options
41options = Options 42options = Options
42 { inputDir = "./" 43 { inputDir = "./"
43 &= typDir 44 &= typDir
diff --git a/compiler/package.yaml b/compiler/package.yaml
index 0577bb5..f93c146 100644
--- a/compiler/package.yaml
+++ b/compiler/package.yaml
@@ -28,6 +28,13 @@ dependencies:
28- parallel-io 28- parallel-io
29- regex-compat 29- regex-compat
30 30
31ghc-options:
32- -Wall
33- -Wcompat
34- -Widentities
35- -Wincomplete-uni-patterns
36- -Wredundant-constraints
37
31data-dir: data 38data-dir: data
32data-files: ["**/*"] 39data-files: ["**/*"]
33 40
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
31import Control.Monad (liftM2) 31import Control.Monad (liftM2)
32import Data.Function ((&))
33import Data.List (any) 32import Data.List (any)
34import Data.Maybe (isJust, fromMaybe) 33import Data.Maybe (isJust, fromMaybe)
35import Text.Regex (Regex, mkRegex, matchRegex) 34import Text.Regex (Regex, mkRegex, matchRegex)
@@ -39,7 +38,7 @@ import Data.Aeson (ToJSON)
39import qualified Data.Aeson as JSON 38import qualified Data.Aeson as JSON
40 39
41import Config 40import Config
42import Input (decodeYamlFile, readInputTree) 41import Input (readInputTree)
43import Resource (buildGalleryTree, galleryCleanupResourceDir) 42import Resource (buildGalleryTree, galleryCleanupResourceDir)
44import Files 43import Files
45 ( FileName 44 ( FileName
@@ -55,11 +54,22 @@ import Processors
55 , skipCached, withCached ) 54 , skipCached, withCached )
56 55
57 56
57galleryConf :: String
58galleryConf = "gallery.yaml" 58galleryConf = "gallery.yaml"
59
60indexFile :: String
59indexFile = "index.json" 61indexFile = "index.json"
62
63viewerMainFile :: String
60viewerMainFile = "index.html" 64viewerMainFile = "index.html"
65
66viewerConfFile :: String
61viewerConfFile = "viewer.json" 67viewerConfFile = "viewer.json"
68
69itemsDir :: String
62itemsDir = "items" 70itemsDir = "items"
71
72thumbnailsDir :: String
63thumbnailsDir = "thumbnails" 73thumbnailsDir = "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
33import Data.Text (Text)
34import GHC.Generics (Generic) 33import GHC.Generics (Generic)
35import Data.Aeson (ToJSON, FromJSON, withObject, (.:?), (.!=)) 34import Data.Aeson (FromJSON, withObject, (.:?), (.!=))
36import qualified Data.Aeson as JSON 35import qualified Data.Aeson as JSON
37 36
38import Files (FileName) 37import 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
37import Control.Monad (filterM, mapM) 37import Control.Monad (mapM)
38import Data.Bool (bool) 38import Data.Bool (bool)
39import Data.List (isPrefixOf, length, deleteBy, subsequences) 39import Data.List (isPrefixOf, length, subsequences)
40import Data.Function ((&)) 40import Data.Function ((&))
41import Data.Text (pack) 41import Data.Text (pack)
42import Data.Aeson (ToJSON) 42import 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
84fileName :: Path -> Maybe FileName 85fileName :: Path -> Maybe FileName
85fileName (Path (name:_)) = Just name 86fileName (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
33import GHC.Generics (Generic) 33import GHC.Generics (Generic)
34import Control.Exception (Exception, throwIO) 34import Control.Exception (Exception, AssertionFailed(..), throw, throwIO)
35import Control.Monad.IO.Class (MonadIO, liftIO) 35import Control.Monad.IO.Class (MonadIO, liftIO)
36import Data.Function ((&)) 36import Data.Function ((&))
37import Data.Maybe (mapMaybe, catMaybes) 37import Data.Maybe (catMaybes)
38import Data.Bool (bool) 38import Data.Bool (bool)
39import Data.List (find) 39import Data.List (find)
40import Data.Yaml (ParseException, decodeFileEither) 40import Data.Yaml (ParseException, decodeFileEither)
@@ -90,6 +90,8 @@ readSidecarFile filepath =
90 90
91 91
92readInputTree :: AnchoredFSNode -> IO InputTree 92readInputTree :: AnchoredFSNode -> IO InputTree
93readInputTree (AnchoredFSNode _ File{}) =
94 throw $ AssertionFailed "Input directory is a file"
93readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root 95readInputTree (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
35import Control.Exception (Exception, throwIO) 35import Control.Exception (Exception, PatternMatchFail(..), throw, throwIO)
36import Data.Function ((&)) 36import Data.Function ((&))
37import Data.Ratio ((%)) 37import Data.Ratio ((%))
38import Data.Char (toLower) 38import Data.Char (toLower)
@@ -90,12 +90,13 @@ resizeStaticImageUpTo Jpg = resizeStaticGeneric readJpeg (saveJpgImage 80)
90resizeStaticImageUpTo Png = resizeStaticGeneric readPng savePngImage 90resizeStaticImageUpTo Png = resizeStaticGeneric readPng savePngImage
91resizeStaticImageUpTo Tiff = resizeStaticGeneric readTiff saveTiffImage 91resizeStaticImageUpTo Tiff = resizeStaticGeneric readTiff saveTiffImage
92resizeStaticImageUpTo Hdr = resizeStaticGeneric readHDR saveRadianceImage 92resizeStaticImageUpTo Hdr = resizeStaticGeneric readHDR saveRadianceImage
93resizeStaticImageUpTo Gif = resizeStaticGeneric readGif writeGifImage 93resizeStaticImageUpTo 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
99resizeStaticImageUpTo _ = throw $ PatternMatchFail "Unhandled format"
99 100
100 101
101type StaticImageReader = FilePath -> IO (Either String DynamicImage) 102type StaticImageReader = FilePath -> IO (Either String DynamicImage)
@@ -166,14 +167,14 @@ type ItemFileProcessor =
166 -> ItemProcessor 167 -> ItemProcessor
167 168
168itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor 169itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor
169itemFileProcessor maxRes cached inputBase outputBase resClass inputRes = 170itemFileProcessor 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