From bbae6ddb97c0825f6b0b689f4d9eeac67515d1c1 Mon Sep 17 00:00:00 2001
From: pacien
Date: Sat, 21 Dec 2019 19:28:58 +0100
Subject: compiler: init stack project

---
 compiler/src/Lib.hs | 6 ++++++
 1 file changed, 6 insertions(+)
 create mode 100644 compiler/src/Lib.hs

(limited to 'compiler/src')

diff --git a/compiler/src/Lib.hs b/compiler/src/Lib.hs
new file mode 100644
index 0000000..d36ff27
--- /dev/null
+++ b/compiler/src/Lib.hs
@@ -0,0 +1,6 @@
+module Lib
+    ( someFunc
+    ) where
+
+someFunc :: IO ()
+someFunc = putStrLn "someFunc"
-- 
cgit v1.2.3


From 8de4411269ae85789c1cc7d81a9ecf0facbe78ff Mon Sep 17 00:00:00 2001
From: pacien
Date: Mon, 23 Dec 2019 05:09:25 +0100
Subject: compiler: add base structures and encoding

---
 compiler/src/Lib.hs | 178 ++++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 174 insertions(+), 4 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Lib.hs b/compiler/src/Lib.hs
index d36ff27..c52e095 100644
--- a/compiler/src/Lib.hs
+++ b/compiler/src/Lib.hs
@@ -1,6 +1,176 @@
+{-# LANGUAGE DuplicateRecordFields, DeriveGeneric #-}
+
+
+-- ldgallery - A static generator which turns a collection of tagged
+--             pictures into a searchable web gallery.
+--
+-- Copyright (C) 2019  Pacien TRAN-GIRARD
+--               2019  Guillaume FOUET
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU Affero General Public License as
+-- published by the Free Software Foundation, either version 3 of the
+-- License, or (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-- GNU Affero General Public License for more details.
+--
+-- You should have received a copy of the GNU Affero General Public License
+-- along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+
 module Lib
-    ( someFunc
-    ) where
+  ( testRun
+  ) where
+
+
+import GHC.Generics
+
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Exception (Exception, throwIO)
+
+import Data.Function
+import Data.Maybe (fromMaybe)
+import Data.List (map)
+import Data.Char (toLower)
+import Data.Text (Text, empty, pack)
+import Data.Yaml (ParseException, decodeFileEither)
+import Data.Aeson
+
+import System.FilePath
+import System.Directory.Tree
+import System.Directory
+
+
+encodingOptions :: Options
+encodingOptions = defaultOptions
+  { fieldLabelModifier = map toLower
+  , constructorTagModifier = map toLower
+  , sumEncoding = defaultTaggedObject
+      { tagFieldName = "type"
+      , contentsFieldName = "contents"
+      }
+  }
+
+
+-- input structure
+
+data SidecarItemMetadata = SidecarItemMetadata
+  { title :: Maybe Text
+  , date :: Maybe Text
+  , description :: Maybe Text
+  , tags :: Maybe [Text]
+  } deriving Generic
+
+instance FromJSON SidecarItemMetadata where
+  parseJSON = genericParseJSON encodingOptions
+
+
+-- output structures
+
+type ResourcePath = Text
+type Tag = Text
+type FileSizeKB = Int
+
+
+data Resolution = Resolution
+  { width :: Int
+  , height :: Int
+  } deriving Generic
+
+instance ToJSON Resolution where
+  toJSON = genericToJSON encodingOptions
+  toEncoding = genericToEncoding encodingOptions
+
+
+data ItemProperties =
+    Directory { items :: [Item] }
+  | Image { resolution :: Resolution, filesize :: FileSizeKB }
+--  | Video { filesize :: FileSizeKB }
+  | Unknown
+  deriving Generic
+
+instance ToJSON ItemProperties where
+  toJSON = genericToJSON encodingOptions
+  toEncoding = genericToEncoding encodingOptions
+
+
+data Item = Item
+  { title :: Text
+  , date :: Text -- TODO: checked ISO8601 date
+  , description :: Text
+  , tags :: [Tag]
+  , path :: ResourcePath
+  , thumbnail :: Maybe ResourcePath
+  , properties :: ItemProperties
+  } deriving Generic
+
+instance ToJSON Item where
+  toJSON = genericToJSON encodingOptions
+  toEncoding = genericToEncoding encodingOptions
+
+
+-- mapping
+
+data LoadException = LoadException String ParseException deriving Show
+instance Exception LoadException
+
+decodeYamlFile :: (MonadIO m, FromJSON a) => FilePath -> m a
+decodeYamlFile fpath =
+  liftIO $ Data.Yaml.decodeFileEither fpath
+  >>= either (throwIO . LoadException fpath) return
+
+
+metadataDirTree :: DirTree FilePath -> IO (DirTree SidecarItemMetadata)
+metadataDirTree (Failed _ ferr) = ioError ferr
+metadataDirTree f@(File _ fpath) =
+  decodeYamlFile fpath
+  >>= \metadata -> return f { file = metadata }
+metadataDirTree d@(Dir _ dcontents) =
+  filter canContainMetadata dcontents
+  & mapM metadataDirTree
+  >>= \contents -> return d { contents = contents }
+  where
+     canContainMetadata (Dir _ _) = True
+     canContainMetadata (File fname _) = isExtensionOf ".yaml" fname
+
+
+toItemTree :: (MonadIO m) => [FileName] -> DirTree SidecarItemMetadata -> m Item
+toItemTree pathTo d@(Dir dname dcontents) =
+  mapM (toItemTree path) dcontents
+  >>= \items -> return Item
+    { title = pack dname
+    , date = empty -- TODO: would it make sense to take the date of child elements?
+    , description = empty
+    , tags = [] -- TODO: aggregate tags from childs
+    , path = pack $ joinPath $ "items":path -- FIXME: use URL path instead of system path sep
+    , thumbnail = Nothing
+    , properties = Directory { items = items }}
+  where
+    path = pathTo ++ [dname]
+toItemTree pathTo f@(File fname metadata) =
+  return Item
+    { title = optMeta title (pack fname)
+    , date = optMeta date empty -- TODO: check and normalise dates
+    , description = optMeta description empty
+    , tags = optMeta tags []
+    , path = pack $ joinPath $ "items":(pathTo ++ [fname])  -- FIXME: use URL path instead of system path sep
+    , thumbnail = Just $ pack $ joinPath $ "thumbnails":(pathTo ++ [fname])  -- FIXME: use URL path instead of system path sep
+    , properties = Unknown } -- TODO
+  where
+    optMeta get fallback = fromMaybe fallback $ get (metadata::SidecarItemMetadata)
+
+
+process :: FilePath -> FilePath -> IO ()
+process inputDir outputDir =
+  readDirectoryWith return inputDir
+  >>= metadataDirTree . dirTree
+  >>= toItemTree []
+  >>= return . show . toEncoding
+  >>= liftIO . putStrLn
+
 
-someFunc :: IO ()
-someFunc = putStrLn "someFunc"
+testRun :: IO ()
+testRun = process "../example" "../out"
-- 
cgit v1.2.3


From 81cfb110248a8f98cd084533f00a98a507d9518b Mon Sep 17 00:00:00 2001
From: pacien
Date: Mon, 23 Dec 2019 07:39:27 +0100
Subject: compiler: fix item tree tag aggregation and path concat

---
 compiler/src/Lib.hs | 65 ++++++++++++++++++++++++++++++++---------------------
 1 file changed, 40 insertions(+), 25 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Lib.hs b/compiler/src/Lib.hs
index c52e095..6cecfc5 100644
--- a/compiler/src/Lib.hs
+++ b/compiler/src/Lib.hs
@@ -34,12 +34,14 @@ import Control.Exception (Exception, throwIO)
 import Data.Function
 import Data.Maybe (fromMaybe)
 import Data.List (map)
+import Data.Set (fromList, toList)
 import Data.Char (toLower)
 import Data.Text (Text, empty, pack)
 import Data.Yaml (ParseException, decodeFileEither)
 import Data.Aeson
 
-import System.FilePath
+import System.FilePath (isExtensionOf)
+import qualified System.FilePath.Posix (joinPath)
 import System.Directory.Tree
 import System.Directory
 
@@ -137,37 +139,50 @@ metadataDirTree d@(Dir _ dcontents) =
      canContainMetadata (File fname _) = isExtensionOf ".yaml" fname
 
 
-toItemTree :: (MonadIO m) => [FileName] -> DirTree SidecarItemMetadata -> m Item
-toItemTree pathTo d@(Dir dname dcontents) =
-  mapM (toItemTree path) dcontents
-  >>= \items -> return Item
-    { title = pack dname
-    , date = empty -- TODO: would it make sense to take the date of child elements?
-    , description = empty
-    , tags = [] -- TODO: aggregate tags from childs
-    , path = pack $ joinPath $ "items":path -- FIXME: use URL path instead of system path sep
-    , thumbnail = Nothing
-    , properties = Directory { items = items }}
-  where
-    path = pathTo ++ [dname]
-toItemTree pathTo f@(File fname metadata) =
-  return Item
-    { title = optMeta title (pack fname)
-    , date = optMeta date empty -- TODO: check and normalise dates
-    , description = optMeta description empty
-    , tags = optMeta tags []
-    , path = pack $ joinPath $ "items":(pathTo ++ [fname])  -- FIXME: use URL path instead of system path sep
-    , thumbnail = Just $ pack $ joinPath $ "thumbnails":(pathTo ++ [fname])  -- FIXME: use URL path instead of system path sep
-    , properties = Unknown } -- TODO
+unique :: Ord a => [a] -> [a]
+unique = Data.Set.toList . Data.Set.fromList
+
+
+joinURLPath :: [FileName] -> Text
+joinURLPath = pack . System.FilePath.Posix.joinPath
+
+
+toItemTree :: (MonadIO m) => FilePath -> FilePath -> DirTree SidecarItemMetadata -> m Item
+toItemTree itemsDir thumbnailsDir = nodeToItem []
   where
-    optMeta get fallback = fromMaybe fallback $ get (metadata::SidecarItemMetadata)
+    nodeToItem pathTo d@(Dir dname dcontents) =
+      mapM (nodeToItem path) dcontents
+      >>= \items -> return Item
+        { title = pack dname
+        , date = empty
+        , description = empty
+        , tags = aggregateTags items
+        , path = joinURLPath $ itemsDir:path
+        , thumbnail = Nothing
+        , properties = Directory { items = items } }
+      where
+        path = pathTo ++ [dname]
+        aggregateTags = unique . concatMap (\item -> tags (item::Item))
+
+    nodeToItem pathTo f@(File fname metadata) =
+      return Item
+        { title = optMeta title (pack fname)
+        , date = optMeta date empty -- TODO: check and normalise dates
+        , description = optMeta description empty
+        , tags = optMeta tags []
+        , path = joinURLPath $ itemsDir:path
+        , thumbnail = Just $ joinURLPath $ thumbnailsDir:path
+        , properties = Unknown } -- TODO
+      where
+        path = pathTo ++ [fname]
+        optMeta get fallback = fromMaybe fallback $ get (metadata::SidecarItemMetadata)
 
 
 process :: FilePath -> FilePath -> IO ()
 process inputDir outputDir =
   readDirectoryWith return inputDir
   >>= metadataDirTree . dirTree
-  >>= toItemTree []
+  >>= toItemTree "items" "thumbnails"
   >>= return . show . toEncoding
   >>= liftIO . putStrLn
 
-- 
cgit v1.2.3


From 139e2b76d23b13d2b3bb70fb1d5c1ea9dc255513 Mon Sep 17 00:00:00 2001
From: pacien
Date: Mon, 23 Dec 2019 11:19:33 +0100
Subject: compiler: export aggregated json index

---
 compiler/src/Lib.hs | 68 ++++++++++++++++++++++++++++++++++++-----------------
 1 file changed, 47 insertions(+), 21 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Lib.hs b/compiler/src/Lib.hs
index 6cecfc5..e21751c 100644
--- a/compiler/src/Lib.hs
+++ b/compiler/src/Lib.hs
@@ -40,7 +40,7 @@ import Data.Text (Text, empty, pack)
 import Data.Yaml (ParseException, decodeFileEither)
 import Data.Aeson
 
-import System.FilePath (isExtensionOf)
+import System.FilePath ((</>), dropFileName, dropExtension, isExtensionOf)
 import qualified System.FilePath.Posix (joinPath)
 import System.Directory.Tree
 import System.Directory
@@ -147,44 +147,70 @@ joinURLPath :: [FileName] -> Text
 joinURLPath = pack . System.FilePath.Posix.joinPath
 
 
-toItemTree :: (MonadIO m) => FilePath -> FilePath -> DirTree SidecarItemMetadata -> m Item
+toItemTree :: (MonadIO m) => FilePath -> FilePath -> DirTree SidecarItemMetadata -> m (Item, DirTree SidecarItemMetadata)
 toItemTree itemsDir thumbnailsDir = nodeToItem []
   where
     nodeToItem pathTo d@(Dir dname dcontents) =
       mapM (nodeToItem path) dcontents
-      >>= \items -> return Item
-        { title = pack dname
-        , date = empty
-        , description = empty
-        , tags = aggregateTags items
-        , path = joinURLPath $ itemsDir:path
-        , thumbnail = Nothing
-        , properties = Directory { items = items } }
+      >>= return . unzip
+      >>= \(items, _) -> return
+        ( Item
+          { title = pack dname
+          , date = empty
+          , description = empty
+          , tags = aggregateTags items
+          , path = joinURLPath $ itemsDir:path
+          , thumbnail = Nothing
+          , properties = Directory { items = items } }
+        , d)
       where
         path = pathTo ++ [dname]
         aggregateTags = unique . concatMap (\item -> tags (item::Item))
 
     nodeToItem pathTo f@(File fname metadata) =
-      return Item
-        { title = optMeta title (pack fname)
-        , date = optMeta date empty -- TODO: check and normalise dates
-        , description = optMeta description empty
-        , tags = optMeta tags []
-        , path = joinURLPath $ itemsDir:path
-        , thumbnail = Just $ joinURLPath $ thumbnailsDir:path
-        , properties = Unknown } -- TODO
+      return
+        ( Item
+          { title = optMeta title $ pack $ dropExtension fname
+          , date = optMeta date empty -- TODO: check and normalise dates
+          , description = optMeta description empty
+          , tags = optMeta tags []
+          , path = joinURLPath $ itemsDir:path
+          , thumbnail = Just $ joinURLPath $ thumbnailsDir:path
+          , properties = Unknown } -- TODO
+        , f)
       where
         path = pathTo ++ [fname]
         optMeta get fallback = fromMaybe fallback $ get (metadata::SidecarItemMetadata)
 
 
+unrooted :: AnchoredDirTree a -> DirTree a
+unrooted t = (dirTree t) { name = "" }
+
+
+writeJSON :: ToJSON a => FilePath -> a -> IO ()
+writeJSON path obj =
+  createDirectoryIfMissing True (dropFileName path)
+  >> Data.Aeson.encodeFile path obj
+
+
+infixl 1 >>>>>>
+(>>>>>>) :: Monad m => m a -> (a -> m b) -> m a
+a >>>>>> f = a >>= f >>= return a
+
+
 process :: FilePath -> FilePath -> IO ()
 process inputDir outputDir =
   readDirectoryWith return inputDir
-  >>= metadataDirTree . dirTree
-  >>= toItemTree "items" "thumbnails"
-  >>= return . show . toEncoding
+  >>= return . unrooted
+  >>= metadataDirTree
+  >>= toItemTree itemsDir thumbnailsDir
+  >>>>>> writeJSON (outputDir </> indexFile) . fst
+  >>= return . show . toEncoding . fst
   >>= liftIO . putStrLn
+  where
+    itemsDir = "items"
+    thumbnailsDir = "thumbnails"
+    indexFile = "index.json"
 
 
 testRun :: IO ()
-- 
cgit v1.2.3


From 819ec9bfb9674375f696741816184fef06af68ed Mon Sep 17 00:00:00 2001
From: pacien
Date: Tue, 24 Dec 2019 07:34:14 +0100
Subject: compiler: assemble trees

---
 compiler/src/Lib.hs | 154 +++++++++++++++++++++++++++++++++-------------------
 1 file changed, 97 insertions(+), 57 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Lib.hs b/compiler/src/Lib.hs
index e21751c..70a2cca 100644
--- a/compiler/src/Lib.hs
+++ b/compiler/src/Lib.hs
@@ -32,7 +32,7 @@ import Control.Monad.IO.Class (MonadIO, liftIO)
 import Control.Exception (Exception, throwIO)
 
 import Data.Function
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, listToMaybe)
 import Data.List (map)
 import Data.Set (fromList, toList)
 import Data.Char (toLower)
@@ -40,7 +40,7 @@ import Data.Text (Text, empty, pack)
 import Data.Yaml (ParseException, decodeFileEither)
 import Data.Aeson
 
-import System.FilePath ((</>), dropFileName, dropExtension, isExtensionOf)
+import System.FilePath ((</>), joinPath, dropFileName, dropExtension, isExtensionOf)
 import qualified System.FilePath.Posix (joinPath)
 import System.Directory.Tree
 import System.Directory
@@ -64,7 +64,7 @@ data SidecarItemMetadata = SidecarItemMetadata
   , date :: Maybe Text
   , description :: Maybe Text
   , tags :: Maybe [Text]
-  } deriving Generic
+  } deriving (Generic, Show)
 
 instance FromJSON SidecarItemMetadata where
   parseJSON = genericParseJSON encodingOptions
@@ -80,7 +80,7 @@ type FileSizeKB = Int
 data Resolution = Resolution
   { width :: Int
   , height :: Int
-  } deriving Generic
+  } deriving (Generic, Show)
 
 instance ToJSON Resolution where
   toJSON = genericToJSON encodingOptions
@@ -92,7 +92,7 @@ data ItemProperties =
   | Image { resolution :: Resolution, filesize :: FileSizeKB }
 --  | Video { filesize :: FileSizeKB }
   | Unknown
-  deriving Generic
+  deriving (Generic, Show)
 
 instance ToJSON ItemProperties where
   toJSON = genericToJSON encodingOptions
@@ -107,7 +107,7 @@ data Item = Item
   , path :: ResourcePath
   , thumbnail :: Maybe ResourcePath
   , properties :: ItemProperties
-  } deriving Generic
+  } deriving (Generic, Show)
 
 instance ToJSON Item where
   toJSON = genericToJSON encodingOptions
@@ -125,87 +125,127 @@ decodeYamlFile fpath =
   >>= either (throwIO . LoadException fpath) return
 
 
-metadataDirTree :: DirTree FilePath -> IO (DirTree SidecarItemMetadata)
-metadataDirTree (Failed _ ferr) = ioError ferr
-metadataDirTree f@(File _ fpath) =
-  decodeYamlFile fpath
-  >>= \metadata -> return f { file = metadata }
-metadataDirTree d@(Dir _ dcontents) =
-  filter canContainMetadata dcontents
-  & mapM metadataDirTree
-  >>= \contents -> return d { contents = contents }
+toMetaTree :: DirTree FilePath -> IO (DirTree SidecarItemMetadata)
+toMetaTree tree = return (filterDir canContainMetadata tree) >>= metaNode
   where
-     canContainMetadata (Dir _ _) = True
-     canContainMetadata (File fname _) = isExtensionOf ".yaml" fname
+    -- TODO: exclude hidden files (name starting with '.')?
+    canContainMetadata :: DirTree a -> Bool
+    canContainMetadata (File fname _) = isExtensionOf ".yaml" fname
+    canContainMetadata (Dir _ _) = True
+
+    metaNode :: DirTree FilePath -> IO (DirTree SidecarItemMetadata)
+    metaNode (Failed _ ferr) = ioError ferr
+    metaNode file@(File _ fpath) = decodeYamlFile fpath
+      >>= \metadata -> return file { file = metadata }
+    metaNode dir@(Dir _ dcontents) = mapM metaNode dcontents
+      >>= \contents -> return dir { contents = contents }
 
 
 unique :: Ord a => [a] -> [a]
 unique = Data.Set.toList . Data.Set.fromList
 
-
 joinURLPath :: [FileName] -> Text
 joinURLPath = pack . System.FilePath.Posix.joinPath
 
 
-toItemTree :: (MonadIO m) => FilePath -> FilePath -> DirTree SidecarItemMetadata -> m (Item, DirTree SidecarItemMetadata)
-toItemTree itemsDir thumbnailsDir = nodeToItem []
+toItemTree :: FilePath -> FilePath -> DirTree SidecarItemMetadata -> IO Item
+toItemTree itemsDir thumbnailsDir = itemNode []
   where
-    nodeToItem pathTo d@(Dir dname dcontents) =
-      mapM (nodeToItem path) dcontents
-      >>= return . unzip
-      >>= \(items, _) -> return
-        ( Item
-          { title = pack dname
-          , date = empty
-          , description = empty
-          , tags = aggregateTags items
-          , path = joinURLPath $ itemsDir:path
-          , thumbnail = Nothing
-          , properties = Directory { items = items } }
-        , d)
+    itemNode :: [FileName] -> DirTree SidecarItemMetadata -> IO Item
+    itemNode pathTo (Dir dname dcontents) =
+      mapM (itemNode path) dcontents
+      >>= \items -> return Item
+        { title = pack dname
+        , date = empty
+        , description = empty
+        , tags = aggregateChildTags items
+        , path = joinURLPath $ itemsDir:path
+        , thumbnail = Nothing
+        , properties = Directory items }
       where
         path = pathTo ++ [dname]
-        aggregateTags = unique . concatMap (\item -> tags (item::Item))
-
-    nodeToItem pathTo f@(File fname metadata) =
-      return
-        ( Item
-          { title = optMeta title $ pack $ dropExtension fname
-          , date = optMeta date empty -- TODO: check and normalise dates
-          , description = optMeta description empty
-          , tags = optMeta tags []
-          , path = joinURLPath $ itemsDir:path
-          , thumbnail = Just $ joinURLPath $ thumbnailsDir:path
-          , properties = Unknown } -- TODO
-        , f)
+        aggregateChildTags = unique . concatMap (\item -> tags (item::Item))
+
+    itemNode pathTo (File fname metadata) =
+      return Item
+        { title = optMeta title $ pack name
+        , date = optMeta date empty -- TODO: check and normalise dates
+        , description = optMeta description empty
+        , tags = optMeta tags []
+        , path = joinURLPath $ itemsDir:path
+        , thumbnail = Just $ joinURLPath $ thumbnailsDir:path
+        , properties = Unknown } -- TODO
       where
-        path = pathTo ++ [fname]
+        name = dropExtension fname
+        path = pathTo ++ [name]
         optMeta get fallback = fromMaybe fallback $ get (metadata::SidecarItemMetadata)
 
 
+data ObjectTree = ObjectTree
+  { pathTo :: [ObjectTree]
+  , meta :: (DirTree SidecarItemMetadata)
+  , item :: Item } deriving Show
+
+rootObjectTree :: DirTree SidecarItemMetadata -> Item -> ObjectTree
+rootObjectTree = ObjectTree []
+
+toObjectTree :: (DirTree SidecarItemMetadata -> IO Item) -> DirTree SidecarItemMetadata -> IO ObjectTree
+toObjectTree itemGen meta = itemGen meta >>= return . (rootObjectTree meta)
+
+flatten :: ObjectTree -> [ObjectTree]
+flatten object@(ObjectTree _ (File _ _) _) = [object]
+flatten object@(ObjectTree pathTo (Dir _ dcontents) item) =
+  zip dcontents (items $ properties item)
+  & map (uncurry $ ObjectTree $ pathTo ++ [object])
+  & concatMap flatten
+  & (:) object
+
+objFileName :: ObjectTree -> FileName
+objFileName (ObjectTree _ (Dir name _) _) = name
+objFileName (ObjectTree _ (File name _) _) = dropExtension name -- without ".yaml"
+
+objFilePath :: ObjectTree -> FilePath
+objFilePath obj@(ObjectTree pathTo _ _) =
+  (map (name . meta) pathTo) ++ [objFileName obj]
+  & System.FilePath.joinPath
+
+
+data FileTransform = FileTransform
+  { src :: FilePath
+  , dst :: FilePath } deriving Show
+
+
+isUpToDate :: FilePath -> FilePath -> IO Bool
+isUpToDate ref target =
+  do
+    refTime <- getModificationTime ref
+    targetTime <- getModificationTime target
+    return (target >= ref)
+
+
 unrooted :: AnchoredDirTree a -> DirTree a
 unrooted t = (dirTree t) { name = "" }
 
-
 writeJSON :: ToJSON a => FilePath -> a -> IO ()
 writeJSON path obj =
   createDirectoryIfMissing True (dropFileName path)
   >> Data.Aeson.encodeFile path obj
 
-
-infixl 1 >>>>>>
-(>>>>>>) :: Monad m => m a -> (a -> m b) -> m a
-a >>>>>> f = a >>= f >>= return a
-
+passthrough :: Monad m => (a -> m b) -> a -> m a
+passthrough f a = return a >>= f >>= \_ -> return a
 
 process :: FilePath -> FilePath -> IO ()
 process inputDir outputDir =
   readDirectoryWith return inputDir
   >>= return . unrooted
-  >>= metadataDirTree
-  >>= toItemTree itemsDir thumbnailsDir
-  >>>>>> writeJSON (outputDir </> indexFile) . fst
-  >>= return . show . toEncoding . fst
+  >>= toMetaTree
+  >>= toObjectTree (toItemTree itemsDir thumbnailsDir)
+  >>= passthrough (writeJSON (outputDir </> indexFile) . item)
+  >>= return . flatten
+--  >>= mapM (return . pathTo)
+  >>= return . (map objFilePath)
+  >>= return . show
+--  >>= return . show . toEncoding . item
   >>= liftIO . putStrLn
   where
     itemsDir = "items"
-- 
cgit v1.2.3


From 0b2f6fb420d213b4ee718b9ac79cc3f9fa7678d5 Mon Sep 17 00:00:00 2001
From: pacien
Date: Wed, 25 Dec 2019 21:04:31 +0100
Subject: compiler: refactor transform stages

---
 compiler/src/Files.hs    | 104 ++++++++++++++++++++
 compiler/src/Gallery.hs  | 123 +++++++++++++++++++++++
 compiler/src/Input.hs    |  95 ++++++++++++++++++
 compiler/src/Lib.hs      | 251 ++++++-----------------------------------------
 compiler/src/Resource.hs |  58 +++++++++++
 compiler/src/Utils.hs    |  49 +++++++++
 6 files changed, 461 insertions(+), 219 deletions(-)
 create mode 100644 compiler/src/Files.hs
 create mode 100644 compiler/src/Gallery.hs
 create mode 100644 compiler/src/Input.hs
 create mode 100644 compiler/src/Resource.hs
 create mode 100644 compiler/src/Utils.hs

(limited to 'compiler/src')

diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
new file mode 100644
index 0000000..7948842
--- /dev/null
+++ b/compiler/src/Files.hs
@@ -0,0 +1,104 @@
+{-# LANGUAGE DuplicateRecordFields, DeriveGeneric #-}
+
+-- ldgallery - A static generator which turns a collection of tagged
+--             pictures into a searchable web gallery.
+--
+-- Copyright (C) 2019  Pacien TRAN-GIRARD
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU Affero General Public License as
+-- published by the Free Software Foundation, either version 3 of the
+-- License, or (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-- GNU Affero General Public License for more details.
+--
+-- You should have received a copy of the GNU Affero General Public License
+-- along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+
+module Files
+  ( FileName, LocalPath, WebPath, Path
+  , (</>), (</), (/>), localPath, webPath
+  , FSNode(..), AnchoredFSNode(..)
+  , nodePath, nodeName, isHidden, flatten, filterDir, readDirectory
+  ) where
+
+
+import Control.Monad (filterM, mapM)
+import Data.Bool (bool)
+import Data.List (isPrefixOf, length, deleteBy)
+import Data.Function ((&))
+import System.Directory (doesDirectoryExist, listDirectory)
+import qualified System.FilePath
+import qualified System.FilePath.Posix
+import Utils
+
+
+type FileName = String
+type LocalPath = String
+type WebPath = String
+
+ -- | Reversed path component list
+type Path = [FileName]
+
+(</>) :: Path -> Path -> Path
+l </> r = r ++ l
+
+(</) :: Path -> FileName -> Path
+path </ file = file:path
+
+(/>) :: FileName -> Path -> Path
+file /> path = path ++ [file]
+
+localPath :: Path -> LocalPath
+localPath = System.FilePath.joinPath . reverse
+
+webPath :: Path -> WebPath
+webPath = System.FilePath.Posix.joinPath . reverse
+
+
+data FSNode = File Path | Dir Path [FSNode] deriving Show
+data AnchoredFSNode = AnchoredFSNode
+  { anchor :: LocalPath
+  , root :: FSNode } deriving Show
+
+nodePath :: FSNode -> Path
+nodePath (File path) = path
+nodePath (Dir path _) = path
+
+nodeName :: FSNode -> FileName
+nodeName = head . nodePath
+
+isHidden :: FSNode -> Bool
+isHidden node = "." `isPrefixOf` filename && length filename > 1
+  where filename = nodeName node
+
+flatten :: FSNode -> [FSNode]
+flatten file@(File _) = [file]
+flatten dir@(Dir _ childs) = dir:(concatMap flatten childs)
+
+-- | Filters a dir tree. The root is always returned.
+filterDir :: (FSNode -> Bool) -> FSNode -> FSNode
+filterDir _ file@(File _) = file
+filterDir cond (Dir path childs) =
+  filter cond childs & map (filterDir cond) & Dir path
+
+readDirectory :: LocalPath -> IO AnchoredFSNode
+readDirectory root = mkNode [""] >>= return . AnchoredFSNode root
+  where
+    mkNode :: Path -> IO FSNode
+    mkNode path =
+      (doesDirectoryExist $ localPath (root /> path))
+      >>= bool (mkFileNode path) (mkDirNode path)
+
+    mkFileNode :: Path -> IO FSNode
+    mkFileNode path = return $ File path
+
+    mkDirNode :: Path -> IO FSNode
+    mkDirNode path =
+      (listDirectory $ localPath (root /> path))
+      >>= mapM (mkNode . ((</) path))
+      >>= return . Dir path
diff --git a/compiler/src/Gallery.hs b/compiler/src/Gallery.hs
new file mode 100644
index 0000000..3be62ad
--- /dev/null
+++ b/compiler/src/Gallery.hs
@@ -0,0 +1,123 @@
+{-# LANGUAGE DuplicateRecordFields, DeriveGeneric, DeriveAnyClass #-}
+
+-- ldgallery - A static generator which turns a collection of tagged
+--             pictures into a searchable web gallery.
+--
+-- Copyright (C) 2019  Pacien TRAN-GIRARD
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU Affero General Public License as
+-- published by the Free Software Foundation, either version 3 of the
+-- License, or (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-- GNU Affero General Public License for more details.
+--
+-- You should have received a copy of the GNU Affero General Public License
+-- along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+
+module Gallery
+  ( GalleryItem(..), buildGalleryTree
+  ) where
+
+
+import GHC.Generics (Generic)
+import Data.Char (toLower)
+import Data.Function ((&))
+import Data.Maybe (fromMaybe)
+
+import Data.Aeson (ToJSON, genericToJSON, genericToEncoding)
+import qualified Data.Aeson as JSON
+
+import Utils
+import Files
+import Input
+import Resource
+
+
+encodingOptions :: JSON.Options
+encodingOptions = JSON.defaultOptions
+  { JSON.fieldLabelModifier = map toLower
+  , JSON.constructorTagModifier = map toLower
+  , JSON.sumEncoding = JSON.defaultTaggedObject
+      { JSON.tagFieldName = "type"
+      , JSON.contentsFieldName = "contents"
+      }
+  }
+
+
+type ResourcePath = String
+type Tag = String
+type FileSizeKB = Int
+
+
+data Resolution = Resolution
+  { width :: Int
+  , height :: Int
+  } deriving (Generic, Show)
+
+instance ToJSON Resolution where
+  toJSON = genericToJSON encodingOptions
+  toEncoding = genericToEncoding encodingOptions
+
+
+data GalleryItemProps =
+    Directory { items :: [GalleryItem] }
+--  | Image { resolution :: Resolution, filesize :: FileSizeKB }
+--  | Video { filesize :: FileSizeKB }
+  | Unknown
+  deriving (Generic, Show)
+
+instance ToJSON GalleryItemProps where
+  toJSON = genericToJSON encodingOptions
+  toEncoding = genericToEncoding encodingOptions
+
+
+-- TODO: fuse GalleryItem and GalleryItemProps
+data GalleryItem = GalleryItem
+  { title :: String
+  , date :: String -- TODO: checked ISO8601 date
+  , description :: String
+  , tags :: [Tag]
+  , path :: ResourcePath
+  , thumbnail :: Maybe ResourcePath
+  , properties :: GalleryItemProps
+  } deriving (Generic, Show)
+
+instance ToJSON GalleryItem where
+  toJSON = genericToJSON encodingOptions
+  toEncoding = genericToEncoding encodingOptions
+
+
+buildGalleryTree :: ResourceTree -> GalleryItem
+buildGalleryTree (ItemResource sidecar path@(filename:_) thumbnailPath) =
+  GalleryItem
+    { title = optMeta title filename
+    , date = optMeta date "" -- TODO: check and normalise dates
+    , description = optMeta description ""
+    , tags = optMeta tags []
+    , path = webPath path
+    , thumbnail = Just $ webPath thumbnailPath
+    , properties = Unknown } -- TODO
+  where
+    optMeta :: (Sidecar -> Maybe a) -> a -> a
+    optMeta get fallback = fromMaybe fallback $ get sidecar
+
+buildGalleryTree (DirResource dirItems path@(dirname:_) thumbnailPath) =
+  map buildGalleryTree dirItems
+  & \items -> GalleryItem
+    { title = dirname
+      -- TODO: consider using the most recent item's date? what if empty?
+    , date = ""
+      -- TODO: consider allowing metadata sidecars for directories too
+    , description = ""
+    , tags = aggregateChildTags items
+    , path = webPath path
+    , thumbnail = fmap webPath thumbnailPath
+    , properties = Directory items }
+  where
+    aggregateChildTags :: [GalleryItem] -> [Tag]
+    aggregateChildTags = unique . concatMap (\item -> tags (item::GalleryItem))
diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs
new file mode 100644
index 0000000..78622bf
--- /dev/null
+++ b/compiler/src/Input.hs
@@ -0,0 +1,95 @@
+{-# LANGUAGE DuplicateRecordFields, DeriveGeneric, DeriveAnyClass #-}
+
+-- ldgallery - A static generator which turns a collection of tagged
+--             pictures into a searchable web gallery.
+--
+-- Copyright (C) 2019  Pacien TRAN-GIRARD
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU Affero General Public License as
+-- published by the Free Software Foundation, either version 3 of the
+-- License, or (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-- GNU Affero General Public License for more details.
+--
+-- You should have received a copy of the GNU Affero General Public License
+-- along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+
+module Input
+  ( Sidecar, title, date, description, tags
+  , InputTree(..), readInputTree
+  ) where
+
+
+import GHC.Generics (Generic)
+import Control.Exception (Exception, throwIO)
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Data.Function ((&))
+import Data.Maybe (mapMaybe, catMaybes)
+import Data.List (find)
+import Data.Yaml (ParseException, decodeFileEither)
+import Data.Aeson (FromJSON)
+import System.FilePath (isExtensionOf, dropExtension)
+
+import Files
+import Utils
+
+
+data LoadException = LoadException String ParseException deriving Show
+instance Exception LoadException
+
+decodeYamlFile :: (MonadIO m, FromJSON a) => Path -> m a
+decodeYamlFile path =
+  liftIO $ Data.Yaml.decodeFileEither fpath
+  >>= either (throwIO . LoadException fpath) return
+  where
+    fpath = localPath path
+
+
+-- | Tree representing the input from the input directory.
+data InputTree =
+    InputFile
+      { path :: Path
+      , sidecar :: Sidecar }
+    | InputDir
+      { path :: Path
+      , thumbnailPath :: Maybe Path
+      , items :: [InputTree] }
+  deriving Show
+
+data Sidecar = Sidecar
+  { title :: Maybe String
+  , date :: Maybe String
+  , description :: Maybe String
+  , tags :: Maybe [String]
+  } deriving (Generic, FromJSON, Show)
+
+
+readInputTree :: AnchoredFSNode -> IO InputTree
+readInputTree (AnchoredFSNode anchor root@Dir{}) =
+  filterDir (neg isHidden) root & mkDirNode
+  where
+    mkInputNode :: FSNode -> IO (Maybe InputTree)
+    mkInputNode (File path@(filename:pathto)) | ".yaml" `isExtensionOf` filename =
+      decodeYamlFile (anchor /> path)
+      >>= return . InputFile ((dropExtension filename):pathto)
+      >>= return . Just
+    mkInputNode File{} = return Nothing
+    mkInputNode dir@Dir{} = mkDirNode dir >>= return . Just
+
+    mkDirNode :: FSNode -> IO InputTree
+    mkDirNode (Dir path items) =
+      mapM mkInputNode items
+      >>= return . catMaybes
+      >>= return . InputDir path (findThumbnail items)
+      where
+        findThumbnail :: [FSNode] -> Maybe Path
+        findThumbnail = (fmap nodePath) . (find matchThumbnail)
+
+        matchThumbnail :: FSNode -> Bool
+        matchThumbnail Dir{} = False
+        matchThumbnail (File (filename:_)) = (dropExtension filename) == "thumbnail"
diff --git a/compiler/src/Lib.hs b/compiler/src/Lib.hs
index 70a2cca..bab7e9c 100644
--- a/compiler/src/Lib.hs
+++ b/compiler/src/Lib.hs
@@ -1,11 +1,7 @@
-{-# LANGUAGE DuplicateRecordFields, DeriveGeneric #-}
-
-
 -- ldgallery - A static generator which turns a collection of tagged
 --             pictures into a searchable web gallery.
 --
 -- Copyright (C) 2019  Pacien TRAN-GIRARD
---               2019  Guillaume FOUET
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of the GNU Affero General Public License as
@@ -26,232 +22,49 @@ module Lib
   ) where
 
 
-import GHC.Generics
-
-import Control.Monad.IO.Class (MonadIO, liftIO)
-import Control.Exception (Exception, throwIO)
-
-import Data.Function
-import Data.Maybe (fromMaybe, listToMaybe)
-import Data.List (map)
-import Data.Set (fromList, toList)
-import Data.Char (toLower)
-import Data.Text (Text, empty, pack)
-import Data.Yaml (ParseException, decodeFileEither)
-import Data.Aeson
-
-import System.FilePath ((</>), joinPath, dropFileName, dropExtension, isExtensionOf)
-import qualified System.FilePath.Posix (joinPath)
-import System.Directory.Tree
-import System.Directory
-
-
-encodingOptions :: Options
-encodingOptions = defaultOptions
-  { fieldLabelModifier = map toLower
-  , constructorTagModifier = map toLower
-  , sumEncoding = defaultTaggedObject
-      { tagFieldName = "type"
-      , contentsFieldName = "contents"
-      }
-  }
-
-
--- input structure
-
-data SidecarItemMetadata = SidecarItemMetadata
-  { title :: Maybe Text
-  , date :: Maybe Text
-  , description :: Maybe Text
-  , tags :: Maybe [Text]
-  } deriving (Generic, Show)
-
-instance FromJSON SidecarItemMetadata where
-  parseJSON = genericParseJSON encodingOptions
-
-
--- output structures
-
-type ResourcePath = Text
-type Tag = Text
-type FileSizeKB = Int
-
-
-data Resolution = Resolution
-  { width :: Int
-  , height :: Int
-  } deriving (Generic, Show)
-
-instance ToJSON Resolution where
-  toJSON = genericToJSON encodingOptions
-  toEncoding = genericToEncoding encodingOptions
-
-
-data ItemProperties =
-    Directory { items :: [Item] }
-  | Image { resolution :: Resolution, filesize :: FileSizeKB }
---  | Video { filesize :: FileSizeKB }
-  | Unknown
-  deriving (Generic, Show)
-
-instance ToJSON ItemProperties where
-  toJSON = genericToJSON encodingOptions
-  toEncoding = genericToEncoding encodingOptions
-
-
-data Item = Item
-  { title :: Text
-  , date :: Text -- TODO: checked ISO8601 date
-  , description :: Text
-  , tags :: [Tag]
-  , path :: ResourcePath
-  , thumbnail :: Maybe ResourcePath
-  , properties :: ItemProperties
-  } deriving (Generic, Show)
-
-instance ToJSON Item where
-  toJSON = genericToJSON encodingOptions
-  toEncoding = genericToEncoding encodingOptions
-
+import GHC.Generics (Generic)
+import Data.Function ((&))
+import System.Directory (createDirectoryIfMissing)
+import System.FilePath (dropFileName, (</>))
+import Data.Aeson (ToJSON, encodeFile)
 
--- mapping
+import Files (FileName, readDirectory)
+import Input (readInputTree)
+import Resource (buildResourceTree)
+import Gallery (buildGalleryTree)
 
-data LoadException = LoadException String ParseException deriving Show
-instance Exception LoadException
 
-decodeYamlFile :: (MonadIO m, FromJSON a) => FilePath -> m a
-decodeYamlFile fpath =
-  liftIO $ Data.Yaml.decodeFileEither fpath
-  >>= either (throwIO . LoadException fpath) return
-
-
-toMetaTree :: DirTree FilePath -> IO (DirTree SidecarItemMetadata)
-toMetaTree tree = return (filterDir canContainMetadata tree) >>= metaNode
-  where
-    -- TODO: exclude hidden files (name starting with '.')?
-    canContainMetadata :: DirTree a -> Bool
-    canContainMetadata (File fname _) = isExtensionOf ".yaml" fname
-    canContainMetadata (Dir _ _) = True
-
-    metaNode :: DirTree FilePath -> IO (DirTree SidecarItemMetadata)
-    metaNode (Failed _ ferr) = ioError ferr
-    metaNode file@(File _ fpath) = decodeYamlFile fpath
-      >>= \metadata -> return file { file = metadata }
-    metaNode dir@(Dir _ dcontents) = mapM metaNode dcontents
-      >>= \contents -> return dir { contents = contents }
-
-
-unique :: Ord a => [a] -> [a]
-unique = Data.Set.toList . Data.Set.fromList
-
-joinURLPath :: [FileName] -> Text
-joinURLPath = pack . System.FilePath.Posix.joinPath
-
-
-toItemTree :: FilePath -> FilePath -> DirTree SidecarItemMetadata -> IO Item
-toItemTree itemsDir thumbnailsDir = itemNode []
-  where
-    itemNode :: [FileName] -> DirTree SidecarItemMetadata -> IO Item
-    itemNode pathTo (Dir dname dcontents) =
-      mapM (itemNode path) dcontents
-      >>= \items -> return Item
-        { title = pack dname
-        , date = empty
-        , description = empty
-        , tags = aggregateChildTags items
-        , path = joinURLPath $ itemsDir:path
-        , thumbnail = Nothing
-        , properties = Directory items }
-      where
-        path = pathTo ++ [dname]
-        aggregateChildTags = unique . concatMap (\item -> tags (item::Item))
-
-    itemNode pathTo (File fname metadata) =
-      return Item
-        { title = optMeta title $ pack name
-        , date = optMeta date empty -- TODO: check and normalise dates
-        , description = optMeta description empty
-        , tags = optMeta tags []
-        , path = joinURLPath $ itemsDir:path
-        , thumbnail = Just $ joinURLPath $ thumbnailsDir:path
-        , properties = Unknown } -- TODO
-      where
-        name = dropExtension fname
-        path = pathTo ++ [name]
-        optMeta get fallback = fromMaybe fallback $ get (metadata::SidecarItemMetadata)
-
-
-data ObjectTree = ObjectTree
-  { pathTo :: [ObjectTree]
-  , meta :: (DirTree SidecarItemMetadata)
-  , item :: Item } deriving Show
-
-rootObjectTree :: DirTree SidecarItemMetadata -> Item -> ObjectTree
-rootObjectTree = ObjectTree []
-
-toObjectTree :: (DirTree SidecarItemMetadata -> IO Item) -> DirTree SidecarItemMetadata -> IO ObjectTree
-toObjectTree itemGen meta = itemGen meta >>= return . (rootObjectTree meta)
-
-flatten :: ObjectTree -> [ObjectTree]
-flatten object@(ObjectTree _ (File _ _) _) = [object]
-flatten object@(ObjectTree pathTo (Dir _ dcontents) item) =
-  zip dcontents (items $ properties item)
-  & map (uncurry $ ObjectTree $ pathTo ++ [object])
-  & concatMap flatten
-  & (:) object
-
-objFileName :: ObjectTree -> FileName
-objFileName (ObjectTree _ (Dir name _) _) = name
-objFileName (ObjectTree _ (File name _) _) = dropExtension name -- without ".yaml"
-
-objFilePath :: ObjectTree -> FilePath
-objFilePath obj@(ObjectTree pathTo _ _) =
-  (map (name . meta) pathTo) ++ [objFileName obj]
-  & System.FilePath.joinPath
-
-
-data FileTransform = FileTransform
-  { src :: FilePath
-  , dst :: FilePath } deriving Show
+writeJSON :: ToJSON a => FileName -> a -> IO ()
+writeJSON path obj =
+  createDirectoryIfMissing True (dropFileName path)
+  >> encodeFile path obj
 
 
-isUpToDate :: FilePath -> FilePath -> IO Bool
-isUpToDate ref target =
+process :: FilePath -> FilePath -> IO ()
+process inputDirPath outputDirPath =
   do
-    refTime <- getModificationTime ref
-    targetTime <- getModificationTime target
-    return (target >= ref)
+    inputDir <- readDirectory inputDirPath
+    putStrLn "\nINPUT DIR"
+    putStrLn (show inputDir)
 
+    outputDir <- readDirectory outputDirPath
+    putStrLn "\nOUTPUT DIR"
+    putStrLn (show outputDir)
 
-unrooted :: AnchoredDirTree a -> DirTree a
-unrooted t = (dirTree t) { name = "" }
+    inputTree <- readInputTree inputDir
+    putStrLn "\nINPUT TREE"
+    putStrLn (show inputTree)
 
-writeJSON :: ToJSON a => FilePath -> a -> IO ()
-writeJSON path obj =
-  createDirectoryIfMissing True (dropFileName path)
-  >> Data.Aeson.encodeFile path obj
+    let resourceTree = buildResourceTree inputTree
+    putStrLn "\nRESOURCE TREE"
+    putStrLn (show resourceTree)
 
-passthrough :: Monad m => (a -> m b) -> a -> m a
-passthrough f a = return a >>= f >>= \_ -> return a
+    -- TODO: make buildResourceTree build a resource compilation strategy
+    -- TODO: clean up output dir by comparing its content with the resource tree
+    -- TODO: execute (in parallel) the resource compilation strategy list
 
-process :: FilePath -> FilePath -> IO ()
-process inputDir outputDir =
-  readDirectoryWith return inputDir
-  >>= return . unrooted
-  >>= toMetaTree
-  >>= toObjectTree (toItemTree itemsDir thumbnailsDir)
-  >>= passthrough (writeJSON (outputDir </> indexFile) . item)
-  >>= return . flatten
---  >>= mapM (return . pathTo)
-  >>= return . (map objFilePath)
-  >>= return . show
---  >>= return . show . toEncoding . item
-  >>= liftIO . putStrLn
-  where
-    itemsDir = "items"
-    thumbnailsDir = "thumbnails"
-    indexFile = "index.json"
+    buildGalleryTree resourceTree & writeJSON (outputDirPath </> "index.json")
 
 
 testRun :: IO ()
-testRun = process "../example" "../out"
+testRun = process "../../example" "../../out"
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
new file mode 100644
index 0000000..04e315a
--- /dev/null
+++ b/compiler/src/Resource.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE DuplicateRecordFields, DeriveGeneric, DeriveAnyClass #-}
+
+-- ldgallery - A static generator which turns a collection of tagged
+--             pictures into a searchable web gallery.
+--
+-- Copyright (C) 2019  Pacien TRAN-GIRARD
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU Affero General Public License as
+-- published by the Free Software Foundation, either version 3 of the
+-- License, or (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-- GNU Affero General Public License for more details.
+--
+-- You should have received a copy of the GNU Affero General Public License
+-- along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+
+module Resource
+  ( ResourceTree(..)
+  , buildResourceTree
+  ) where
+
+
+import Data.Function ((&))
+import Files
+import Input
+
+
+-- | Tree representing the compiled gallery resources.
+data ResourceTree =
+    ItemResource
+      { sidecar :: Sidecar
+      , path :: Path
+      , itemThumbnailPath :: Path }
+  | DirResource
+      { items :: [ResourceTree]
+      , path :: Path
+      , dirThumbnailPath :: Maybe Path }
+  deriving Show
+
+
+  -- TODO: actually generate compilation strategies
+buildResourceTree :: InputTree -> ResourceTree
+buildResourceTree = resNode
+  where
+    resNode (InputFile path sidecar) =
+      ItemResource sidecar (itemsDir /> path) (thumbnailsDir /> path)
+
+    resNode (InputDir path thumbnailPath items) =
+      map resNode items
+      & \dirItems -> DirResource dirItems (itemsDir /> path) Nothing
+
+    itemsDir = "items"
+    thumbnailsDir = "thumbnails"
diff --git a/compiler/src/Utils.hs b/compiler/src/Utils.hs
new file mode 100644
index 0000000..794382c
--- /dev/null
+++ b/compiler/src/Utils.hs
@@ -0,0 +1,49 @@
+-- ldgallery - A static generator which turns a collection of tagged
+--             pictures into a searchable web gallery.
+--
+-- Copyright (C) 2019  Pacien TRAN-GIRARD
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU Affero General Public License as
+-- published by the Free Software Foundation, either version 3 of the
+-- License, or (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-- GNU Affero General Public License for more details.
+--
+-- You should have received a copy of the GNU Affero General Public License
+-- along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+
+module Utils
+  ( conj, neg
+  , unique
+  , passthrough
+  ) where
+
+
+import qualified Data.List
+import qualified Data.Set
+
+
+-- predicates
+
+conj :: (a -> Bool) -> (a -> Bool) -> a -> Bool
+conj p q x = (p x) && (q x)
+
+neg :: (a -> Bool) -> a -> Bool
+neg p x = not (p x)
+
+
+-- lists
+
+unique :: Ord a => [a] -> [a]
+unique = Data.Set.toList . Data.Set.fromList
+
+
+-- monads
+
+passthrough :: Monad m => (a -> m b) -> a -> m a
+passthrough f a = return a >>= f >>= \_ -> return a
-- 
cgit v1.2.3


From 5b35285daa62fb9c10280fb43e340ba7b0746f5a Mon Sep 17 00:00:00 2001
From: pacien
Date: Wed, 25 Dec 2019 22:48:34 +0100
Subject: compiler: add gallery config file handling

---
 compiler/src/Files.hs |  2 +-
 compiler/src/Input.hs | 13 ++++++-------
 compiler/src/Lib.hs   | 41 +++++++++++++++++++++++++++++++++++------
 3 files changed, 42 insertions(+), 14 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 7948842..30e4b94 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -32,9 +32,9 @@ import Data.Bool (bool)
 import Data.List (isPrefixOf, length, deleteBy)
 import Data.Function ((&))
 import System.Directory (doesDirectoryExist, listDirectory)
+
 import qualified System.FilePath
 import qualified System.FilePath.Posix
-import Utils
 
 
 type FileName = String
diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs
index 78622bf..fa36d59 100644
--- a/compiler/src/Input.hs
+++ b/compiler/src/Input.hs
@@ -20,7 +20,8 @@
 
 
 module Input
-  ( Sidecar, title, date, description, tags
+  ( decodeYamlFile
+  , Sidecar, title, date, description, tags
   , InputTree(..), readInputTree
   ) where
 
@@ -42,12 +43,10 @@ import Utils
 data LoadException = LoadException String ParseException deriving Show
 instance Exception LoadException
 
-decodeYamlFile :: (MonadIO m, FromJSON a) => Path -> m a
+decodeYamlFile :: (MonadIO m, FromJSON a) => FileName -> m a
 decodeYamlFile path =
-  liftIO $ Data.Yaml.decodeFileEither fpath
-  >>= either (throwIO . LoadException fpath) return
-  where
-    fpath = localPath path
+  liftIO $ Data.Yaml.decodeFileEither path
+  >>= either (throwIO . LoadException path) return
 
 
 -- | Tree representing the input from the input directory.
@@ -75,7 +74,7 @@ readInputTree (AnchoredFSNode anchor root@Dir{}) =
   where
     mkInputNode :: FSNode -> IO (Maybe InputTree)
     mkInputNode (File path@(filename:pathto)) | ".yaml" `isExtensionOf` filename =
-      decodeYamlFile (anchor /> path)
+      decodeYamlFile (localPath $ anchor /> path)
       >>= return . InputFile ((dropExtension filename):pathto)
       >>= return . Just
     mkInputNode File{} = return Nothing
diff --git a/compiler/src/Lib.hs b/compiler/src/Lib.hs
index bab7e9c..abdbeb7 100644
--- a/compiler/src/Lib.hs
+++ b/compiler/src/Lib.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DuplicateRecordFields, DeriveGeneric, DeriveAnyClass #-}
+
 -- ldgallery - A static generator which turns a collection of tagged
 --             pictures into a searchable web gallery.
 --
@@ -26,23 +28,32 @@ import GHC.Generics (Generic)
 import Data.Function ((&))
 import System.Directory (createDirectoryIfMissing)
 import System.FilePath (dropFileName, (</>))
-import Data.Aeson (ToJSON, encodeFile)
+import Data.Aeson (Object, ToJSON, FromJSON, encodeFile)
 
 import Files (FileName, readDirectory)
-import Input (readInputTree)
+import Input (decodeYamlFile, readInputTree)
 import Resource (buildResourceTree)
 import Gallery (buildGalleryTree)
 
 
-writeJSON :: ToJSON a => FileName -> a -> IO ()
-writeJSON path obj =
-  createDirectoryIfMissing True (dropFileName path)
-  >> encodeFile path obj
+data CompilerConfig = CompilerConfig
+  { dummy :: Maybe String -- TODO
+  } deriving (Generic, FromJSON, Show)
+
+data GalleryConfig = GalleryConfig
+  { compiler :: CompilerConfig
+  , viewer :: Data.Aeson.Object
+  } deriving (Generic, FromJSON, Show)
+
+readConfig :: FileName -> IO GalleryConfig
+readConfig = decodeYamlFile
 
 
 process :: FilePath -> FilePath -> IO ()
 process inputDirPath outputDirPath =
   do
+    config <- readConfig (inputDirPath </> "gallery.yaml")
+
     inputDir <- readDirectory inputDirPath
     putStrLn "\nINPUT DIR"
     putStrLn (show inputDir)
@@ -60,10 +71,28 @@ process inputDirPath outputDirPath =
     putStrLn (show resourceTree)
 
     -- TODO: make buildResourceTree build a resource compilation strategy
+    -- (need to know the settings)
+    -- flatten the tree of resources and their strategies
+    -- filter resources that are already up to date
+    --   (or recompile everything if the config file has changed!)
+    -- execute in parallel
+
     -- TODO: clean up output dir by comparing its content with the resource tree
+    -- aggregate both trees as list
+    -- compute the difference
+    -- sort by deepest and erase files and dirs
+
     -- TODO: execute (in parallel) the resource compilation strategy list
+    -- need to find a good library for that
 
     buildGalleryTree resourceTree & writeJSON (outputDirPath </> "index.json")
+    writeJSON (outputDirPath </> "viewer.json") (viewer config)
+
+  where
+    writeJSON :: ToJSON a => FileName -> a -> IO ()
+    writeJSON path obj =
+      createDirectoryIfMissing True (dropFileName path)
+      >> encodeFile path obj
 
 
 testRun :: IO ()
-- 
cgit v1.2.3


From 45163fbc93b2bf2f7cb1fc3242ce5d3f51076601 Mon Sep 17 00:00:00 2001
From: pacien
Date: Wed, 25 Dec 2019 22:56:16 +0100
Subject: cosmetic

---
 compiler/src/Lib.hs | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Lib.hs b/compiler/src/Lib.hs
index abdbeb7..2068b4a 100644
--- a/compiler/src/Lib.hs
+++ b/compiler/src/Lib.hs
@@ -28,7 +28,9 @@ import GHC.Generics (Generic)
 import Data.Function ((&))
 import System.Directory (createDirectoryIfMissing)
 import System.FilePath (dropFileName, (</>))
-import Data.Aeson (Object, ToJSON, FromJSON, encodeFile)
+
+import Data.Aeson (ToJSON, FromJSON)
+import qualified Data.Aeson as JSON
 
 import Files (FileName, readDirectory)
 import Input (decodeYamlFile, readInputTree)
@@ -42,7 +44,7 @@ data CompilerConfig = CompilerConfig
 
 data GalleryConfig = GalleryConfig
   { compiler :: CompilerConfig
-  , viewer :: Data.Aeson.Object
+  , viewer :: JSON.Object
   } deriving (Generic, FromJSON, Show)
 
 readConfig :: FileName -> IO GalleryConfig
@@ -92,7 +94,7 @@ process inputDirPath outputDirPath =
     writeJSON :: ToJSON a => FileName -> a -> IO ()
     writeJSON path obj =
       createDirectoryIfMissing True (dropFileName path)
-      >> encodeFile path obj
+      >> JSON.encodeFile path obj
 
 
 testRun :: IO ()
-- 
cgit v1.2.3


From 2a6467272e18af4864745b9d0267f9fa3ed382dd Mon Sep 17 00:00:00 2001
From: pacien
Date: Thu, 26 Dec 2019 01:13:42 +0100
Subject: compiler: implement output dir cleanup

---
 compiler/src/Files.hs    | 11 ++++++-----
 compiler/src/Lib.hs      | 32 +++++++++++++++++++-------------
 compiler/src/Resource.hs | 35 ++++++++++++++++++++++++++++++-----
 3 files changed, 55 insertions(+), 23 deletions(-)

(limited to 'compiler/src')

diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 30e4b94..77a8c5b 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -23,7 +23,7 @@ module Files
   ( FileName, LocalPath, WebPath, Path
   , (</>), (</), (/>), localPath, webPath
   , FSNode(..), AnchoredFSNode(..)
-  , nodePath, nodeName, isHidden, flatten, filterDir, readDirectory
+  , nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory
   ) where
 
 
@@ -76,9 +76,10 @@ isHidden :: FSNode -> Bool
 isHidden node = "." `isPrefixOf` filename && length filename > 1
   where filename = nodeName node
 
-flatten :: FSNode -> [FSNode]
-flatten file@(File _) = [file]
-flatten dir@(Dir _ childs) = dir:(concatMap flatten childs)
+-- | DFS with intermediate dirs first.
+flattenDir :: FSNode -> [FSNode]
+flattenDir file@(File _) = [file]
+flattenDir dir@(Dir _ childs) = dir:(concatMap flattenDir childs)
 
 -- | Filters a dir tree. The root is always returned.
 filterDir :: (FSNode -> Bool) -> FSNode -> FSNode
@@ -87,7 +88,7 @@ filterDir cond (Dir path childs) =
   filter cond childs & map (filterDir cond) & Dir path
 
 readDirectory :: LocalPath -> IO AnchoredFSNode
-readDirectory root = mkNode [""] >>= return . AnchoredFSNode root
+readDirectory root = mkNode [] >>= return . AnchoredFSNode root
   where
     mkNode :: Path -> IO FSNode
     mkNode path =
diff --git a/compiler/src/Lib.hs b/compiler/src/Lib.hs
index 2068b4a..643e5f6 100644
--- a/compiler/src/Lib.hs
+++ b/compiler/src/Lib.hs
@@ -26,15 +26,17 @@ module Lib
 
 import GHC.Generics (Generic)
 import Data.Function ((&))
-import System.Directory (createDirectoryIfMissing)
+import Data.Ord (comparing)
+import Data.List (sortBy, length)
+import System.Directory (createDirectoryIfMissing, removePathForcibly)
 import System.FilePath (dropFileName, (</>))
 
 import Data.Aeson (ToJSON, FromJSON)
 import qualified Data.Aeson as JSON
 
-import Files (FileName, readDirectory)
+import Files (FileName, readDirectory, localPath, flattenDir, root, (/>))
 import Input (decodeYamlFile, readInputTree)
-import Resource (buildResourceTree)
+import Resource (ResourceTree, buildResourceTree, outputDiff)
 import Gallery (buildGalleryTree)
 
 
@@ -60,10 +62,6 @@ process inputDirPath outputDirPath =
     putStrLn "\nINPUT DIR"
     putStrLn (show inputDir)
 
-    outputDir <- readDirectory outputDirPath
-    putStrLn "\nOUTPUT DIR"
-    putStrLn (show outputDir)
-
     inputTree <- readInputTree inputDir
     putStrLn "\nINPUT TREE"
     putStrLn (show inputTree)
@@ -79,18 +77,26 @@ process inputDirPath outputDirPath =
     --   (or recompile everything if the config file has changed!)
     -- execute in parallel
 
-    -- TODO: clean up output dir by comparing its content with the resource tree
-    -- aggregate both trees as list
-    -- compute the difference
-    -- sort by deepest and erase files and dirs
+    cleanup resourceTree outputDirPath
 
     -- TODO: execute (in parallel) the resource compilation strategy list
     -- need to find a good library for that
 
-    buildGalleryTree resourceTree & writeJSON (outputDirPath </> "index.json")
-    writeJSON (outputDirPath </> "viewer.json") (viewer config)
+    buildGalleryTree resourceTree
+      & writeJSON (outputDirPath </> "index.json")
+
+    viewer config
+      & writeJSON (outputDirPath </> "viewer.json")
 
   where
+    cleanup :: ResourceTree -> FileName -> IO ()
+    cleanup resourceTree outputDir =
+      readDirectory outputDir
+      >>= return . outputDiff resourceTree . root
+      >>= return . sortBy (flip $ comparing length) -- nested files before dirs
+      >>= return . map (localPath . (/>) outputDir)
+      >>= mapM_ removePathForcibly
+
     writeJSON :: ToJSON a => FileName -> a -> IO ()
     writeJSON path obj =
       createDirectoryIfMissing True (dropFileName path)
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 04e315a..60b783e 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -22,10 +22,13 @@
 module Resource
   ( ResourceTree(..)
   , buildResourceTree
+  , flattenResourceTree
+  , outputDiff
   ) where
 
 
 import Data.Function ((&))
+import Data.List ((\\))
 import Files
 import Input
 
@@ -34,25 +37,47 @@ import Input
 data ResourceTree =
     ItemResource
       { sidecar :: Sidecar
-      , path :: Path
+      , resPath :: Path
       , itemThumbnailPath :: Path }
   | DirResource
       { items :: [ResourceTree]
-      , path :: Path
+      , resPath :: Path
       , dirThumbnailPath :: Maybe Path }
   deriving Show
 
 
-  -- TODO: actually generate compilation strategies
+-- TODO: actually generate compilation strategies
 buildResourceTree :: InputTree -> ResourceTree
 buildResourceTree = resNode
   where
     resNode (InputFile path sidecar) =
-      ItemResource sidecar (itemsDir /> path) (thumbnailsDir /> path)
+      ItemResource
+        { sidecar = sidecar
+        , resPath = itemsDir /> path
+        , itemThumbnailPath = thumbnailsDir /> path }
 
     resNode (InputDir path thumbnailPath items) =
       map resNode items
-      & \dirItems -> DirResource dirItems (itemsDir /> path) Nothing
+      & \dirItems -> DirResource
+        { items = dirItems
+        , resPath = itemsDir /> path
+        , dirThumbnailPath = fmap ((/>) thumbnailsDir) thumbnailPath }
 
     itemsDir = "items"
     thumbnailsDir = "thumbnails"
+
+
+flattenResourceTree :: ResourceTree -> [ResourceTree]
+flattenResourceTree item@ItemResource{} = [item]
+flattenResourceTree dir@(DirResource items _ _) =
+  dir:(concatMap flattenResourceTree items)
+
+
+outputDiff :: ResourceTree -> FSNode -> [Path]
+outputDiff resources ref = (fsPaths ref) \\ (resPaths resources)
+  where
+    resPaths :: ResourceTree -> [Path]
+    resPaths = map resPath . flattenResourceTree
+
+    fsPaths :: FSNode -> [Path]
+    fsPaths = map nodePath . tail . flattenDir
-- 
cgit v1.2.3


From aead07929e6ed13375b86539b1679a88993c9cf5 Mon Sep 17 00:00:00 2001
From: pacien
Date: Thu, 26 Dec 2019 08:03:31 +0100
Subject: compiler: extract config and remove utils

---
 compiler/src/Config.hs  | 49 +++++++++++++++++++++++++++++++++++++++++++++++++
 compiler/src/Gallery.hs |  6 +++++-
 compiler/src/Input.hs   |  3 +--
 compiler/src/Lib.hs     | 35 +++++++++++------------------------
 compiler/src/Utils.hs   | 49 -------------------------------------------------
 5 files changed, 66 insertions(+), 76 deletions(-)
 create mode 100644 compiler/src/Config.hs
 delete mode 100644 compiler/src/Utils.hs

(limited to 'compiler/src')

diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs
new file mode 100644
index 0000000..6f04818
--- /dev/null
+++ b/compiler/src/Config.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE DuplicateRecordFields, DeriveGeneric, DeriveAnyClass #-}
+
+-- ldgallery - A static generator which turns a collection of tagged
+--             pictures into a searchable web gallery.
+--
+-- Copyright (C) 2019  Pacien TRAN-GIRARD
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU Affero General Public License as
+-- published by the Free Software Foundation, either version 3 of the
+-- License, or (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-- GNU Affero General Public License for more details.
+--
+-- You should have received a copy of the GNU Affero General Public License
+-- along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+
+module Config
+  ( GalleryConfig(..)
+  , CompilerConfig(..)
+  , readConfig
+  ) where
+
+import GHC.Generics (Generic)
+import Data.Aeson (ToJSON, FromJSON)
+import qualified Data.Aeson as JSON
+
+import Files (FileName)
+import Input (decodeYamlFile)
+
+
+data CompilerConfig = CompilerConfig
+  { dummy :: Maybe String -- TODO
+  } deriving (Generic, FromJSON, Show)
+
+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/Gallery.hs b/compiler/src/Gallery.hs
index 3be62ad..ce52523 100644
--- a/compiler/src/Gallery.hs
+++ b/compiler/src/Gallery.hs
@@ -32,7 +32,8 @@ import Data.Maybe (fromMaybe)
 import Data.Aeson (ToJSON, genericToJSON, genericToEncoding)
 import qualified Data.Aeson as JSON
 
-import Utils
+import qualified Data.Set as Set
+
 import Files
 import Input
 import Resource
@@ -121,3 +122,6 @@ buildGalleryTree (DirResource dirItems path@(dirname:_) thumbnailPath) =
   where
     aggregateChildTags :: [GalleryItem] -> [Tag]
     aggregateChildTags = unique . concatMap (\item -> tags (item::GalleryItem))
+
+    unique :: Ord a => [a] -> [a]
+    unique = Set.toList . Set.fromList
diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs
index fa36d59..681f169 100644
--- a/compiler/src/Input.hs
+++ b/compiler/src/Input.hs
@@ -37,7 +37,6 @@ import Data.Aeson (FromJSON)
 import System.FilePath (isExtensionOf, dropExtension)
 
 import Files
-import Utils
 
 
 data LoadException = LoadException String ParseException deriving Show
@@ -70,7 +69,7 @@ data Sidecar = Sidecar
 
 readInputTree :: AnchoredFSNode -> IO InputTree
 readInputTree (AnchoredFSNode anchor root@Dir{}) =
-  filterDir (neg isHidden) root & mkDirNode
+  filterDir (not . isHidden) root & mkDirNode
   where
     mkInputNode :: FSNode -> IO (Maybe InputTree)
     mkInputNode (File path@(filename:pathto)) | ".yaml" `isExtensionOf` filename =
diff --git a/compiler/src/Lib.hs b/compiler/src/Lib.hs
index 643e5f6..b2bbe15 100644
--- a/compiler/src/Lib.hs
+++ b/compiler/src/Lib.hs
@@ -24,47 +24,28 @@ module Lib
   ) where
 
 
-import GHC.Generics (Generic)
 import Data.Function ((&))
 import Data.Ord (comparing)
 import Data.List (sortBy, length)
 import System.Directory (createDirectoryIfMissing, removePathForcibly)
 import System.FilePath (dropFileName, (</>))
 
-import Data.Aeson (ToJSON, FromJSON)
+import Data.Aeson (ToJSON)
 import qualified Data.Aeson as JSON
 
+import Config
 import Files (FileName, readDirectory, localPath, flattenDir, root, (/>))
 import Input (decodeYamlFile, readInputTree)
 import Resource (ResourceTree, buildResourceTree, outputDiff)
 import Gallery (buildGalleryTree)
 
 
-data CompilerConfig = CompilerConfig
-  { dummy :: Maybe String -- TODO
-  } deriving (Generic, FromJSON, Show)
-
-data GalleryConfig = GalleryConfig
-  { compiler :: CompilerConfig
-  , viewer :: JSON.Object
-  } deriving (Generic, FromJSON, Show)
-
-readConfig :: FileName -> IO GalleryConfig
-readConfig = decodeYamlFile
-
-
 process :: FilePath -> FilePath -> IO ()
 process inputDirPath outputDirPath =
   do
     config <- readConfig (inputDirPath </> "gallery.yaml")
-
     inputDir <- readDirectory inputDirPath
-    putStrLn "\nINPUT DIR"
-    putStrLn (show inputDir)
-
     inputTree <- readInputTree inputDir
-    putStrLn "\nINPUT TREE"
-    putStrLn (show inputTree)
 
     let resourceTree = buildResourceTree inputTree
     putStrLn "\nRESOURCE TREE"
@@ -77,11 +58,11 @@