aboutsummaryrefslogtreecommitdiff
path: root/compiler/src
diff options
context:
space:
mode:
authorpacien2019-12-27 10:08:19 +0100
committerpacien2019-12-27 10:08:19 +0100
commiteb7a652b2244ffa4dd5ba2440b7879127e7c6078 (patch)
tree71ab010b20a0f8d9f4a99179b68a7a12c081531d /compiler/src
parentaead07929e6ed13375b86539b1679a88993c9cf5 (diff)
downloadldgallery-eb7a652b2244ffa4dd5ba2440b7879127e7c6078.tar.gz
compiler: implement resource processing
but break directory cleanup
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.hs8
-rw-r--r--compiler/src/Files.hs31
-rw-r--r--compiler/src/Gallery.hs15
-rw-r--r--compiler/src/Input.hs12
-rw-r--r--compiler/src/Processors.hs221
-rw-r--r--compiler/src/Resource.hs65
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
22module Lib 25module Compiler
23 ( testRun 26 ( compileGallery
24 ) where 27 ) where
25 28
26 29
30import Control.Monad
27import Data.Function ((&)) 31import Data.Function ((&))
28import Data.Ord (comparing) 32import Data.Ord (comparing)
29import Data.List (sortBy, length) 33import Data.List (sortBy, length)
@@ -34,42 +38,49 @@ import Data.Aeson (ToJSON)
34import qualified Data.Aeson as JSON 38import qualified Data.Aeson as JSON
35 39
36import Config 40import Config
37import Files (FileName, readDirectory, localPath, flattenDir, root, (/>)) 41import Files (FileName, readDirectory, localPath, isHidden, nodeName, filterDir, flattenDir, root, (/>), ensureParentDir)
38import Input (decodeYamlFile, readInputTree) 42import Input (decodeYamlFile, readInputTree)
39import Resource (ResourceTree, buildResourceTree, outputDiff) 43import Resource (ResourceTree, buildResourceTree, outputDiff)
40import Gallery (buildGalleryTree) 44import Gallery (buildGalleryTree)
45import Processors
46
47
48itemsDir :: String
49itemsDir = "items"
41 50
51thumbnailsDir :: String
52thumbnailsDir = "thumbnails"
42 53
43process :: FilePath -> FilePath -> IO () 54
44process inputDirPath outputDirPath = 55compileGallery :: FilePath -> FilePath -> IO ()
56compileGallery 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
93testRun :: IO ()
94testRun = 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
22module Config 25module Config
23 ( GalleryConfig(..) 26 ( GalleryConfig(..)
@@ -25,6 +28,7 @@ module Config
25 , readConfig 28 , readConfig
26 ) where 29 ) where
27 30
31
28import GHC.Generics (Generic) 32import GHC.Generics (Generic)
29import Data.Aeson (ToJSON, FromJSON) 33import Data.Aeson (ToJSON, FromJSON)
30import qualified Data.Aeson as JSON 34import 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
22module Files 24module 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)
31import Data.Bool (bool) 34import Data.Bool (bool)
32import Data.List (isPrefixOf, length, deleteBy) 35import Data.List (isPrefixOf, length, deleteBy)
33import Data.Function ((&)) 36import Data.Function ((&))
34import System.Directory (doesDirectoryExist, listDirectory) 37import System.Directory (doesDirectoryExist, listDirectory, createDirectoryIfMissing)
35 38
36import qualified System.FilePath 39import qualified System.FilePath
37import qualified System.FilePath.Posix 40import 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.
80flattenDir :: FSNode -> [FSNode] 83flattenDir :: FSNode -> [FSNode]
81flattenDir file@(File _) = [file] 84flattenDir file@(File _) = [file]
82flattenDir dir@(Dir _ childs) = dir:(concatMap flattenDir childs) 85flattenDir 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.
85filterDir :: (FSNode -> Bool) -> FSNode -> FSNode 88filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode
86filterDir _ file@(File _) = file 89filterDir cond (AnchoredFSNode anchor root) =
87filterDir 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
90readDirectory :: LocalPath -> IO AnchoredFSNode 97readDirectory :: LocalPath -> IO AnchoredFSNode
91readDirectory root = mkNode [] >>= return . AnchoredFSNode root 98readDirectory 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
115ensureParentDir :: (FileName ->