aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/src/Compiler.hs21
-rw-r--r--compiler/src/Files.hs39
-rw-r--r--compiler/src/Input.hs26
-rw-r--r--compiler/src/Processors.hs21
-rw-r--r--compiler/src/Resource.hs10
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
25module Compiler 26module Compiler
@@ -30,7 +31,7 @@ module Compiler
30import Control.Monad (liftM2) 31import Control.Monad (liftM2)
31import Data.Function ((&)) 32import Data.Function ((&))
32import Data.List (any) 33import Data.List (any)
33import Data.Maybe (isJust) 34import Data.Maybe (isJust, fromMaybe)
34import Text.Regex (Regex, mkRegex, matchRegex) 35import Text.Regex (Regex, mkRegex, matchRegex)
35import System.FilePath ((</>)) 36import 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
94compileGallery :: FilePath -> FilePath -> Bool -> IO () 95compileGallery :: 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 @@
25module Files 25module 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
84fileName :: Path -> FileName 84fileName :: Path -> Maybe FileName
85fileName (Path (name:_)) = name 85fileName (Path (name:_)) = Just name
86 86fileName _ = Nothing
87maybeFileName :: Path -> Maybe FileName
88maybeFileName (Path (name:_)) = Just name
89maybeFileName _ = Nothing
90 87
91subPaths :: Path -> [Path] 88subPaths :: Path -> [Path]
92subPaths (Path path) = map Path $ subsequences path 89subPaths (Path path) = map Path $ subsequences path
@@ -101,21 +98,25 @@ webPath :: Path -> WebPath
101webPath (Path path) = System.FilePath.Posix.joinPath $ reverse path 98webPath (Path path) = System.FilePath.Posix.joinPath $ reverse path
102 99
103 100
104data FSNode = File Path | Dir Path [FSNode] deriving Show 101data FSNode =
102 File { path :: Path }
103 | Dir { path :: Path, items :: [FSNode] }
104 deriving Show
105
105data AnchoredFSNode = AnchoredFSNode 106data AnchoredFSNode = AnchoredFSNode
106 { anchor :: LocalPath 107 { anchor :: LocalPath
107 , root :: FSNode } deriving Show 108 , root :: FSNode }
109 deriving Show
108 110
109nodePath :: FSNode -> Path 111nodeName :: FSNode -> Maybe FileName
110nodePath (File path) = path 112nodeName = fileName . path
111nodePath (Dir path _) = path
112
113nodeName :: FSNode -> FileName
114nodeName = fileName . nodePath
115 113
116isHidden :: FSNode -> Bool 114isHidden :: FSNode -> Bool
117isHidden node = "." `isPrefixOf` filename &&length filename > 1 115isHidden = 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.
121flattenDir :: FSNode -> [FSNode] 122flattenDir :: 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
25module Input 26module Input
@@ -92,7 +93,7 @@ readInputTree :: AnchoredFSNode -> IO InputTree
92readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root 93readInputTree (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
62formatFromPath :: Path -> Format 62formatFromPath :: Path -> Format
63formatFromPath = aux . (map toLower) . takeExtension . fileName 63formatFromPath = 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 71 fromExt ".hdr" = Hdr
72 aux _ = Unknown 72 fromExt ".gif" = Gif
73 fromExt _ = Unknown
73 74
74 75
75<