diff --git a/byg/byg.cabal b/byg/byg.cabal index 0ba7d0c..ca7b8e0 100644 --- a/byg/byg.cabal +++ b/byg/byg.cabal @@ -28,6 +28,7 @@ library Types.Dependency Types DependencyGenerator + FunctionIO Evaluation.Function DependencyRunner SiteGenerator diff --git a/byg/src/DependencyGenerator.hs b/byg/src/DependencyGenerator.hs index f9d37fb..fcf0829 100644 --- a/byg/src/DependencyGenerator.hs +++ b/byg/src/DependencyGenerator.hs @@ -3,11 +3,13 @@ module DependencyGenerator ( DepGenM , DepGenM' - , evalDepGenM , TokenableTo(..) + , toTupleToken + , evalDepGenM , inject , runFunction , runFunctionIO + , runFunctionIO_ , mapDepGenM , mapDepGenM_ , forDepGenM @@ -34,20 +36,9 @@ module DependencyGenerator , applyTemplate , toText , convertImage - - , listDirectory - , isDirectory - , readTextFile - , openImage - , saveImage - , saveTextFile - , copyFile - , copyFile' - , makeDir , runPandoc , hasExtension - , copyTo ) where import Prelude hiding (String, FilePath) @@ -55,8 +46,8 @@ import Prelude hiding (String, FilePath) import Types.Token (Token(..)) import Types.Values import Types.Value (Valuable(..)) +import Types.FunctionIO (IsFunctionIO(..)) import Types.Function (Function(..)) -import Types.FunctionIO import Types.Dependency (Action(..), Dependency, makeDependency, makeUToken) import Control.Monad.State (MonadState, State, runState, put, get) @@ -77,7 +68,7 @@ evalDepGenM = snd . fst . runDepGenM 0 tellDep :: Dependency -> DepGenM () tellDep dep = tell [dep] -newToken :: DepGenM' a +newToken :: DepGenM (Token a) newToken = do top <- get let top' = top + 1 @@ -85,30 +76,30 @@ newToken = do put top' pure target -genDependencyM :: (Token a -> DepGenM Dependency) -> DepGenM' a +genDependencyM :: (Token a -> DepGenM Dependency) -> DepGenM (Token a) genDependencyM f = do target <- newToken result <- f target tellDep result pure target -genDependency :: (Token a -> Dependency) -> DepGenM' a +genDependency :: (Token a -> Dependency) -> DepGenM (Token a) genDependency f = genDependencyM (pure . f) -inject :: Valuable a => a -> DepGenM' a +inject :: Valuable a => a -> DepGenM (Token a) inject x = genDependency (makeDependency NoToken (Inject (toValue x))) -runFunction :: Function -> Token a -> DepGenM' b +runFunction :: Function -> Token a -> DepGenM (Token b) runFunction f input = genDependency (makeDependency input (Function f)) -runFunctionIO :: IsFunctionIO f a b => f -> Token a -> DepGenM' b +runFunctionIO :: IsFunctionIO f a b => f -> Token a -> DepGenM (Token b) runFunctionIO f input = genDependency (makeDependency input (FunctionIO f)) runFunctionIO_ :: IsFunctionIO f a () => f -> Token a -> DepGenM () runFunctionIO_ f input = tellDep $ makeDependency input (FunctionIO f) NoToken class TokenableTo t s | s -> t where - toToken :: s -> DepGenM' t + toToken :: s -> DepGenM (Token t) instance TokenableTo a (Token a) where toToken = pure @@ -116,16 +107,16 @@ instance TokenableTo a (Token a) where instance TokenableTo [a] [Token a] where toToken = pure . ListToken -instance TokenableTo [a] [DepGenM' a] where - toToken = fmap ListToken . sequence - -instance TokenableTo a (DepGenM' a) where +instance TokenableTo a (DepGenM (Token a)) where toToken = id -toTupleToken :: (TokenableTo ta a, TokenableTo tb b) => a -> b -> DepGenM' (ta, tb) +instance TokenableTo [a] [DepGenM (Token a)] where + toToken = fmap ListToken . sequence + +toTupleToken :: (TokenableTo ta a, TokenableTo tb b) => a -> b -> DepGenM (Token (ta, tb)) toTupleToken a b = TupleToken <$> toToken a <*> toToken b -mapDepGenM :: TokenableTo [a] v => (Token a -> DepGenM' b) -> v -> DepGenM' [b] +mapDepGenM :: TokenableTo [a] v => (Token a -> DepGenM (Token b)) -> v -> DepGenM (Token [b]) mapDepGenM f input = do input' <- toToken input genDependencyM $ \target -> do @@ -142,23 +133,23 @@ mapDepGenM_ f input = do _ <- mapDepGenM (\x -> f x >> pure NoToken) input pure () -forDepGenM :: TokenableTo [a] v => v -> (Token a -> DepGenM' b) -> DepGenM' [b] +forDepGenM :: TokenableTo [a] v => v -> (Token a -> DepGenM (Token b)) -> DepGenM (Token [b]) forDepGenM = flip mapDepGenM forDepGenM_ :: TokenableTo [a] v => v -> (Token a -> DepGenM ()) -> DepGenM () forDepGenM_ = flip mapDepGenM_ -filterDepGenM' :: (TokenableTo [Bool] v, TokenableTo [a] u) => v -> u -> DepGenM' [a] +filterDepGenM' :: (TokenableTo [Bool] v, TokenableTo [a] u) => v -> u -> DepGenM (Token [a]) filterDepGenM' mask input = do tup <- toTupleToken input mask genDependency (makeDependency tup FilterComp) -filterDepGenM :: TokenableTo [a] v => (Token a -> DepGenM' Bool) -> v -> DepGenM' [a] +filterDepGenM :: TokenableTo [a] v => (Token a -> DepGenM (Token Bool)) -> v -> DepGenM (Token [a]) filterDepGenM f input = do mask <- mapDepGenM f input filterDepGenM' mask input -zipDepGenM :: (TokenableTo [a] v, TokenableTo [b] u) => v -> u -> DepGenM' [(a, b)] +zipDepGenM :: (TokenableTo [a] v, TokenableTo [b] u) => v -> u -> DepGenM (Token [(a, b)]) zipDepGenM a b = do a' <- toToken a b' <- toToken b @@ -206,79 +197,46 @@ unzipDepGenM t = do b <- unzipSndDepGenM t' pure (a, b) -appendStrings :: (TokenableTo String a, TokenableTo String b) => a -> b -> DepGenM' String +appendStrings :: (TokenableTo String a, TokenableTo String b) => a -> b -> DepGenM (Token String) appendStrings a b = runFunction AppendStrings =<< TupleToken <$> toToken a <*> toToken b -concatStrings :: TokenableTo [String] a => a -> DepGenM' String +concatStrings :: TokenableTo [String] a => a -> DepGenM (Token String) concatStrings a = runFunction ConcatStrings =<< toToken a -appendTexts :: (TokenableTo Text a, TokenableTo Text b) => a -> b -> DepGenM' Text +appendTexts :: (TokenableTo Text a, TokenableTo Text b) => a -> b -> DepGenM (Token Text) appendTexts a b = runFunction AppendTexts =<< toTupleToken a b -concatTexts :: TokenableTo [Text] a => a -> DepGenM' Text +concatTexts :: TokenableTo [Text] a => a -> DepGenM (Token Text) concatTexts a = runFunction ConcatTexts =<< toToken a -joinPaths :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM' FilePath +joinPaths :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM (Token FilePath) joinPaths a b = runFunction JoinPaths =<< TupleToken <$> toToken a <*> toToken b -fileComponents :: TokenableTo FilePath a => a -> DepGenM' (String, String) +fileComponents :: TokenableTo FilePath a => a -> DepGenM (Token (String, String)) fileComponents a = runFunction FileComponents =<< toToken a -lowerString :: TokenableTo String a => a -> DepGenM' String +lowerString :: TokenableTo String a => a -> DepGenM (Token String) lowerString a = runFunction LowerString =<< toToken a -elemOf :: (TokenableTo String a, TokenableTo [String] b) => a -> b -> DepGenM' Bool +elemOf :: (TokenableTo String a, TokenableTo [String] b) => a -> b -> DepGenM (Token Bool) elemOf a b = runFunction ElemOf =<< toTupleToken a b -makeTemplate :: (TokenableTo Text a, TokenableTo Text b) => a -> b -> DepGenM' Template +makeTemplate :: (TokenableTo Text a, TokenableTo Text b) => a -> b -> DepGenM (Token Template) makeTemplate a b = runFunction MakeTemplate =<< toTupleToken a b -applyTemplate :: (TokenableTo Template a, TokenableTo Text b) => a -> b -> DepGenM' Text +applyTemplate :: (TokenableTo Template a, TokenableTo Text b) => a -> b -> DepGenM (Token Text) applyTemplate a b = runFunction ApplyTemplate =<< toTupleToken a b -toText :: TokenableTo String a => a -> DepGenM' Text +toText :: TokenableTo String a => a -> DepGenM (Token Text) toText a = runFunction ToText =<< toToken a -convertImage :: (TokenableTo Image a, TokenableTo ImageConversionSettings b) => a -> b -> DepGenM' Image +convertImage :: (TokenableTo Image a, TokenableTo ImageConversionSettings b) => a -> b -> DepGenM (Token Image) convertImage a b = runFunction ConvertImage =<< toTupleToken a b -runPandoc :: TokenableTo Text a => a -> DepGenM' Text +runPandoc :: TokenableTo Text a => a -> DepGenM (Token Text) runPandoc a = runFunction RunPandoc =<< toToken a -listDirectory :: TokenableTo FilePath a => a -> DepGenM' [FilePath] -listDirectory a = runFunctionIO ListDirectory =<< toToken a - -isDirectory :: TokenableTo FilePath a => a -> DepGenM' Bool -isDirectory a = runFunctionIO IsDirectory =<< toToken a - -readTextFile :: TokenableTo FilePath a => a -> DepGenM' Text -readTextFile a = runFunctionIO ReadTextFile =<< toToken a - -openImage :: TokenableTo FilePath a => a -> DepGenM' Image -openImage a = runFunctionIO OpenImage =<< toToken a - -saveImage :: (TokenableTo Image a, TokenableTo FilePath b) => a -> b -> DepGenM () -saveImage a b = runFunctionIO_ SaveImage =<< toTupleToken a b - -saveTextFile :: (TokenableTo Text a, TokenableTo FilePath b) => a -> b -> DepGenM () -saveTextFile a b = runFunctionIO_ SaveTextFile =<< toTupleToken a b - -copyFile :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM () -copyFile a b = runFunctionIO_ CopyFile =<< toTupleToken a b - -copyFile' :: Token (FilePath, FilePath) -> DepGenM () -copyFile' = runFunctionIO_ CopyFile - -makeDir :: TokenableTo FilePath a => a -> DepGenM () -makeDir a = runFunctionIO_ MakeDir =<< toToken a - - -hasExtension :: (TokenableTo [String] a, TokenableTo FilePath b) => a -> b -> DepGenM' Bool +hasExtension :: (TokenableTo [String] a, TokenableTo FilePath b) => a -> b -> DepGenM (Token Bool) hasExtension exts filename = do - ext <- lowerString $ untupleSndDepGenM $ fileComponents filename + ext <- lowerString =<< untupleSndDepGenM =<< fileComponents filename ext `elemOf` exts - -copyTo :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM () -copyTo path targetDir = do - pathToken <- toToken path - copyFile pathToken (joinPaths targetDir pathToken) diff --git a/byg/src/FunctionIO.hs b/byg/src/FunctionIO.hs new file mode 100644 index 0000000..cca4300 --- /dev/null +++ b/byg/src/FunctionIO.hs @@ -0,0 +1,106 @@ +module FunctionIO + ( listDirectory + , isDirectory + , readTextFile + , openImage + , saveImage + , saveTextFile + , copyFile + , makeDir + ) where + +import Prelude hiding (String, FilePath) + +import Types.FunctionIO +import Types.Values +import Types.Token (Token(..)) +import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken, runFunctionIO, runFunctionIO_) + +import Data.Text (Text) +import qualified Data.Text.IO as T +import qualified Codec.Picture as CP +import qualified System.Directory as SD +import Language.Haskell.TH.Syntax (Lift) + + +data ListDirectory = ListDirectory deriving (Show, Lift) +instance IsFunctionIO ListDirectory FilePath [FilePath] where + evalFunctionIO ListDirectory (StringWrapper s) = + map StringWrapper <$> SD.listDirectory s + functionIOTouchesFilesystem ListDirectory = False + +listDirectory :: TokenableTo FilePath a => a -> DepGenM (Token [FilePath]) +listDirectory a = runFunctionIO ListDirectory =<< toToken a + + +data IsDirectory = IsDirectory deriving (Show, Lift) +instance IsFunctionIO IsDirectory FilePath Bool where + evalFunctionIO IsDirectory (StringWrapper s) = + SD.doesDirectoryExist s + functionIOTouchesFilesystem IsDirectory = False + +isDirectory :: TokenableTo FilePath a => a -> DepGenM (Token Bool) +isDirectory a = runFunctionIO IsDirectory =<< toToken a + + +data ReadTextFile = ReadTextFile deriving (Show, Lift) +instance IsFunctionIO ReadTextFile FilePath Text where + evalFunctionIO ReadTextFile (StringWrapper s) = + T.readFile s + functionIOTouchesFilesystem ReadTextFile = False + +readTextFile :: TokenableTo FilePath a => a -> DepGenM (Token Text) +readTextFile a = runFunctionIO ReadTextFile =<< toToken a + + +data OpenImage = OpenImage deriving (Show, Lift) +instance IsFunctionIO OpenImage FilePath Image where + evalFunctionIO OpenImage (StringWrapper s) = do + imageOrig <- CP.readImage s + case imageOrig of + Left e -> error ("unexpected error: " ++ e) + Right image -> pure $ ImageWrapper $ CP.convertRGB8 image + functionIOTouchesFilesystem OpenImage = False + +openImage :: TokenableTo FilePath a => a -> DepGenM (Token Image) +openImage a = runFunctionIO OpenImage =<< toToken a + + +data SaveImage = SaveImage deriving (Show, Lift) +instance IsFunctionIO SaveImage (Image, FilePath) () where + evalFunctionIO SaveImage (ImageWrapper image, StringWrapper s) = + CP.saveJpgImage 90 s $ CP.ImageRGB8 image + functionIOTouchesFilesystem SaveImage = True + +saveImage :: (TokenableTo Image a, TokenableTo FilePath b) => a -> b -> DepGenM () +saveImage a b = runFunctionIO_ SaveImage =<< toTupleToken a b + + +data SaveTextFile = SaveTextFile deriving (Show, Lift) +instance IsFunctionIO SaveTextFile (Text, FilePath) () where + evalFunctionIO SaveTextFile (t, StringWrapper s) = + T.writeFile s t + functionIOTouchesFilesystem SaveTextFile = True + +saveTextFile :: (TokenableTo Text a, TokenableTo FilePath b) => a -> b -> DepGenM () +saveTextFile a b = runFunctionIO_ SaveTextFile =<< toTupleToken a b + + +data CopyFile = CopyFile deriving (Show, Lift) +instance IsFunctionIO CopyFile (FilePath, FilePath) () where + evalFunctionIO CopyFile (StringWrapper source, StringWrapper target) = + SD.copyFile source target + functionIOTouchesFilesystem CopyFile = True + +copyFile :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM () +copyFile a b = runFunctionIO_ CopyFile =<< toTupleToken a b + + +data MakeDir = MakeDir deriving (Show, Lift) +instance IsFunctionIO MakeDir FilePath () where + evalFunctionIO MakeDir (StringWrapper s) = + SD.createDirectory s + functionIOTouchesFilesystem MakeDir = True + +makeDir :: TokenableTo FilePath a => a -> DepGenM () +makeDir a = runFunctionIO_ MakeDir =<< toToken a diff --git a/byg/src/SiteGenerator.hs b/byg/src/SiteGenerator.hs index e780a33..837b3b1 100644 --- a/byg/src/SiteGenerator.hs +++ b/byg/src/SiteGenerator.hs @@ -4,9 +4,15 @@ import Prelude hiding (String, FilePath) import Types import DependencyGenerator +import FunctionIO import Control.Monad (forM_) +copyTo :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM () +copyTo path targetDir = do + pathToken <- toToken path + copyFile pathToken =<< joinPaths targetDir pathToken + handleRecipeDir :: Token FilePath -> Token Template -> Token FilePath -> Token FilePath -> DepGenM () handleRecipeDir outputDir htmlTemplate indexName dir = do recipeDirOut <- joinPaths outputDir dir diff --git a/byg/src/Types/FunctionIO.hs b/byg/src/Types/FunctionIO.hs index 3e4284d..13c6947 100644 --- a/byg/src/Types/FunctionIO.hs +++ b/byg/src/Types/FunctionIO.hs @@ -1,78 +1,13 @@ {-# LANGUAGE FunctionalDependencies #-} module Types.FunctionIO ( IsFunctionIO(..) - , ListDirectory(..) - , IsDirectory(..) - , ReadTextFile(..) - , OpenImage(..) - , SaveImage(..) - , SaveTextFile(..) - , CopyFile(..) - , MakeDir(..) ) where -import Prelude hiding (String, FilePath) - -import Types.Values import Types.Value (Valuable) -import Data.Text (Text) -import qualified Data.Text.IO as T -import qualified Codec.Picture as CP -import System.Directory (listDirectory, doesDirectoryExist, createDirectory, copyFile) import Language.Haskell.TH.Syntax (Lift) + class (Show f, Lift f, Valuable a, Valuable b) => IsFunctionIO f a b | f -> a b where evalFunctionIO :: f -> a -> IO b functionIOTouchesFilesystem :: f -> Bool - -data ListDirectory = ListDirectory deriving (Show, Lift) -instance IsFunctionIO ListDirectory FilePath [FilePath] where - evalFunctionIO ListDirectory (StringWrapper s) = - map StringWrapper <$> listDirectory s - functionIOTouchesFilesystem ListDirectory = False - -data IsDirectory = IsDirectory deriving (Show, Lift) -instance IsFunctionIO IsDirectory FilePath Bool where - evalFunctionIO IsDirectory (StringWrapper s) = - doesDirectoryExist s - functionIOTouchesFilesystem IsDirectory = False - -data ReadTextFile = ReadTextFile deriving (Show, Lift) -instance IsFunctionIO ReadTextFile FilePath Text where - evalFunctionIO ReadTextFile (StringWrapper s) = - T.readFile s - functionIOTouchesFilesystem ReadTextFile = False - -data OpenImage = OpenImage deriving (Show, Lift) -instance IsFunctionIO OpenImage FilePath Image where - evalFunctionIO OpenImage (StringWrapper s) = do - imageOrig <- CP.readImage s - case imageOrig of - Left e -> error ("unexpected error: " ++ e) - Right image -> pure $ ImageWrapper $ CP.convertRGB8 image - functionIOTouchesFilesystem OpenImage = False - -data SaveImage = SaveImage deriving (Show, Lift) -instance IsFunctionIO SaveImage (Image, FilePath) () where - evalFunctionIO SaveImage (ImageWrapper image, StringWrapper s) = - CP.saveJpgImage 90 s $ CP.ImageRGB8 image - functionIOTouchesFilesystem SaveImage = True - -data SaveTextFile = SaveTextFile deriving (Show, Lift) -instance IsFunctionIO SaveTextFile (Text, FilePath) () where - evalFunctionIO SaveTextFile (t, StringWrapper s) = - T.writeFile s t - functionIOTouchesFilesystem SaveTextFile = True - -data CopyFile = CopyFile deriving (Show, Lift) -instance IsFunctionIO CopyFile (FilePath, FilePath) () where - evalFunctionIO CopyFile (StringWrapper source, StringWrapper target) = - copyFile source target - functionIOTouchesFilesystem CopyFile = True - -data MakeDir = MakeDir deriving (Show, Lift) -instance IsFunctionIO MakeDir FilePath () where - evalFunctionIO MakeDir (StringWrapper s) = - createDirectory s - functionIOTouchesFilesystem MakeDir = True