diff options
-rw-r--r-- | compiler/src/Files.hs | 11 | ||||
-rw-r--r-- | compiler/src/Lib.hs | 32 | ||||
-rw-r--r-- | compiler/src/Resource.hs | 35 |
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 | |||
76 | isHidden node = "." `isPrefixOf` filename && length filename > 1 | 76 | isHidden node = "." `isPrefixOf` filename && length filename > 1 |
77 | where filename = nodeName node | 77 | where filename = nodeName node |
78 | 78 | ||
79 | flatten :: FSNode -> [FSNode] | 79 | -- | DFS with intermediate dirs first. |
80 | flatten file@(File _) = [file] | 80 | flattenDir :: FSNode -> [FSNode] |
81 | flatten dir@(Dir _ childs) = dir:(concatMap flatten childs) | 81 | flattenDir file@(File _) = [file] |
82 | flattenDir 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. |
84 | filterDir :: (FSNode -> Bool) -> FSNode -> FSNode | 85 | filterDir :: (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 | ||
89 | readDirectory :: LocalPath -> IO AnchoredFSNode | 90 | readDirectory :: LocalPath -> IO AnchoredFSNode |
90 | readDirectory root = mkNode [""] >>= return . AnchoredFSNode root | 91 | readDirectory 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 | ||
27 | import GHC.Generics (Generic) | 27 | import GHC.Generics (Generic) |
28 | import Data.Function ((&)) | 28 | import Data.Function ((&)) |
29 | import System.Directory (createDirectoryIfMissing) | 29 | import Data.Ord (comparing) |
30 | import Data.List (sortBy, length) | ||
31 | import System.Directory (createDirectoryIfMissing, removePathForcibly) | ||
30 | import System.FilePath (dropFileName, (</>)) | 32 | import System.FilePath (dropFileName, (</>)) |
31 | 33 | ||
32 | import Data.Aeson (ToJSON, FromJSON) | 34 | import Data.Aeson (ToJSON, FromJSON) |
33 | import qualified Data.Aeson as JSON | 35 | import qualified Data.Aeson as JSON |
34 | 36 | ||
35 | import Files (FileName, readDirectory) | 37 | import Files (FileName, readDirectory, localPath, flattenDir, root, (/>)) |
36 | import Input (decodeYamlFile, readInputTree) | 38 | import Input (decodeYamlFile, readInputTree) |
37 | import Resource (buildResourceTree) | 39 | import Resource (ResourceTree, buildResourceTree, outputDiff) |
38 | import Gallery (buildGalleryTree) | 40 | import 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 @@ | |||
22 | module Resource | 22 | module Resource |
23 | ( ResourceTree(..) | 23 | ( ResourceTree(..) |
24 | , buildResourceTree | 24 | , buildResourceTree |
25 | , flattenResourceTree | ||
26 | , outputDiff | ||
25 | ) where | 27 | ) where |
26 | 28 | ||
27 | 29 | ||
28 | import Data.Function ((&)) | 30 | import Data.Function ((&)) |
31 | import Data.List ((\\)) | ||
29 | import Files | 32 | import Files |
30 | import Input | 33 | import Input |
31 | 34 | ||
@@ -34,25 +37,47 @@ import Input | |||
34 | data ResourceTree = | 37 | data 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 |
47 | buildResourceTree :: InputTree -> ResourceTree | 50 | buildResourceTree :: InputTree -> ResourceTree |
48 | buildResourceTree = resNode | 51 | buildResourceTree = 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 | |||
70 | flattenResourceTree :: ResourceTree -> [ResourceTree] | ||
71 | flattenResourceTree item@ItemResource{} = [item] | ||
72 | flattenResourceTree dir@(DirResource items _ _) = | ||
73 | dir:(concatMap flattenResourceTree items) | ||
74 | |||
75 | |||
76 | outputDiff :: ResourceTree -> FSNode -> [Path] | ||
77 | outputDiff 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 | ||