diff options
Diffstat (limited to 'compiler/src')
-rw-r--r-- | compiler/src/Compiler.hs | 21 | ||||
-rw-r--r-- | compiler/src/Files.hs | 39 | ||||
-rw-r--r-- | compiler/src/Input.hs | 26 | ||||
-rw-r--r-- | compiler/src/Processors.hs | 21 | ||||
-rw-r--r-- | compiler/src/Resource.hs | 10 |
5 files changed, 65 insertions, 52 deletions
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs index 4f2093b..5d30a26 100644 --- a/compiler/src/Compiler.hs +++ b/compiler/src/Compiler.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 |
@@ -20,6 +20,7 @@ | |||
20 | DuplicateRecordFields | 20 | DuplicateRecordFields |
21 | , DeriveGeneric | 21 | , DeriveGeneric |
22 | , DeriveAnyClass | 22 | , DeriveAnyClass |
23 | , NamedFieldPuns | ||
23 | #-} | 24 | #-} |
24 | 25 | ||
25 | module Compiler | 26 | module Compiler |
@@ -30,7 +31,7 @@ module Compiler | |||
30 | import Control.Monad (liftM2) | 31 | import Control.Monad (liftM2) |
31 | import Data.Function ((&)) | 32 | import Data.Function ((&)) |
32 | import Data.List (any) | 33 | import Data.List (any) |
33 | import Data.Maybe (isJust) | 34 | import Data.Maybe (isJust, fromMaybe) |
34 | import Text.Regex (Regex, mkRegex, matchRegex) | 35 | import Text.Regex (Regex, mkRegex, matchRegex) |
35 | import System.FilePath ((</>)) | 36 | import System.FilePath ((</>)) |
36 | 37 | ||
@@ -80,15 +81,15 @@ galleryDirFilter excludeRegex = | |||
80 | (&&&) = liftM2 (&&) | 81 | (&&&) = liftM2 (&&) |
81 | (|||) = liftM2 (||) | 82 | (|||) = liftM2 (||) |
82 | 83 | ||
83 | isConfigFile = (galleryConf ==) . nodeName | 84 | matchName :: (FileName -> Bool) -> FSNode -> Bool |
85 | matchName cond = maybe False cond . nodeName | ||
84 | 86 | ||
85 | isGalleryIndex = (indexFile ==) | 87 | isConfigFile = matchName (== galleryConf) |
86 | isViewerIndex = (viewerMainFile ==) | 88 | isGalleryIndex = matchName (== indexFile) |
87 | containsOutputGallery (File _) = False | 89 | isViewerIndex = matchName (== viewerMainFile) |
88 | containsOutputGallery (Dir _ items) = | 90 | containsOutputGallery File{} = False |
89 | any ((isGalleryIndex ||| isViewerIndex) . nodeName) items | 91 | containsOutputGallery Dir{items} = any (isGalleryIndex ||| isViewerIndex) items |
90 | 92 | excludedName = isJust . matchRegex excludeRegex . fromMaybe "" . nodeName | |
91 | excludedName = isJust . matchRegex excludeRegex . nodeName | ||
92 | 93 | ||
93 | 94 | ||
94 | compileGallery :: FilePath -> FilePath -> Bool -> IO () | 95 | compileGallery :: FilePath -> FilePath -> Bool -> IO () |
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs index a658ded..53f9c9e 100644 --- a/compiler/src/Files.hs +++ b/compiler/src/Files.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 |
@@ -25,10 +25,10 @@ | |||
25 | module Files | 25 | module Files |
26 | ( FileName, LocalPath, WebPath, Path | 26 | ( FileName, LocalPath, WebPath, Path |
27 | , (</>), (</), (/>), (<.>) | 27 | , (</>), (</), (/>), (<.>) |
28 | , fileName, maybeFileName, subPaths, pathLength | 28 | , fileName, subPaths, pathLength |
29 | , localPath, webPath | 29 | , localPath, webPath |
30 | , FSNode(..), AnchoredFSNode(..) | 30 | , FSNode(..), AnchoredFSNode(..) |
31 | , nodePath, nodeName, isHidden, flattenDir, filterDir | 31 | , nodeName, isHidden, flattenDir, filterDir |
32 | , readDirectory, copyTo | 32 | , readDirectory, copyTo |
33 | , ensureParentDir, remove, isOutdated | 33 | , ensureParentDir, remove, isOutdated |
34 | ) where | 34 | ) where |
@@ -81,12 +81,9 @@ file /> (Path path) = Path (path ++ [file]) | |||
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 | 83 | ||
84 | fileName :: Path -> FileName | 84 | fileName :: Path -> Maybe FileName |
85 | fileName (Path (name:_)) = name | 85 | fileName (Path (name:_)) = Just name |
86 | 86 | fileName _ = Nothing | |
87 | maybeFileName :: Path -> Maybe FileName | ||
88 | maybeFileName (Path (name:_)) = Just name | ||
89 | maybeFileName _ = Nothing | ||
90 | 87 | ||
91 | subPaths :: Path -> [Path] | 88 | subPaths :: Path -> [Path] |
92 | subPaths (Path path) = map Path $ subsequences path | 89 | subPaths (Path path) = map Path $ subsequences path |
@@ -101,21 +98,25 @@ webPath :: Path -> WebPath | |||
101 | webPath (Path path) = System.FilePath.Posix.joinPath $ reverse path | 98 | webPath (Path path) = System.FilePath.Posix.joinPath $ reverse path |
102 | 99 | ||
103 | 100 | ||
104 | data FSNode = File Path | Dir Path [FSNode] deriving Show | 101 | data FSNode = |
102 | File { path :: Path } | ||
103 | | Dir { path :: Path, items :: [FSNode] } | ||
104 | deriving Show | ||
105 | |||
105 | data AnchoredFSNode = AnchoredFSNode | 106 | data AnchoredFSNode = AnchoredFSNode |
106 | { anchor :: LocalPath | 107 | { anchor :: LocalPath |
107 | , root :: FSNode } deriving Show | 108 | , root :: FSNode } |
109 | deriving Show | ||
108 | 110 | ||
109 | nodePath :: FSNode -> Path | 111 | nodeName :: FSNode -> Maybe FileName |
110 | nodePath (File path) = path | 112 | nodeName = fileName . path |
111 | nodePath (Dir path _) = path | ||
112 | |||
113 | nodeName :: FSNode -> FileName | ||
114 | nodeName = fileName . nodePath | ||
115 | 113 | ||
116 | isHidden :: FSNode -> Bool | 114 | isHidden :: FSNode -> Bool |
117 | isHidden node = "." `isPrefixOf` filename &&length filename > 1 | 115 | isHidden = hiddenName . nodeName |
118 | where filename = nodeName node | 116 | where |
117 | hiddenName :: Maybe FileName -> Bool | ||
118 | hiddenName Nothing = False | ||
119 | hiddenName (Just filename) = "." `isPrefixOf` filename && length filename > 1 | ||
119 | 120 | ||
120 | -- | DFS with intermediate dirs first. | 121 | -- | DFS with intermediate dirs first. |
121 | flattenDir :: FSNode -> [FSNode] | 122 | flattenDir :: FSNode -> [FSNode] |
diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs index 2e11ebe..7e1b169 100644 --- a/compiler/src/Input.hs +++ b/compiler/src/Input.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 |
@@ -20,6 +20,7 @@ | |||
20 | DuplicateRecordFields | 20 | DuplicateRecordFields |
21 | , DeriveGeneric | 21 | , DeriveGeneric |
22 | , DeriveAnyClass | 22 | , DeriveAnyClass |
23 | , NamedFieldPuns | ||
23 | #-} | 24 | #-} |
24 | 25 | ||
25 | module Input | 26 | module Input |
@@ -92,7 +93,7 @@ readInputTree :: AnchoredFSNode -> IO InputTree | |||
92 | readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root | 93 | readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root |
93 | where | 94 | where |
94 | mkInputNode :: FSNode -> IO (Maybe InputTree) | 95 | mkInputNode :: FSNode -> IO (Maybe InputTree) |
95 | mkInputNode (File path) | not (sidecarExt `isExtensionOf` (fileName path)) = | 96 | mkInputNode file@File{path} | not $ isSidecar file = |
96 | readSidecarFile (localPath $ anchor /> path <.> sidecarExt) | 97 | readSidecarFile (localPath $ anchor /> path <.> sidecarExt) |
97 | >>= return . InputFile path | 98 | >>= return . InputFile path |
98 | >>= return . Just | 99 | >>= return . Just |
@@ -104,10 +105,19 @@ readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root | |||
104 | mapM mkInputNode items | 105 | mapM mkInputNode items |
105 | >>= return . catMaybes | 106 | >>= return . catMaybes |
106 | >>= return . InputDir path (findThumbnail items) | 107 | >>= return . InputDir path (findThumbnail items) |
107 | where | ||
108 | findThumbnail :: [FSNode] -> Maybe Path | ||
109 | findThumbnail = (fmap nodePath) . (find matchThumbnail) | ||
110 | 108 | ||
111 | matchThumbnail :: FSNode -> Bool | 109 | isSidecar :: FSNode -> Bool |
112 | matchThumbnail Dir{} = False | 110 | isSidecar Dir{} = False |
113 | matchThumbnail (File path) = (dropExtension $ fileName path) == "thumbnail" | 111 | isSidecar File{path} = |
112 | fileName path | ||
113 | & (maybe False $ isExtensionOf sidecarExt) | ||
114 | |||
115 | isThumbnail :: FSNode -> Bool | ||
116 | isThumbnail Dir{} = False | ||
117 | isThumbnail File{path} = | ||
118 | fileName path | ||
119 | & fmap dropExtension | ||
120 | & (maybe False ("thumbnail" ==)) | ||
121 | |||
122 | findThumbnail :: [FSNode] -> Maybe Path | ||
123 | findThumbnail = (fmap Files.path) . (find isThumbnail) | ||
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index dab9aaa..2525af4 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.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 |
@@ -60,16 +60,17 @@ data Format = | |||
60 | | Unknown | 60 | | Unknown |
61 | 61 | ||
62 | formatFromPath :: Path -> Format | 62 | formatFromPath :: Path -> Format |
63 | formatFromPath = aux . (map toLower) . takeExtension . fileName | 63 | formatFromPath = maybe Unknown fromExt . fmap (map toLower) . fmap takeExtension . fileName |
64 | where | 64 | where |
65 | aux ".bmp" = Bmp | 65 | fromExt :: String -> Format |
66 | aux ".jpg" = Jpg | 66 | fromExt ".bmp" = Bmp |
67 | aux ".jpeg" = Jpg | 67 | fromExt ".jpg" = Jpg |
68 | aux ".png" = Png | 68 | fromExt ".jpeg" = Jpg |
69 | aux ".tiff" = Tiff | 69 | fromExt ".png" = Png |
70 | aux ".hdr" = Hdr | 70 | fromExt ".tiff" = Tiff |
71 | aux ".gif" = Gif |