diff options
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/app/Main.hs | 24 | ||||
-rw-r--r-- | compiler/src/Compiler.hs | 8 | ||||
-rw-r--r-- | compiler/src/Processors.hs | 4 |
3 files changed, 19 insertions, 17 deletions
diff --git a/compiler/app/Main.hs b/compiler/app/Main.hs index 1864dee..594a5b7 100644 --- a/compiler/app/Main.hs +++ b/compiler/app/Main.hs | |||
@@ -20,11 +20,13 @@ module Main where | |||
20 | 20 | ||
21 | import GHC.Generics (Generic) | 21 | import GHC.Generics (Generic) |
22 | import Paths_ldgallery_compiler (version, getDataFileName) | 22 | import Paths_ldgallery_compiler (version, getDataFileName) |
23 | import Control.Monad (when) | ||
23 | import Data.Version (showVersion) | 24 | import Data.Version (showVersion) |
24 | import Data.Int (Int64) | 25 | import Data.Int (Int64) |
25 | import Data.Aeson (ToJSON) | 26 | import Data.Aeson (ToJSON) |
26 | import Data.Time.Clock.System (getSystemTime, systemSeconds) | 27 | import Data.Time.Clock.System (getSystemTime, systemSeconds) |
27 | import System.FilePath ((</>)) | 28 | import System.FilePath ((</>)) |
29 | import System.Directory (canonicalizePath) | ||
28 | import System.Console.CmdArgs | 30 | import System.Console.CmdArgs |
29 | 31 | ||
30 | import Compiler | 32 | import Compiler |
@@ -88,11 +90,9 @@ main = | |||
88 | do | 90 | do |
89 | opts <- cmdArgs options | 91 | opts <- cmdArgs options |
90 | buildGallery opts | 92 | buildGallery opts |
91 | if (withViewer opts) then do | 93 | when (withViewer opts) $ do |
92 | copyViewer (outputDir opts) | 94 | copyViewer (outputDir opts) |
93 | writeViewerConfig (outputDir opts </> "config.json") | 95 | writeViewerConfig (outputDir opts </> "config.json") |
94 | else | ||
95 | return () | ||
96 | 96 | ||
97 | where | 97 | where |
98 | gallerySubdir :: String | 98 | gallerySubdir :: String |
@@ -100,12 +100,18 @@ main = | |||
100 | 100 | ||
101 | buildGallery :: Options -> IO () | 101 | buildGallery :: Options -> IO () |
102 | buildGallery opts = | 102 | buildGallery opts = |
103 | compileGallery | 103 | checkDistinctPaths (inputDir opts) (outputDir opts) |
104 | (inputDir opts) | 104 | >> compileGallery |
105 | (galleryOutputDir opts) | 105 | (inputDir opts) |
106 | [outputDir opts] | 106 | (galleryOutputDir opts) |
107 | (rebuilAll opts) | 107 | [outputDir opts] |
108 | (cleanOutput opts) | 108 | (rebuilAll opts) |
109 | (cleanOutput opts) | ||
110 | where | ||
111 | checkDistinctPaths a b = do | ||
112 | canonicalA <- canonicalizePath a | ||
113 | canonicalB <- canonicalizePath b | ||
114 | when (canonicalA == canonicalB) $ error "Input and output paths refer to the same location." | ||
109 | 115 | ||
110 | galleryOutputDir :: Options -> FilePath | 116 | galleryOutputDir :: Options -> FilePath |
111 | galleryOutputDir opts = | 117 | galleryOutputDir opts = |
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs index adc4a5f..2a0dccc 100644 --- a/compiler/src/Compiler.hs +++ b/compiler/src/Compiler.hs | |||
@@ -22,7 +22,7 @@ module Compiler | |||
22 | ) where | 22 | ) where |
23 | 23 | ||
24 | 24 | ||
25 | import Control.Monad (liftM2) | 25 | import Control.Monad (liftM2, when) |
26 | import Data.List (any) | 26 | import Data.List (any) |
27 | import System.FilePath ((</>)) | 27 | import System.FilePath ((</>)) |
28 | import qualified System.FilePath.Glob as Glob | 28 | import qualified System.FilePath.Glob as Glob |
@@ -118,11 +118,7 @@ compileGallery inputDirPath outputDirPath excludedDirs rebuildAll cleanOutput = | |||
118 | let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config) | 118 | let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config) |
119 | resources <- galleryBuilder (galleryName config) inputTree | 119 | resources <- galleryBuilder (galleryName config) inputTree |
120 | 120 | ||
121 | if cleanOutput then | 121 | when cleanOutput $ galleryCleanupResourceDir resources outputDirPath |
122 | galleryCleanupResourceDir resources outputDirPath | ||
123 | else | ||
124 | return () | ||
125 | |||
126 | writeJSON outputIndex resources | 122 | writeJSON outputIndex resources |
127 | writeJSON outputViewerConf $ viewer fullConfig | 123 | writeJSON outputViewerConf $ viewer fullConfig |
128 | 124 | ||
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index 6ab4eb5..faa2f43 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs | |||
@@ -25,6 +25,7 @@ module Processors | |||
25 | 25 | ||
26 | 26 | ||
27 | import Control.Exception (Exception, throwIO) | 27 | import Control.Exception (Exception, throwIO) |
28 | import Control.Monad (when) | ||
28 | import Data.Function ((&)) | 29 | import Data.Function ((&)) |
29 | import Data.Char (toLower) | 30 | import Data.Char (toLower) |
30 | import Data.List (break) | 31 | import Data.List (break) |
@@ -106,7 +107,7 @@ withCached :: Cache | |||
106 | withCached processor inputPath outputPath = | 107 | withCached processor inputPath outputPath = |
107 | do | 108 | do |
108 | isDir <- doesDirectoryExist outputPath | 109 | isDir <- doesDirectoryExist outputPath |
109 | if isDir then removePathForcibly outputPath else noop | 110 | when isDir $ removePathForcibly outputPath |
110 | 111 | ||
111 | fileExists <- doesFileExist outputPath | 112 | fileExists <- doesFileExist outputPath |
112 | if fileExists then | 113 | if fileExists then |
@@ -117,7 +118,6 @@ withCached processor inputPath outputPath = | |||
117 | update | 118 | update |
118 | 119 | ||
119 | where | 120 | where |
120 | noop = return () | ||
121 | update = processor inputPath outputPath | 121 | update = processor inputPath outputPath |
122 | skip = putStrLn $ "Skipping:\t" ++ outputPath | 122 | skip = putStrLn $ "Skipping:\t" ++ outputPath |
123 | 123 | ||