From 63b06627f200f155f66ecdb6c5f41ab44808dd6b Mon Sep 17 00:00:00 2001
From: pacien
Date: Fri, 27 Dec 2019 12:38:01 +0100
Subject: compiler: add compiler config keys

---
 compiler/package.yaml      |  1 +
 compiler/src/Compiler.hs   | 35 ++++++++++++++++++++++++++++-------
 compiler/src/Config.hs     | 19 +++++++++++++------
 compiler/src/Files.hs      | 17 ++++++++++++++++-
 compiler/src/Processors.hs | 12 ++++--------
 5 files changed, 62 insertions(+), 22 deletions(-)

(limited to 'compiler')

diff --git a/compiler/package.yaml b/compiler/package.yaml
index e3c1eb6..b594ee7 100644
--- a/compiler/package.yaml
+++ b/compiler/package.yaml
@@ -19,6 +19,7 @@ dependencies:
 - containers
 - filepath
 - directory
+- text
 - aeson
 - yaml
 - optparse-applicative
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 5c47521..854fd03 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -35,7 +35,19 @@ import Data.Aeson (ToJSON)
 import qualified Data.Aeson as JSON
 
 import Config
-import Files (FileName, readDirectory, localPath, isHidden, nodeName, filterDir, flattenDir, root, (/>), ensureParentDir)
+import Files
+  ( FileName
+  , readDirectory
+  , localPath
+  , isHidden
+  , nodeName
+  , filterDir
+  , flattenDir
+  , root
+  , (/>)
+  , ensureParentDir
+  , isOutdated )
+
 import Input (decodeYamlFile, readInputTree)
 import Resource (ResourceTree, buildResourceTree, cleanupResourceDir)
 import Gallery (buildGalleryTree)
@@ -52,7 +64,10 @@ writeJSON outputPath object =
 compileGallery :: FilePath -> FilePath -> IO ()
 compileGallery inputDirPath outputDirPath =
   do
-    config <- readConfig (inputDirPath </> galleryConf)
+    fullConfig <- readConfig inputGalleryConf
+    let config = compiler fullConfig
+
+    -- TODO: exclude output dir if it's under the input dir
     inputDir <- readDirectory inputDirPath
 
     let isGalleryFile = \n -> nodeName n == galleryConf
@@ -60,20 +75,26 @@ compileGallery inputDirPath outputDirPath =
 
     inputTree <- readInputTree galleryTree
 
+    invalidateCache <- isOutdated inputGalleryConf outputIndex
+    let cache = if invalidateCache then skipCached else withCached
     let dirProc = dirFileProcessor inputDirPath outputDirPath itemsDir
-    let itemProc = itemFileProcessor Nothing skipCached inputDirPath outputDirPath itemsDir
-    let thumbnailProc = thumbnailFileProcessor (Resolution 150 50) skipCached inputDirPath outputDirPath thumbnailsDir
+    let itemProc = itemFileProcessor (pictureMaxResolution config) cache inputDirPath outputDirPath itemsDir
+    let thumbnailProc = thumbnailFileProcessor (thumbnailResolution config) cache inputDirPath outputDirPath thumbnailsDir
     resourceTree <- buildResourceTree dirProc itemProc thumbnailProc inputTree
 
     cleanupResourceDir resourceTree outputDirPath
 
     buildGalleryTree resourceTree
-      & writeJSON (outputDirPath </> "index.json")
+      & writeJSON outputIndex
 
-    viewer config
-      & writeJSON (outputDirPath </> "viewer.json")
+    viewer fullConfig
+      & writeJSON outputViewerConf
 
   where
     galleryConf = "gallery.yaml"
     itemsDir = "items"
     thumbnailsDir = "thumbnails"
+
+    inputGalleryConf = inputDirPath </> galleryConf
+    outputIndex = outputDirPath </> "index.json"
+    outputViewerConf = outputDirPath </> "viewer.json"
diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs
index f147bdd..fe981c3 100644
--- a/compiler/src/Config.hs
+++ b/compiler/src/Config.hs
@@ -20,6 +20,7 @@
     DuplicateRecordFields
   , DeriveGeneric
   , DeriveAnyClass
+  , OverloadedStrings
 #-}
 
 module Config
@@ -29,25 +30,31 @@ module Config
   ) where
 
 
+import Data.Text (Text)
 import GHC.Generics (Generic)
-import Data.Aeson (ToJSON, FromJSON)
+import Data.Aeson (ToJSON, FromJSON, withObject, (.:?), (.!=))
 import qualified Data.Aeson as JSON
 
 import Files (FileName)
 import Input (decodeYamlFile)
+import Processors (Resolution(..))
 
 
 data CompilerConfig = CompilerConfig
-  { dummy :: Maybe String -- TODO
-  } deriving (Generic, FromJSON, Show)
+  { thumbnailResolution :: Resolution
+  , pictureMaxResolution :: Maybe Resolution
+  } deriving (Generic, Show)
+
+instance FromJSON CompilerConfig where
+  parseJSON = withObject "CompilerConfig" $ \v -> CompilerConfig
+    <$> v .:? "thumbnailResolution" .!= (Resolution 400 400)
+    <*> v .:? "pictureMaxResolution"
+
 
 data GalleryConfig = GalleryConfig
   { compiler :: CompilerConfig
   , viewer :: JSON.Object
   } deriving (Generic, FromJSON, Show)
 
--- TODO: add compiler config keys and their default values
-
-
 readConfig :: FileName -> IO GalleryConfig
 readConfig = decodeYamlFile
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 23daf3a..fb46c33 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -26,7 +26,7 @@ module Files
   , (</>), (</), (/>), localPath, webPath
   , FSNode(..), AnchoredFSNode(..)
   , nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory
-  , ensureParentDir, remove
+  , ensureParentDir, remove, isOutdated
   ) where
 
 
@@ -36,6 +36,8 @@ import Data.List (isPrefixOf, length, deleteBy)
 import Data.Function ((&))
 import System.Directory
   ( doesDirectoryExist
+  , doesPathExist
+  , getModificationTime
   , listDirectory
   , createDirectoryIfMissing
   , removePathForcibly )
@@ -128,3 +130,16 @@ remove path =
   do
     putStrLn $ "Removing:\t" ++ path
     removePathForcibly path
+
+isOutdated :: FilePath -> FilePath -> IO Bool
+isOutdated ref target =
+  do
+    refExists <- doesPathExist ref
+    targetExists <- doesPathExist target
+    if refExists && targetExists then
+      do
+        refTime <- getModificationTime ref
+        targetTime <- getModificationTime target
+        return (targetTime < refTime)
+    else
+      return True
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index aaa178f..c097db7 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -36,6 +36,9 @@ import Control.Exception (throwIO)
 import Data.Function ((&))
 import Data.Ratio ((%))
 
+import GHC.Generics (Generic)
+import Data.Aeson (FromJSON)
+
 import System.Directory hiding (copyFile)
 import qualified System.Directory
 import System.FilePath
@@ -64,7 +67,7 @@ formatFromExt _ = Other
 
 data Resolution = Resolution
   { width :: Int
-  , height :: Int } deriving Show
+  , height :: Int } deriving (Show, Generic, FromJSON)
 
 type FileProcessor =
      FileName        -- ^ Input path
@@ -144,13 +147,6 @@ withCached processor inputPath outputPath =
     update = processor inputPath outputPath
     skip = putStrLn $ "Skipping:\t" ++ outputPath
 
-    isOutdated :: FilePath -> FilePath -> IO Bool
-    isOutdated ref target =
-      do
-        refTime <- getModificationTime ref
-        targetTime <- getModificationTime target
-        return (targetTime < refTime)
-
 
 type DirFileProcessor =
      FileName        -- ^ Input base path
-- 
cgit v1.2.3