aboutsummaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-rw-r--r--compiler/src/Compiler.hs48
-rw-r--r--compiler/src/Files.hs14
-rw-r--r--compiler/src/Processors.hs6
-rw-r--r--compiler/src/Resource.hs14
4 files changed, 39 insertions, 43 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
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 0392efe..23daf3a 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -26,7 +26,7 @@ module Files
26 , (</>), (</), (/>), localPath, webPath 26 , (</>), (</), (/>), localPath, webPath
27 , FSNode(..), AnchoredFSNode(..) 27 , FSNode(..), AnchoredFSNode(..)
28 , nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory 28 , nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory
29 , ensureParentDir 29 , ensureParentDir, remove
30 ) where 30 ) where
31 31
32 32
@@ -34,7 +34,11 @@ import Control.Monad (filterM, mapM)
34import Data.Bool (bool) 34import Data.Bool (bool)
35import Data.List (isPrefixOf, length, deleteBy) 35import Data.List (isPrefixOf, length, deleteBy)
36import Data.Function ((&)) 36import Data.Function ((&))
37import System.Directory (doesDirectoryExist, listDirectory, createDirectoryIfMissing) 37import System.Directory
38 ( doesDirectoryExist
39 , listDirectory
40 , createDirectoryIfMissing
41 , removePathForcibly )
38 42
39import qualified System.FilePath 43import qualified System.FilePath
40import qualified System.FilePath.Posix 44import qualified System.FilePath.Posix
@@ -118,3 +122,9 @@ ensureParentDir writer filePath a =
118 >> writer filePath a 122 >> writer filePath a
119 where 123 where
120 parentDir = System.FilePath.dropFileName filePath 124 parentDir = System.FilePath.dropFileName filePath
125
126remove :: FileName -> IO ()
127remove path =
128 do
129 putStrLn $ "Removing:\t" ++ path
130 removePathForcibly path
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index a296215..aaa178f 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -73,7 +73,7 @@ type FileProcessor =
73 73
74copyFileProcessor :: FileProcessor 74copyFileProcessor :: FileProcessor
75copyFileProcessor inputPath outputPath = 75copyFileProcessor inputPath outputPath =
76 (putStrLn $ "Copying: " ++ outputPath) 76 (putStrLn $ "Copying:\t" ++ outputPath)
77 >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath 77 >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath
78 78
79eitherIOToIO :: Either String (IO a) -> IO a 79eitherIOToIO :: Either String (IO a) -> IO a
@@ -99,7 +99,7 @@ type StaticImageWriter = FilePath -> DynamicImage -> IO ()
99 99
100resizeStaticGeneric :: StaticImageReader -> StaticImageWriter -> Resolution -> FileProcessor 100resizeStaticGeneric :: StaticImageReader -> StaticImageWriter -> Resolution -> FileProcessor
101resizeStaticGeneric reader writer maxRes inputPath outputPath = 101resizeStaticGeneric reader writer maxRes inputPath outputPath =
102 (putStrLn $ "Generating: " ++ outputPath) 102 (putStrLn $ "Generating:\t" ++ outputPath)
103 >> reader inputPath 103 >> reader inputPath
104 >>= eitherResToIO 104 >>= eitherResToIO
105 >>= return . (fitDynamicImage maxRes) 105 >>= return . (fitDynamicImage maxRes)
@@ -142,7 +142,7 @@ withCached processor inputPath outputPath =
142 where 142 where
143 noop = return () 143 noop = return ()
144 update = processor inputPath outputPath 144 update = processor inputPath outputPath
145 skip = putStrLn $ "Skipping: " ++ outputPath 145 skip = putStrLn $ "Skipping:\t" ++ outputPath
146 146
147 isOutdated :: FilePath -> FilePath -> IO Bool 147 isOutdated :: FilePath -> FilePath -> IO Bool
148 isOutdated ref target = 148 isOutdated ref target =
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 83f7438..a8be913 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -28,13 +28,13 @@ module Resource
28 , ItemProcessor 28 , ItemProcessor
29 , ThumbnailProcessor 29 , ThumbnailProcessor
30 , buildResourceTree 30 , buildResourceTree
31 , flattenResourceTree 31 , cleanupResourceDir
32 , outputDiff
33 ) where 32 ) where
34 33
35 34
36import Data.Function ((&)) 35import Data.Function ((&))
37import Data.List ((\\), subsequences) 36import Data.List ((\\), subsequences, sortBy)
37import Data.Ord (comparing)
38import Data.Maybe (mapMaybe) 38import Data.Maybe (mapMaybe)
39import Files 39import Files
40import Input (InputTree(..), Sidecar) 40import Input (InputTree(..), Sidecar)
@@ -104,3 +104,11 @@ outputDiff resources ref =
104 104
105 fsPaths :: FSNode -> [Path] 105 fsPaths :: FSNode -> [Path]
106 fsPaths = map nodePath . tail . flattenDir 106 fsPaths = map nodePath . tail . flattenDir
107
108cleanupResourceDir :: ResourceTree -> FileName -> IO ()
109cleanupResourceDir resourceTree outputDir =
110 readDirectory outputDir
111 >>= return . outputDiff resourceTree . root
112 >>= return . sortBy (flip $ comparing length) -- nested files before dirs
113 >>= return . map (localPath . (/>) outputDir)
114 >>= mapM_ remove