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 .
+
+
+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
+
+( FileName -> Path
+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 . ((>= 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 .
+
+
+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 .
+
+
+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 .
+
+
+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 .
+
+
+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