diff options
Diffstat (limited to 'compiler/app/Main.hs')
-rw-r--r-- | compiler/app/Main.hs | 69 |
1 files changed, 42 insertions, 27 deletions
diff --git a/compiler/app/Main.hs b/compiler/app/Main.hs index 2fdaf3e..48e5644 100644 --- a/compiler/app/Main.hs +++ b/compiler/app/Main.hs | |||
@@ -21,6 +21,7 @@ module Main where | |||
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 Control.Monad (when) |
24 | import Data.Maybe (isJust) | ||
24 | import Data.Version (showVersion) | 25 | import Data.Version (showVersion) |
25 | import Data.Aeson (ToJSON) | 26 | import Data.Aeson (ToJSON) |
26 | import System.FilePath ((</>)) | 27 | import System.FilePath ((</>)) |
@@ -43,7 +44,7 @@ data Options = Options | |||
43 | , galleryConfig :: FilePath | 44 | , galleryConfig :: FilePath |
44 | , rebuilAll :: Bool | 45 | , rebuilAll :: Bool |
45 | , cleanOutput :: Bool | 46 | , cleanOutput :: Bool |
46 | , withViewer :: Bool | 47 | , withViewer :: Maybe FilePath |
47 | } deriving (Show, Data, Typeable) | 48 | } deriving (Show, Data, Typeable) |
48 | 49 | ||
49 | options :: Options | 50 | options :: Options |
@@ -82,11 +83,13 @@ options = Options | |||
82 | &= name "clean-output" | 83 | &= name "clean-output" |
83 | &= explicit | 84 | &= explicit |
84 | &= help "Remove unnecessary files from the output directory" | 85 | &= help "Remove unnecessary files from the output directory" |
85 | , withViewer = False | 86 | , withViewer = Nothing |
87 | &= typDir | ||
88 | &= opt ("" :: FilePath) | ||
86 | &= name "w" | 89 | &= name "w" |
87 | &= name "with-viewer" | 90 | &= name "with-viewer" |
88 | &= explicit | 91 | &= explicit |
89 | &= help "Include the static web viewer in the output" | 92 | &= help "Deploy either the bundled or the given static web viewer to the output directory" |
90 | } | 93 | } |
91 | 94 | ||
92 | &= summary ("ldgallery v" ++ (showVersion version) ++ " - a static web gallery generator with tags") | 95 | &= summary ("ldgallery v" ++ (showVersion version) ++ " - a static web gallery generator with tags") |
@@ -101,15 +104,23 @@ main = | |||
101 | do | 104 | do |
102 | opts <- cmdArgs options | 105 | opts <- cmdArgs options |
103 | buildGallery opts | 106 | buildGallery opts |
104 | when (withViewer opts) $ do | 107 | |
105 | when (cleanOutput opts) $ cleanViewerDir (outputDir opts) | 108 | when (isJust $ withViewer opts) $ do |
106 | copyViewer (outputDir opts) | 109 | viewerDist <- viewerDistPath $ withViewer opts |
107 | writeViewerConfig (outputDir opts </> "config.json") | 110 | deployViewer viewerDist opts |
108 | 111 | ||
109 | where | 112 | where |
110 | gallerySubdir :: String | 113 | gallerySubdir :: String |
111 | gallerySubdir = "gallery" | 114 | gallerySubdir = "gallery" |
112 | 115 | ||
116 | viewerConfig :: ViewerConfig | ||
117 | viewerConfig = ViewerConfig (gallerySubdir ++ "/") | ||
118 | |||
119 | viewerDistPath :: Maybe FilePath -> IO FilePath | ||
120 | viewerDistPath (Just "") = getDataFileName "viewer" | ||
121 | viewerDistPath (Just dist) = return dist | ||
122 | viewerDistPath Nothing = fail "No viewer distribution" | ||
123 | |||
113 | buildGallery :: Options -> IO () | 124 | buildGallery :: Options -> IO () |
114 | buildGallery opts = | 125 | buildGallery opts = |
115 | checkDistinctPaths (inputDir opts) (outputDir opts) | 126 | checkDistinctPaths (inputDir opts) (outputDir opts) |
@@ -122,28 +133,32 @@ main = | |||
122 | (rebuilAll opts) | 133 | (rebuilAll opts) |
123 | (cleanOutput opts) | 134 | (cleanOutput opts) |
124 | where | 135 | where |
136 | checkDistinctPaths :: FilePath -> FilePath -> IO () | ||
125 | checkDistinctPaths a b = do | 137 | checkDistinctPaths a b = do |
126 | canonicalA <- canonicalizePath a | 138 | canonicalA <- canonicalizePath a |
127 | canonicalB <- canonicalizePath b | 139 | canonicalB <- canonicalizePath b |
128 | when (canonicalA == canonicalB) $ error "Input and output paths refer to the same location." | 140 | when (canonicalA == canonicalB) $ error "Input and output paths refer to the same location." |
129 | 141 | ||
130 | galleryOutputDir :: Options -> FilePath | 142 | galleryOutputDir :: Options -> FilePath |
131 | galleryOutputDir opts = | 143 | galleryOutputDir Options{withViewer, outputDir} |
132 | if withViewer opts then outputBase </> gallerySubdir else outputBase | 144 | | isJust withViewer = outputDir </> gallerySubdir |
133 | where outputBase = outputDir opts | 145 | | otherwise = outputDir |
134 | 146 | ||
135 | cleanViewerDir :: FilePath -> IO () | 147 | deployViewer :: FilePath -> Options -> IO () |
136 | cleanViewerDir target = | 148 | deployViewer distPath Options{outputDir, cleanOutput} = |
137 | listDirectory target | 149 | (when cleanOutput $ cleanViewerDir outputDir) |
138 | >>= return . filter (/= gallerySubdir) | 150 | >> copyViewer distPath outputDir |
139 | >>= mapM_ remove . map (target </>) | 151 | >> writeJSON (outputDir </> "config.json") viewerConfig |
140 | 152 | ||
141 | copyViewer :: FilePath -> IO () | 153 | where |
142 | copyViewer target = | 154 | cleanViewerDir :: FilePath -> IO () |
143 | putStrLn "Copying viewer webapp" | 155 | cleanViewerDir target = |
144 | >> getDataFileName "viewer" | 156 | listDirectory target |
145 | >>= readDirectory | 157 | >>= return . filter (/= gallerySubdir) |
146 | >>= copyTo target | 158 | >>= mapM_ remove . map (target </>) |
147 | 159 | ||
148 | writeViewerConfig :: FilePath -> IO () | 160 | copyViewer :: FilePath -> FilePath -> IO () |
149 | writeViewerConfig fileName = writeJSON fileName $ ViewerConfig (gallerySubdir ++ "/") | 161 | copyViewer dist target = |
162 | putStrLn "Copying viewer webapp" | ||
163 | >> readDirectory dist | ||
164 | >>= copyTo target | ||