aboutsummaryrefslogtreecommitdiff
path: root/compiler/src/Compiler.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/src/Compiler.hs')
-rw-r--r--compiler/src/Compiler.hs48
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
30import Control.Monad 30import Control.Monad
31import Data.Function ((&)) 31import Data.Function ((&))
32import Data.Ord (comparing) 32import System.FilePath ((</>))
33import Data.List (sortBy, length)
34import System.Directory (createDirectoryIfMissing, removePathForcibly)
35import System.FilePath (dropFileName, (</>))
36 33
37import Data.Aeson (ToJSON) 34import Data.Aeson (ToJSON)
38import qualified Data.Aeson as JSON 35import qualified Data.Aeson as JSON
@@ -40,25 +37,25 @@ import qualified Data.Aeson as JSON
40import Config 37import Config
41import Files (FileName, readDirectory, localPath, isHidden, nodeName, filterDir, flattenDir, root, (/>), ensureParentDir) 38import Files (FileName, readDirectory, localPath, isHidden, nodeName, filterDir, flattenDir, root, (/>), ensureParentDir)
42import Input (decodeYamlFile, readInputTree) 39import Input (decodeYamlFile, readInputTree)
43import Resource (ResourceTree, buildResourceTree, outputDiff) 40import Resource (ResourceTree, buildResourceTree, cleanupResourceDir)
44import Gallery (buildGalleryTree) 41import Gallery (buildGalleryTree)
45import Processors 42import Processors
46 43
47 44
48itemsDir :: String 45writeJSON :: ToJSON a => FileName -> a -> IO ()
49itemsDir = "items" 46writeJSON outputPath object =
50 47 do
51thumbnailsDir :: String 48 putStrLn $ "Generating:\t" ++ outputPath
52thumbnailsDir = "thumbnails" 49 ensureParentDir JSON.encodeFile outputPath object
53 50
54 51
55compileGallery :: FilePath -> FilePath -> IO () 52compileGallery :: FilePath -> FilePath -> IO ()
56compileGallery inputDirPath outputDirPath = 53compileGallery 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