Define shortcut runners the same place as the instances

byg/byg.cabal

@@ -28,6 +28,7 @@ library
         Types.Dependency
         Types
         DependencyGenerator
+        FunctionIO
         Evaluation.Function
         DependencyRunner
         SiteGenerator

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
+instance TokenableTo a (DepGenM (Token a)) where
-  toToken = fmap ListToken . sequence
-
-instance TokenableTo a (DepGenM' 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]
+hasExtension :: (TokenableTo [String] a, TokenableTo FilePath b) => a -> b -> DepGenM (Token Bool)
-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 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)

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

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

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