diff options
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/package.yaml | 1 | ||||
-rw-r--r-- | compiler/src/Compiler.hs | 20 | ||||
-rw-r--r-- | compiler/src/Files.hs | 49 | ||||
-rw-r--r-- | compiler/src/Processors.hs | 6 | ||||
-rw-r--r-- | compiler/src/Resource.hs | 21 |
5 files changed, 63 insertions, 34 deletions
diff --git a/compiler/package.yaml b/compiler/package.yaml index 9b96d17..1769833 100644 --- a/compiler/package.yaml +++ b/compiler/package.yaml | |||
@@ -17,6 +17,7 @@ description: Please see the README on GitHub at <https://github.com/paci | |||
17 | dependencies: | 17 | dependencies: |
18 | - base >= 4.7 && < 5 | 18 | - base >= 4.7 && < 5 |
19 | - containers | 19 | - containers |
20 | - data-ordlist | ||
20 | - filepath | 21 | - filepath |
21 | - directory | 22 | - directory |
22 | - text | 23 | - text |
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs index 8819ffc..d392f74 100644 --- a/compiler/src/Compiler.hs +++ b/compiler/src/Compiler.hs | |||
@@ -26,6 +26,7 @@ import Control.Monad (liftM2) | |||
26 | import Data.List (any) | 26 | import Data.List (any) |
27 | import System.FilePath ((</>)) | 27 | import System.FilePath ((</>)) |
28 | import qualified System.FilePath.Glob as Glob | 28 | import qualified System.FilePath.Glob as Glob |
29 | import System.Directory (canonicalizePath) | ||
29 | 30 | ||
30 | import Data.Aeson (ToJSON) | 31 | import Data.Aeson (ToJSON) |
31 | import qualified Data.Aeson as JSON | 32 | import qualified Data.Aeson as JSON |
@@ -52,9 +53,6 @@ galleryConf = "gallery.yaml" | |||
52 | indexFile :: String | 53 | indexFile :: String |
53 | indexFile = "index.json" | 54 | indexFile = "index.json" |
54 | 55 | ||
55 | viewerMainFile :: String | ||
56 | viewerMainFile = "index.html" | ||
57 | |||
58 | viewerConfFile :: String | 56 | viewerConfFile :: String |
59 | viewerConfFile = "viewer.json" | 57 | viewerConfFile = "viewer.json" |
60 | 58 | ||
@@ -72,11 +70,11 @@ writeJSON outputPath object = | |||
72 | ensureParentDir JSON.encodeFile outputPath object | 70 | ensureParentDir JSON.encodeFile outputPath object |
73 | 71 | ||
74 | 72 | ||
75 | galleryDirFilter :: CompilerConfig -> FSNode -> Bool | 73 | galleryDirFilter :: CompilerConfig -> FilePath -> FSNode -> Bool |
76 | galleryDirFilter config = | 74 | galleryDirFilter config outputDir = |
77 | (not . isHidden) | 75 | (not . isHidden) |
76 | &&& (not . isOutputGallery) | ||
78 | &&& (not . matchesFile (== galleryConf)) | 77 | &&& (not . matchesFile (== galleryConf)) |
79 | &&& (not . containsOutputGallery) | ||
80 | &&& ((matchesDir $ anyPattern $ includedDirectories config) ||| | 78 | &&& ((matchesDir $ anyPattern $ includedDirectories config) ||| |
81 | (matchesFile $ anyPattern $ includedFiles config)) | 79 | (matchesFile $ anyPattern $ includedFiles config)) |
82 | &&& (not . ((matchesDir $ anyPattern $ excludedDirectories config) ||| | 80 | &&& (not . ((matchesDir $ anyPattern $ excludedDirectories config) ||| |
@@ -97,10 +95,9 @@ galleryDirFilter config = | |||
97 | anyPattern :: [String] -> FileName -> Bool | 95 | anyPattern :: [String] -> FileName -> Bool |
98 | anyPattern patterns filename = any (flip Glob.match filename) (map Glob.compile patterns) | 96 | anyPattern patterns filename = any (flip Glob.match filename) (map Glob.compile patterns) |
99 | 97 | ||
100 | containsOutputGallery :: FSNode -> Bool | 98 | isOutputGallery :: FSNode -> Bool |
101 | containsOutputGallery File{} = False | 99 | isOutputGallery Dir{canonicalPath} = canonicalPath == outputDir |
102 | containsOutputGallery Dir{items} = | 100 | isOutputGallery File{} = False |
103 | any (matchesFile (== indexFile) ||| matchesFile (== viewerMainFile)) items | ||
104 | 101 | ||
105 | 102 | ||
106 | compileGallery :: FilePath -> FilePath -> Bool -> Bool -> IO () | 103 | compileGallery :: FilePath -> FilePath -> Bool -> Bool -> IO () |
@@ -110,7 +107,8 @@ compileGallery inputDirPath outputDirPath rebuildAll cleanOutput = | |||
110 | let config = compiler fullConfig | 107 | let config = compiler fullConfig |
111 | 108 | ||
112 | inputDir <- readDirectory inputDirPath | 109 | inputDir <- readDirectory inputDirPath |
113 | let sourceFilter = galleryDirFilter config | 110 | canonicalOutPath <- canonicalizePath outputDirPath |
111 | let sourceFilter = galleryDirFilter config canonicalOutPath | ||
114 | let sourceTree = filterDir sourceFilter inputDir | 112 | let sourceTree = filterDir sourceFilter inputDir |
115 | inputTree <- readInputTree sourceTree | 113 | inputTree <- readInputTree sourceTree |
116 | 114 | ||
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs index 41fc5a8..8ea943f 100644 --- a/compiler/src/Files.hs +++ b/compiler/src/Files.hs | |||
@@ -29,7 +29,6 @@ module Files | |||
29 | 29 | ||
30 | 30 | ||
31 | import Control.Monad (mapM) | 31 | import Control.Monad (mapM) |
32 | import Data.Bool (bool) | ||
33 | import Data.List (isPrefixOf, length, subsequences) | 32 | import Data.List (isPrefixOf, length, subsequences) |
34 | import Data.Function ((&)) | 33 | import Data.Function ((&)) |
35 | import Data.Text (pack) | 34 | import Data.Text (pack) |
@@ -39,6 +38,7 @@ import qualified Data.Aeson as JSON | |||
39 | import System.Directory | 38 | import System.Directory |
40 | ( doesDirectoryExist | 39 | ( doesDirectoryExist |
41 | , doesPathExist | 40 | , doesPathExist |
41 | , canonicalizePath | ||
42 | , getModificationTime | 42 | , getModificationTime |
43 | , listDirectory | 43 | , listDirectory |
44 | , createDirectoryIfMissing | 44 | , createDirectoryIfMissing |
@@ -94,8 +94,13 @@ webPath (Path path) = System.FilePath.Posix.joinPath $ reverse path | |||
94 | 94 | ||
95 | 95 | ||
96 | data FSNode = | 96 | data FSNode = |
97 | File { path :: Path } | 97 | File |
98 | | Dir { path :: Path, items :: [FSNode] } | 98 | { path :: Path |
99 | , canonicalPath :: FilePath } | ||
100 | | Dir | ||
101 | { path :: Path | ||
102 | , canonicalPath :: FilePath | ||
103 | , items :: [FSNode] } | ||
99 | deriving Show | 104 | deriving Show |
100 | 105 | ||
101 | data AnchoredFSNode = AnchoredFSNode | 106 | data AnchoredFSNode = AnchoredFSNode |
@@ -115,8 +120,8 @@ isHidden = hiddenName . nodeName | |||
115 | 120 | ||
116 | -- | DFS with intermediate dirs first. | 121 | -- | DFS with intermediate dirs first. |
117 | flattenDir :: FSNode -> [FSNode] | 122 | flattenDir :: FSNode -> [FSNode] |
118 | flattenDir file@(File _) = [file] | 123 | flattenDir file@File{} = [file] |
119 | flattenDir dir@(Dir _ items) = dir:(concatMap flattenDir items) | 124 | flattenDir dir@Dir{items} = dir:(concatMap flattenDir items) |
120 | 125 | ||
121 | -- | Filters a dir tree. The root is always returned. | 126 | -- | Filters a dir tree. The root is always returned. |
122 | filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode | 127 | filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode |
@@ -124,35 +129,41 @@ filterDir cond (AnchoredFSNode anchor root) = | |||
124 | AnchoredFSNode anchor (filterNode root) | 129 | AnchoredFSNode anchor (filterNode root) |
125 | where | 130 | where |
126 | filterNode :: FSNode -> FSNode | 131 | filterNode :: FSNode -> FSNode |
127 | filterNode file@(File _) = file | 132 | filterNode file@File{} = file |
128 | filterNode (Dir path items) = | 133 | filterNode Dir{path, canonicalPath, items} = |
129 | filter cond items & map filterNode & Dir path | 134 | filter cond items & map filterNode & Dir path canonicalPath |
130 | 135 | ||
131 | readDirectory :: LocalPath -> IO AnchoredFSNode | 136 | readDirectory :: LocalPath -> IO AnchoredFSNode |
132 | readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root | 137 | readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root |
133 | where | 138 | where |
134 | mkNode :: Path -> IO FSNode | 139 | mkNode :: Path -> IO FSNode |
135 | mkNode path = | 140 | mkNode path = |
136 | (doesDirectoryExist $ localPath (root /> path)) | 141 | do |
137 | >>= bool (mkFileNode path) (mkDirNode path) | 142 | let relPath = localPath (root /> path) |
138 | 143 | canonicalPath <- canonicalizePath relPath | |
139 | mkFileNode :: Path -> IO FSNode | 144 | isDir <- doesDirectoryExist relPath |
140 | mkFileNode path = return $ File path | 145 | if isDir then |
141 | 146 | mkDirNode path canonicalPath | |
142 | mkDirNode :: Path -> IO FSNode | 147 | else |
143 | mkDirNode path = | 148 | mkFileNode path canonicalPath |
149 | |||
150 | mkFileNode :: Path -> FilePath -> IO FSNode | ||
151 | mkFileNode path canonicalPath = return $ File path canonicalPath | ||
152 | |||
153 | mkDirNode :: Path -> FilePath -> IO FSNode | ||
154 | mkDirNode path canonicalPath = | ||
144 | (listDirectory $ localPath (root /> path)) | 155 | (listDirectory $ localPath (root /> path)) |
145 | >>= mapM (mkNode . ((</) path)) | 156 | >>= mapM (mkNode . ((</) path)) |
146 | >>= return . Dir path | 157 | >>= return . Dir path canonicalPath |
147 | 158 | ||
148 | copyTo :: FilePath -> AnchoredFSNode -> IO () | 159 | copyTo :: FilePath -> AnchoredFSNode -> IO () |
149 | copyTo target AnchoredFSNode{anchor, root} = copyNode root | 160 | copyTo target AnchoredFSNode{anchor, root} = copyNode root |
150 | where | 161 | where |
151 | copyNode :: FSNode -> IO () | 162 | copyNode :: FSNode -> IO () |
152 | copyNode (File path) = | 163 | copyNode File{path} = |
153 | copyFile (localPath $ anchor /> path) (localPath $ target /> path) | 164 | copyFile (localPath $ anchor /> path) (localPath $ target /> path) |
154 | 165 | ||
155 | copyNode (Dir path items) = | 166 | copyNode Dir{path, items} = |
156 | createDirectoryIfMissing True (localPath $ target /> path) | 167 | createDirectoryIfMissing True (localPath $ target /> path) |
157 | >> mapM_ copyNode items | 168 | >> mapM_ copyNode items |
158 | 169 | ||
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index 9ddc6ee..fc719af 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs | |||
@@ -87,7 +87,11 @@ resizePictureUpTo maxResolution inputPath outputPath = | |||
87 | maxSize Resolution{width, height} = show width ++ "x" ++ show height ++ ">" | 87 | maxSize Resolution{width, height} = show width ++ "x" ++ show height ++ ">" |
88 | 88 | ||
89 | resize :: FileName -> FileName -> IO () | 89 | resize :: FileName -> FileName -> IO () |
90 | resize input output = callProcess "magick" [input, "-resize", maxSize maxResolution, output] | 90 | resize input output = callProcess "magick" |
91 | [ input | ||
92 | , "-auto-orient" | ||
93 | , "-resize", maxSize maxResolution | ||
94 | , output ] | ||
91 | 95 | ||
92 | 96 | ||
93 | type Cache = FileProcessor -> FileProcessor | 97 | type Cache = FileProcessor -> FileProcessor |
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs index 33f3cf0..400e18a 100644 --- a/compiler/src/Resource.hs +++ b/compiler/src/Resource.hs | |||
@@ -24,8 +24,8 @@ module Resource | |||
24 | 24 | ||
25 | 25 | ||
26 | import Control.Concurrent.ParallelIO.Global (parallel) | 26 | import Control.Concurrent.ParallelIO.Global (parallel) |
27 | import Data.List ((\\), sortBy) | 27 | import Data.List (sortOn) |
28 | import Data.Ord (comparing) | 28 | import Data.List.Ordered (minusBy) |
29 | import Data.Char (toLower) | 29 | import Data.Char (toLower) |
30 | import Data.Maybe (mapMaybe, fromMaybe, maybeToList) | 30 | import Data.Maybe (mapMaybe, fromMaybe, maybeToList) |
31 | import Data.Function ((&)) | 31 | import Data.Function ((&)) |
@@ -218,11 +218,26 @@ galleryOutputDiff resources ref = | |||
218 | . map (resource :: (Thumbnail -> Resource)) | 218 | . map (resource :: (Thumbnail -> Resource)) |
219 | . mapMaybe thumbnail | 219 | . mapMaybe thumbnail |
220 | 220 | ||
221 | (\\) :: [Path] -> [Path] -> [Path] |