diff options
Diffstat (limited to 'compiler/src')
-rw-r--r-- | compiler/src/Compiler.hs (renamed from compiler/src/Lib.hs) | 64 | ||||
-rw-r--r-- | compiler/src/Config.hs | 8 | ||||
-rw-r--r-- | compiler/src/Files.hs | 31 | ||||
-rw-r--r-- | compiler/src/Gallery.hs | 15 | ||||
-rw-r--r-- | compiler/src/Input.hs | 12 | ||||
-rw-r--r-- | compiler/src/Processors.hs | 221 | ||||
-rw-r--r-- | compiler/src/Resource.hs | 65 |
7 files changed, 341 insertions, 75 deletions
diff --git a/compiler/src/Lib.hs b/compiler/src/Compiler.hs index b2bbe15..9767394 100644 --- a/compiler/src/Lib.hs +++ b/compiler/src/Compiler.hs | |||
@@ -1,5 +1,3 @@ | |||
1 | {-# LANGUAGE DuplicateRecordFields, DeriveGeneric, DeriveAnyClass #-} | ||
2 | |||
3 | -- ldgallery - A static generator which turns a collection of tagged | 1 | -- ldgallery - A static generator which turns a collection of tagged |
4 | -- pictures into a searchable web gallery. | 2 | -- pictures into a searchable web gallery. |
5 | -- | 3 | -- |
@@ -18,12 +16,18 @@ | |||
18 | -- You should have received a copy of the GNU Affero General Public License | 16 | -- You should have received a copy of the GNU Affero General Public License |
19 | -- along with this program. If not, see <https://www.gnu.org/licenses/>. | 17 | -- along with this program. If not, see <https://www.gnu.org/licenses/>. |
20 | 18 | ||
19 | {-# LANGUAGE | ||
20 | DuplicateRecordFields | ||
21 | , DeriveGeneric | ||
22 | , DeriveAnyClass | ||
23 | #-} | ||
21 | 24 | ||
22 | module Lib | 25 | module Compiler |
23 | ( testRun | 26 | ( compileGallery |
24 | ) where | 27 | ) where |
25 | 28 | ||
26 | 29 | ||
30 | import Control.Monad | ||
27 | import Data.Function ((&)) | 31 | import Data.Function ((&)) |
28 | import Data.Ord (comparing) | 32 | import Data.Ord (comparing) |
29 | import Data.List (sortBy, length) | 33 | import Data.List (sortBy, length) |
@@ -34,42 +38,49 @@ import Data.Aeson (ToJSON) | |||
34 | import qualified Data.Aeson as JSON | 38 | import qualified Data.Aeson as JSON |
35 | 39 | ||
36 | import Config | 40 | import Config |
37 | import Files (FileName, readDirectory, localPath, flattenDir, root, (/>)) | 41 | import Files (FileName, readDirectory, localPath, isHidden, nodeName, filterDir, flattenDir, root, (/>), ensureParentDir) |
38 | import Input (decodeYamlFile, readInputTree) | 42 | import Input (decodeYamlFile, readInputTree) |
39 | import Resource (ResourceTree, buildResourceTree, outputDiff) | 43 | import Resource (ResourceTree, buildResourceTree, outputDiff) |
40 | import Gallery (buildGalleryTree) | 44 | import Gallery (buildGalleryTree) |
45 | import Processors | ||
46 | |||
47 | |||
48 | itemsDir :: String | ||
49 | itemsDir = "items" | ||
41 | 50 | ||
51 | thumbnailsDir :: String | ||
52 | thumbnailsDir = "thumbnails" | ||
42 | 53 | ||
43 | process :: FilePath -> FilePath -> IO () | 54 | |
44 | process inputDirPath outputDirPath = | 55 | compileGallery :: FilePath -> FilePath -> IO () |
56 | compileGallery inputDirPath outputDirPath = | ||
45 | do | 57 | do |
46 | config <- readConfig (inputDirPath </> "gallery.yaml") | 58 | config <- readConfig (inputDirPath </> "gallery.yaml") |
47 | inputDir <- readDirectory inputDirPath | 59 | inputDir <- readDirectory inputDirPath |
48 | inputTree <- readInputTree inputDir | ||
49 | 60 | ||
50 | let resourceTree = buildResourceTree inputTree | 61 | let isGalleryFile = \n -> nodeName n == "gallery.yaml" |
51 | putStrLn "\nRESOURCE TREE" | 62 | let galleryTree = filterDir (liftM2 (&&) (not . isGalleryFile) (not . isHidden)) inputDir |
52 | putStrLn (show resourceTree) | ||
53 | 63 | ||
54 | -- TODO: make buildResourceTree build a resource compilation strategy | 64 | inputTree <- readInputTree galleryTree |
55 | -- (need to know the settings) | ||
56 | -- flatten the tree of resources and their strategies | ||
57 | -- filter resources that are already up to date | ||
58 | -- (or recompile everything if the config file has changed!) | ||
59 | -- execute in parallel | ||
60 | 65 | ||
61 | -- TODO: execute (in parallel) the resource compilation strategy list | 66 | let dirProc = dirFileProcessor inputDirPath outputDirPath itemsDir |
62 | -- need to find a good library for that | 67 | let itemProc = itemFileProcessor Nothing skipCached inputDirPath outputDirPath itemsDir |
68 | let thumbnailProc = thumbnailFileProcessor (Resolution 150 50) skipCached inputDirPath outputDirPath thumbnailsDir | ||
69 | resourceTree <- buildResourceTree dirProc itemProc thumbnailProc inputTree | ||
63 | 70 | ||
64 | cleanup resourceTree outputDirPath | 71 | putStrLn "\nRESOURCE TREE" |
72 | putStrLn (show resourceTree) | ||
73 | |||
74 | --cleanup resourceTree outputDirPath | ||
65 | 75 | ||
66 | buildGalleryTree resourceTree | 76 | buildGalleryTree resourceTree |
67 | & writeJSON (outputDirPath </> "index.json") | 77 | & ensureParentDir JSON.encodeFile (outputDirPath </> "index.json") |
68 | 78 | ||
69 | viewer config | 79 | viewer config |
70 | & writeJSON (outputDirPath </> "viewer.json") | 80 | & ensureParentDir JSON.encodeFile (outputDirPath </> "viewer.json") |
71 | 81 | ||
72 | where | 82 | where |
83 | -- TODO: delete all files, then only non-empty dirs | ||
73 | cleanup :: ResourceTree -> FileName -> IO () | 84 | cleanup :: ResourceTree -> FileName -> IO () |
74 | cleanup resourceTree outputDir = | 85 | cleanup resourceTree outputDir = |
75 | readDirectory outputDir | 86 | readDirectory outputDir |
@@ -83,12 +94,3 @@ process inputDirPath outputDirPath = | |||
83 | do | 94 | do |
84 | putStrLn $ "Removing: " ++ path | 95 | putStrLn $ "Removing: " ++ path |
85 | removePathForcibly path | 96 | removePathForcibly path |
86 | |||
87 | writeJSON :: ToJSON a => FileName -> a -> IO () | ||
88 | writeJSON path obj = | ||
89 | createDirectoryIfMissing True (dropFileName path) | ||
90 | >> JSON.encodeFile path obj | ||
91 | |||
92 | |||
93 | testRun :: IO () | ||
94 | testRun = process "../../example" "../../out" | ||
diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs index 6f04818..f147bdd 100644 --- a/compiler/src/Config.hs +++ b/compiler/src/Config.hs | |||
@@ -1,5 +1,3 @@ | |||
1 | {-# LANGUAGE DuplicateRecordFields, DeriveGeneric, DeriveAnyClass #-} | ||
2 | |||
3 | -- ldgallery - A static generator which turns a collection of tagged | 1 | -- ldgallery - A static generator which turns a collection of tagged |
4 | -- pictures into a searchable web gallery. | 2 | -- pictures into a searchable web gallery. |
5 | -- | 3 | -- |
@@ -18,6 +16,11 @@ | |||
18 | -- You should have received a copy of the GNU Affero General Public License | 16 | -- You should have received a copy of the GNU Affero General Public License |
19 | -- along with this program. If not, see <https://www.gnu.org/licenses/>. | 17 | -- along with this program. If not, see <https://www.gnu.org/licenses/>. |
20 | 18 | ||
19 | {-# LANGUAGE | ||
20 | DuplicateRecordFields | ||
21 | , DeriveGeneric | ||
22 | , DeriveAnyClass | ||
23 | #-} | ||
21 | 24 | ||
22 | module Config | 25 | module Config |
23 | ( GalleryConfig(..) | 26 | ( GalleryConfig(..) |
@@ -25,6 +28,7 @@ module Config | |||
25 | , readConfig | 28 | , readConfig |
26 | ) where | 29 | ) where |
27 | 30 | ||
31 | |||
28 | import GHC.Generics (Generic) | 32 | import GHC.Generics (Generic) |
29 | import Data.Aeson (ToJSON, FromJSON) | 33 | import Data.Aeson (ToJSON, FromJSON) |
30 | import qualified Data.Aeson as JSON | 34 | import qualified Data.Aeson as JSON |
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs index 77a8c5b..0392efe 100644 --- a/compiler/src/Files.hs +++ b/compiler/src/Files.hs | |||
@@ -1,5 +1,3 @@ | |||
1 | {-# LANGUAGE DuplicateRecordFields, DeriveGeneric #-} | ||
2 | |||
3 | -- ldgallery - A static generator which turns a collection of tagged | 1 | -- ldgallery - A static generator which turns a collection of tagged |
4 | -- pictures into a searchable web gallery. | 2 | -- pictures into a searchable web gallery. |
5 | -- | 3 | -- |
@@ -18,12 +16,17 @@ | |||
18 | -- You should have received a copy of the GNU Affero General Public License | 16 | -- You should have received a copy of the GNU Affero General Public License |
19 | -- along with this program. If not, see <https://www.gnu.org/licenses/>. | 17 | -- along with this program. If not, see <https://www.gnu.org/licenses/>. |
20 | 18 | ||
19 | {-# LANGUAGE | ||
20 | DuplicateRecordFields | ||
21 | , DeriveGeneric | ||
22 | #-} | ||
21 | 23 | ||
22 | module Files | 24 | module Files |
23 | ( FileName, LocalPath, WebPath, Path | 25 | ( FileName, LocalPath, WebPath, Path |
24 | , (</>), (</), (/>), localPath, webPath | 26 | , (</>), (</), (/>), localPath, webPath |
25 | , FSNode(..), AnchoredFSNode(..) | 27 | , FSNode(..), AnchoredFSNode(..) |
26 | , nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory | 28 | , nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory |
29 | , ensureParentDir | ||
27 | ) where | 30 | ) where |
28 | 31 | ||
29 | 32 | ||
@@ -31,7 +34,7 @@ import Control.Monad (filterM, mapM) | |||
31 | import Data.Bool (bool) | 34 | import Data.Bool (bool) |
32 | import Data.List (isPrefixOf, length, deleteBy) | 35 | import Data.List (isPrefixOf, length, deleteBy) |
33 | import Data.Function ((&)) | 36 | import Data.Function ((&)) |
34 | import System.Directory (doesDirectoryExist, listDirectory) | 37 | import System.Directory (doesDirectoryExist, listDirectory, createDirectoryIfMissing) |
35 | 38 | ||
36 | import qualified System.FilePath | 39 | import qualified System.FilePath |
37 | import qualified System.FilePath.Posix | 40 | import qualified System.FilePath.Posix |
@@ -79,13 +82,17 @@ isHidden node = "." `isPrefixOf` filename && length filename > 1 | |||
79 | -- | DFS with intermediate dirs first. | 82 | -- | DFS with intermediate dirs first. |
80 | flattenDir :: FSNode -> [FSNode] | 83 | flattenDir :: FSNode -> [FSNode] |
81 | flattenDir file@(File _) = [file] | 84 | flattenDir file@(File _) = [file] |
82 | flattenDir dir@(Dir _ childs) = dir:(concatMap flattenDir childs) | 85 | flattenDir dir@(Dir _ items) = dir:(concatMap flattenDir items) |
83 | 86 | ||
84 | -- | Filters a dir tree. The root is always returned. | 87 | -- | Filters a dir tree. The root is always returned. |
85 | filterDir :: (FSNode -> Bool) -> FSNode -> FSNode | 88 | filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode |
86 | filterDir _ file@(File _) = file | 89 | filterDir cond (AnchoredFSNode anchor root) = |
87 | filterDir cond (Dir path childs) = | 90 | AnchoredFSNode anchor (filterNode root) |
88 | filter cond childs & map (filterDir cond) & Dir path | 91 | where |
92 | filterNode :: FSNode -> FSNode | ||
93 | filterNode file@(File _) = file | ||
94 | filterNode (Dir path items) = | ||
95 | filter cond items & map filterNode & Dir path | ||
89 | 96 | ||
90 | readDirectory :: LocalPath -> IO AnchoredFSNode | 97 | readDirectory :: LocalPath -> IO AnchoredFSNode |
91 | readDirectory root = mkNode [] >>= return . AnchoredFSNode root | 98 | readDirectory root = mkNode [] >>= return . AnchoredFSNode root |
@@ -103,3 +110,11 @@ readDirectory root = mkNode [] >>= return . AnchoredFSNode root | |||
103 | (listDirectory $ localPath (root /> path)) | 110 | (listDirectory $ localPath (root /> path)) |
104 | >>= mapM (mkNode . ((</) path)) | 111 | >>= mapM (mkNode . ((</) path)) |
105 | >>= return . Dir path | 112 | >>= return . Dir path |
113 | |||
114 | |||
115 | ensureParentDir :: (FileName -> a -> IO b) -> FileName -> a -> IO b | ||
116 | ensureParentDir writer filePath a = | ||
117 | createDirectoryIfMissing True parentDir | ||
118 | >> writer filePath a | ||
119 | where | ||