diff options
Diffstat (limited to 'compiler/src')
-rw-r--r-- | compiler/src/Compiler.hs | 48 | ||||
-rw-r--r-- | compiler/src/Files.hs | 14 | ||||
-rw-r--r-- | compiler/src/Processors.hs | 6 | ||||
-rw-r--r-- | compiler/src/Resource.hs | 14 |
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 | ||
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 | ||
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) | |||
34 | import Data.Bool (bool) | 34 | import Data.Bool (bool) |
35 | import Data.List (isPrefixOf, length, deleteBy) | 35 | import Data.List (isPrefixOf, length, deleteBy) |
36 | import Data.Function ((&)) | 36 | import Data.Function ((&)) |
37 | import System.Directory (doesDirectoryExist, listDirectory, createDirectoryIfMissing) | 37 | import System.Directory |
38 | ( doesDirectoryExist | ||
39 | , listDirectory | ||
40 | , createDirectoryIfMissing | ||
41 | , removePathForcibly ) | ||
38 | 42 | ||
39 | import qualified System.FilePath | 43 | import qualified System.FilePath |
40 | import qualified System.FilePath.Posix | 44 | import 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 | |||
126 | remove :: FileName -> IO () | ||
127 | remove 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 | ||
74 | copyFileProcessor :: FileProcessor | 74 | copyFileProcessor :: FileProcessor |
75 | copyFileProcessor inputPath outputPath = | 75 | copyFileProcessor 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 | ||
79 | eitherIOToIO :: Either String (IO a) -> IO a | 79 | eitherIOToIO :: Either String (IO a) -> IO a |
@@ -99,7 +99,7 @@ type StaticImageWriter = FilePath -> DynamicImage -> IO () | |||
99 | 99 | ||
100 | resizeStaticGeneric :: StaticImageReader -> StaticImageWriter -> Resolution -> FileProcessor | 100 | resizeStaticGeneric :: StaticImageReader -> StaticImageWriter -> Resolution -> FileProcessor |
101 | resizeStaticGeneric reader writer maxRes inputPath outputPath = | 101 | resizeStaticGeneric 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 | ||
36 | import Data.Function ((&)) | 35 | import Data.Function ((&)) |
37 | import Data.List ((\\), subsequences) | 36 | import Data.List ((\\), subsequences, sortBy) |
37 | import Data.Ord (comparing) | ||
38 | import Data.Maybe (mapMaybe) | 38 | import Data.Maybe (mapMaybe) |
39 | import Files | 39 | import Files |
40 | import Input (InputTree(..), Sidecar) | 40 | import 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 | |||
108 | cleanupResourceDir :: ResourceTree -> FileName -> IO () | ||
109 | cleanupResourceDir 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 | ||