diff options
Diffstat (limited to 'compiler/src/Compiler.hs')
-rw-r--r-- | compiler/src/Compiler.hs | 48 |
1 files changed, 13 insertions, 35 deletions
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs index 991de9c..5c47521 100644 --- a/compiler/src/Compiler.hs +++ b/compiler/src/Compiler.hs | |||
@@ -29,10 +29,7 @@ module Compiler | |||
29 | 29 | ||
30 | import Control.Monad | 30 | import Control.Monad |
31 | import Data.Function ((&)) | 31 | import Data.Function ((&)) |
32 | import Data.Ord (comparing) | 32 | import System.FilePath ((</>)) |
33 | import Data.List (sortBy, length) | ||
34 | import System.Directory (createDirectoryIfMissing, removePathForcibly) | ||
35 | import System.FilePath (dropFileName, (</>)) | ||
36 | 33 | ||
37 | import Data.Aeson (ToJSON) | 34 | import Data.Aeson (ToJSON) |
38 | import qualified Data.Aeson as JSON | 35 | import qualified Data.Aeson as JSON |
@@ -40,25 +37,25 @@ import qualified Data.Aeson as JSON | |||
40 | import Config | 37 | import Config |
41 | import Files (FileName, readDirectory, localPath, isHidden, nodeName, filterDir, flattenDir, root, (/>), ensureParentDir) | 38 | import Files (FileName, readDirectory, localPath, isHidden, nodeName, filterDir, flattenDir, root, (/>), ensureParentDir) |
42 | import Input (decodeYamlFile, readInputTree) | 39 | import Input (decodeYamlFile, readInputTree) |
43 | import Resource (ResourceTree, buildResourceTree, outputDiff) | 40 | import Resource (ResourceTree, buildResourceTree, cleanupResourceDir) |
44 | import Gallery (buildGalleryTree) | 41 | import Gallery (buildGalleryTree) |
45 | import Processors | 42 | import Processors |
46 | 43 | ||
47 | 44 | ||
48 | itemsDir :: String | 45 | writeJSON :: ToJSON a => FileName -> a -> IO () |
49 | itemsDir = "items" | 46 | writeJSON outputPath object = |
50 | 47 | do | |
51 | thumbnailsDir :: String | 48 | putStrLn $ "Generating:\t" ++ outputPath |
52 | thumbnailsDir = "thumbnails" | 49 | ensureParentDir JSON.encodeFile outputPath object |
53 | 50 | ||
54 | 51 | ||
55 | compileGallery :: FilePath -> FilePath -> IO () | 52 | compileGallery :: FilePath -> FilePath -> IO () |
56 | compileGallery inputDirPath outputDirPath = | 53 | compileGallery inputDirPath outputDirPath = |
57 | do | 54 | do |
58 | config <- readConfig (inputDirPath </> "gallery.yaml") | 55 | config <- readConfig (inputDirPath </> galleryConf) |
59 | inputDir <- readDirectory inputDirPath | 56 | inputDir <- readDirectory inputDirPath |
60 | 57 | ||
61 | let isGalleryFile = \n -> nodeName n == "gallery.yaml" | 58 | let isGalleryFile = \n -> nodeName n == galleryConf |
62 | let galleryTree = filterDir (liftM2 (&&) (not . isGalleryFile) (not . isHidden)) inputDir | 59 | let galleryTree = filterDir (liftM2 (&&) (not . isGalleryFile) (not . isHidden)) inputDir |
63 | 60 | ||
64 | inputTree <- readInputTree galleryTree | 61 | inputTree <- readInputTree galleryTree |
@@ -68,10 +65,7 @@ compileGallery inputDirPath outputDirPath = | |||
68 | let thumbnailProc = thumbnailFileProcessor (Resolution 150 50) skipCached inputDirPath outputDirPath thumbnailsDir | 65 | let thumbnailProc = thumbnailFileProcessor (Resolution 150 50) skipCached inputDirPath outputDirPath thumbnailsDir |
69 | resourceTree <- buildResourceTree dirProc itemProc thumbnailProc inputTree | 66 | resourceTree <- buildResourceTree dirProc itemProc thumbnailProc inputTree |
70 | 67 | ||
71 | putStrLn "\nRESOURCE TREE" | 68 | cleanupResourceDir resourceTree outputDirPath |
72 | putStrLn (show resourceTree) | ||
73 | |||
74 | cleanup resourceTree outputDirPath | ||
75 | 69 | ||
76 | buildGalleryTree resourceTree | 70 | buildGalleryTree resourceTree |
77 | & writeJSON (outputDirPath </> "index.json") | 71 | & writeJSON (outputDirPath </> "index.json") |
@@ -80,22 +74,6 @@ compileGallery inputDirPath outputDirPath = | |||
80 | & writeJSON (outputDirPath </> "viewer.json") | 74 | & writeJSON (outputDirPath </> "viewer.json") |
81 | 75 | ||
82 | where | 76 | where |
83 | cleanup :: ResourceTree -> FileName -> IO () | 77 | galleryConf = "gallery.yaml" |
84 | cleanup resourceTree outputDir = | 78 | itemsDir = "items" |
85 | readDirectory outputDir | 79 | thumbnailsDir = "thumbnails" |
86 | >>= return . outputDiff resourceTree . root | ||
87 | >>= return . sortBy (flip $ comparing length) -- nested files before dirs | ||
88 | >>= return . map (localPath . (/>) outputDir) | ||
89 | >>= mapM_ remove | ||
90 | |||
91 | remove :: FileName -> IO () | ||
92 | remove path = | ||
93 | do | ||
94 | putStrLn $ "Removing: " ++ path | ||
95 | removePathForcibly path | ||
96 | |||
97 | writeJSON :: ToJSON a => FileName -> a -> IO () | ||
98 | writeJSON outputPath object = | ||
99 | do | ||
100 | putStrLn $ "Generating: " ++ outputPath | ||
101 | ensureParentDir JSON.encodeFile outputPath object | ||