aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/src/Files.hs11
-rw-r--r--compiler/src/Lib.hs32
-rw-r--r--compiler/src/Resource.hs35
3 files changed, 55 insertions, 23 deletions
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 30e4b94..77a8c5b 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -23,7 +23,7 @@ module Files
23 ( FileName, LocalPath, WebPath, Path 23 ( FileName, LocalPath, WebPath, Path
24 , (</>), (</), (/>), localPath, webPath 24 , (</>), (</), (/>), localPath, webPath
25 , FSNode(..), AnchoredFSNode(..) 25 , FSNode(..), AnchoredFSNode(..)
26 , nodePath, nodeName, isHidden, flatten, filterDir, readDirectory 26 , nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory
27 ) where 27 ) where
28 28
29 29
@@ -76,9 +76,10 @@ isHidden :: FSNode -> Bool
76isHidden node = "." `isPrefixOf` filename && length filename > 1 76isHidden node = "." `isPrefixOf` filename && length filename > 1
77 where filename = nodeName node 77 where filename = nodeName node
78 78
79flatten :: FSNode -> [FSNode] 79-- | DFS with intermediate dirs first.
80flatten file@(File _) = [file] 80flattenDir :: FSNode -> [FSNode]
81flatten dir@(Dir _ childs) = dir:(concatMap flatten childs) 81flattenDir file@(File _) = [file]
82flattenDir dir@(Dir _ childs) = dir:(concatMap flattenDir childs)
82 83
83-- | Filters a dir tree. The root is always returned. 84-- | Filters a dir tree. The root is always returned.
84filterDir :: (FSNode -> Bool) -> FSNode -> FSNode 85filterDir :: (FSNode -> Bool) -> FSNode -> FSNode
@@ -87,7 +88,7 @@ filterDir cond (Dir path childs) =
87 filter cond childs & map (filterDir cond) & Dir path 88 filter cond childs & map (filterDir cond) & Dir path
88 89
89readDirectory :: LocalPath -> IO AnchoredFSNode 90readDirectory :: LocalPath -> IO AnchoredFSNode
90readDirectory root = mkNode [""] >>= return . AnchoredFSNode root 91readDirectory root = mkNode [] >>= return . AnchoredFSNode root
91 where 92 where
92 mkNode :: Path -> IO FSNode 93 mkNode :: Path -> IO FSNode
93 mkNode path = 94 mkNode path =
diff --git a/compiler/src/Lib.hs b/compiler/src/Lib.hs
index 2068b4a..643e5f6 100644
--- a/compiler/src/Lib.hs
+++ b/compiler/src/Lib.hs
@@ -26,15 +26,17 @@ module Lib
26 26
27import GHC.Generics (Generic) 27import GHC.Generics (Generic)
28import Data.Function ((&)) 28import Data.Function ((&))
29import System.Directory (createDirectoryIfMissing) 29import Data.Ord (comparing)
30import Data.List (sortBy, length)
31import System.Directory (createDirectoryIfMissing, removePathForcibly)
30import System.FilePath (dropFileName, (</>)) 32import System.FilePath (dropFileName, (</>))
31 33
32import Data.Aeson (ToJSON, FromJSON) 34import Data.Aeson (ToJSON, FromJSON)
33import qualified Data.Aeson as JSON 35import qualified Data.Aeson as JSON
34 36
35import Files (FileName, readDirectory) 37import Files (FileName, readDirectory, localPath, flattenDir, root, (/>))
36import Input (decodeYamlFile, readInputTree) 38import Input (decodeYamlFile, readInputTree)
37import Resource (buildResourceTree) 39import Resource (ResourceTree, buildResourceTree, outputDiff)
38import Gallery (buildGalleryTree) 40import Gallery (buildGalleryTree)
39 41
40 42
@@ -60,10 +62,6 @@ process inputDirPath outputDirPath =
60 putStrLn "\nINPUT DIR" 62 putStrLn "\nINPUT DIR"
61 putStrLn (show inputDir) 63 putStrLn (show inputDir)
62 64
63 outputDir <- readDirectory outputDirPath
64 putStrLn "\nOUTPUT DIR"
65 putStrLn (show outputDir)
66
67 inputTree <- readInputTree inputDir 65 inputTree <- readInputTree inputDir
68 putStrLn "\nINPUT TREE" 66 putStrLn "\nINPUT TREE"
69 putStrLn (show inputTree) 67 putStrLn (show inputTree)
@@ -79,18 +77,26 @@ process inputDirPath outputDirPath =
79 -- (or recompile everything if the config file has changed!) 77 -- (or recompile everything if the config file has changed!)
80 -- execute in parallel 78 -- execute in parallel
81 79
82 -- TODO: clean up output dir by comparing its content with the resource tree 80 cleanup resourceTree outputDirPath
83 -- aggregate both trees as list
84 -- compute the difference
85 -- sort by deepest and erase files and dirs
86 81
87 -- TODO: execute (in parallel) the resource compilation strategy list 82 -- TODO: execute (in parallel) the resource compilation strategy list
88 -- need to find a good library for that 83 -- need to find a good library for that
89 84
90 buildGalleryTree resourceTree & writeJSON (outputDirPath </> "index.json") 85 buildGalleryTree resourceTree
91 writeJSON (outputDirPath </> "viewer.json") (viewer config) 86 & writeJSON (outputDirPath </> "index.json")
87
88 viewer config
89 & writeJSON (outputDirPath </> "viewer.json")
92 90
93 where 91 where
92 cleanup :: ResourceTree -> FileName -> IO ()
93 cleanup resourceTree outputDir =
94 readDirectory outputDir
95 >>= return . outputDiff resourceTree . root
96 >>= return . sortBy (flip $ comparing length) -- nested files before dirs
97 >>= return . map (localPath . (/>) outputDir)
98 >>= mapM_ removePathForcibly
99
94 writeJSON :: ToJSON a => FileName -> a -> IO () 100 writeJSON :: ToJSON a => FileName -> a -> IO ()
95 writeJSON path obj = 101 writeJSON path obj =
96 createDirectoryIfMissing True (dropFileName path) 102 createDirectoryIfMissing True (dropFileName path)
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 04e315a..60b783e 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -22,10 +22,13 @@
22module Resource 22module Resource
23 ( ResourceTree(..) 23 ( ResourceTree(..)
24 , buildResourceTree 24 , buildResourceTree
25 , flattenResourceTree
26 , outputDiff
25 ) where 27 ) where
26 28
27 29
28import Data.Function ((&)) 30import Data.Function ((&))
31import Data.List ((\\))
29import Files 32import Files
30import Input 33import Input
31 34
@@ -34,25 +37,47 @@ import Input
34data ResourceTree = 37data ResourceTree =
35 ItemResource 38 ItemResource
36 { sidecar :: Sidecar 39 { sidecar :: Sidecar
37 , path :: Path 40 , resPath :: Path
38 , itemThumbnailPath :: Path } 41 , itemThumbnailPath :: Path }
39 | DirResource 42 | DirResource
40 { items :: [ResourceTree] 43 { items :: [ResourceTree]
41 , path :: Path 44 , resPath :: Path
42 , dirThumbnailPath :: Maybe Path } 45 , dirThumbnailPath :: Maybe Path }
43 deriving Show 46 deriving Show
44 47
45 48
46 -- TODO: actually generate compilation strategies 49-- TODO: actually generate compilation strategies
47buildResourceTree :: InputTree -> ResourceTree 50buildResourceTree :: InputTree -> ResourceTree
48buildResourceTree = resNode 51buildResourceTree = resNode
49 where 52 where
50 resNode (InputFile path sidecar) = 53 resNode (InputFile path sidecar) =
51 ItemResource sidecar (itemsDir /> path) (thumbnailsDir /> path) 54 ItemResource
55 { sidecar = sidecar
56 , resPath = itemsDir /> path
57 , itemThumbnailPath = thumbnailsDir /> path }
52 58
53 resNode (InputDir path thumbnailPath items) = 59 resNode (InputDir path thumbnailPath items) =
54 map resNode items 60 map resNode items
55 & \dirItems -> DirResource dirItems (itemsDir /> path) Nothing 61 & \dirItems -> DirResource
62 { items = dirItems
63 , resPath = itemsDir /> path
64 , dirThumbnailPath = fmap ((/>) thumbnailsDir) thumbnailPath }
56 65
57 itemsDir = "items" 66 itemsDir = "items"
58 thumbnailsDir = "thumbnails" 67 thumbnailsDir = "thumbnails"
68
69
70flattenResourceTree :: ResourceTree -> [ResourceTree]
71flattenResourceTree item@ItemResource{} = [item]
72flattenResourceTree dir@(DirResource items _ _) =
73 dir:(concatMap flattenResourceTree items)
74
75
76outputDiff :: ResourceTree -> FSNode -> [Path]
77outputDiff resources ref = (fsPaths ref) \\ (resPaths resources)
78 where
79 resPaths :: ResourceTree -> [Path]
80 resPaths = map resPath . flattenResourceTree
81
82 fsPaths :: FSNode -> [Path]
83 fsPaths = map nodePath . tail . flattenDir