Also make Function plug and play

byg/byg.cabal

@@ -28,8 +28,8 @@ library
         Types.Dependency
         Types
         DependencyGenerator
+        Function
         FunctionIO
-        Evaluation.Function
         DependencyRunner
         SiteGenerator
         Precomputer

byg/src/DependencyGenerator.hs

@@ -23,34 +23,18 @@ module DependencyGenerator
   , unzipFstDepGenM
   , unzipSndDepGenM
   , unzipDepGenM
-
-  , concatStrings
-  , concatTexts
-  , joinPaths
-  , fileComponents
-  , lowerString
-  , elemOf
-  , makeTemplate
-  , applyTemplate
-  , toText
-  , convertImage
-  , runPandoc
-
-  , hasExtension
   ) where
 
 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.Function (IsFunction(..))
 import Types.Dependency (Action(..), Dependency, makeDependency, makeUToken)
 
 import Control.Monad.State (MonadState, State, runState, put, get)
 import Control.Monad.Writer (MonadWriter, WriterT, runWriterT, tell)
-import Data.Text (Text)
 
 newtype DepGenM a = DepGenM { unDepGenM :: WriterT [Dependency] (State Int) a }
   deriving (Functor, Applicative, Monad, MonadState Int, MonadWriter [Dependency])
@@ -87,7 +71,7 @@ genDependency f = genDependencyM (pure . f)
 inject :: Valuable a => a -> DepGenM (Token a)
 inject x = genDependency (makeDependency NoToken (Inject (toValue x)))
 
-runFunction :: Function -> Token a -> DepGenM (Token b)
+runFunction :: IsFunction f a b => f -> Token a -> DepGenM (Token b)
 runFunction f input = genDependency (makeDependency input (Function f))
 
 runFunctionIO :: IsFunctionIO f a b => f -> Token a -> DepGenM (Token b)
@@ -194,41 +178,3 @@ unzipDepGenM t = do
   a <- unzipFstDepGenM t'
   b <- unzipSndDepGenM t'
   pure (a, b)
-
-concatStrings :: TokenableTo [String] a => a -> DepGenM (Token String)
-concatStrings a = runFunction ConcatStrings =<< toToken a
-
-concatTexts :: TokenableTo [Text] a => a -> DepGenM (Token Text)
-concatTexts a = runFunction ConcatTexts =<< toToken a
-
-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 (Token (String, String))
-fileComponents a = runFunction FileComponents =<< toToken a
-
-lowerString :: TokenableTo String a => a -> DepGenM (Token String)
-lowerString a = runFunction LowerString =<< toToken a
-
-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 (Token Template)
-makeTemplate a b = runFunction MakeTemplate =<< toTupleToken a b
-
-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 (Token Text)
-toText a = runFunction ToText =<< toToken a
-
-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 (Token Text)
-runPandoc a = runFunction RunPandoc =<< toToken a
-
-hasExtension :: (TokenableTo [String] a, TokenableTo FilePath b) => a -> b -> DepGenM (Token Bool)
-hasExtension exts filename = do
-  ext <- lowerString =<< untupleSndDepGenM =<< fileComponents filename
-  ext `elemOf` exts

byg/src/DependencyRunner.hs

@@ -4,9 +4,8 @@ module DependencyRunner
   , runDepRunMIO
   ) where
 
-import Types (Value(..), Valuable(..), evalFunctionIO)
+import Types (Value(..), Valuable(..), evalFunction, evalFunctionIO)
 import Types.Dependency
-import Evaluation.Function
 
 import Data.Map (Map)
 import qualified Data.Map as M
@@ -82,7 +81,7 @@ putTokenValue t e = case t of
 runAction :: Action -> Value -> DepRunM Value
 runAction action input = case action of
   Function f ->
-    pure $ evalFunction f input
+    pure $ toValue $ evalFunction f $ fromValue input
   FunctionIO f ->
     liftIO (toValue <$> evalFunctionIO f (fromValue input))
   Inject v ->

byg/src/Evaluation/Function.hs

@@ -1,78 +0,0 @@
-module Evaluation.Function
-  ( evalFunction
-  ) where
-
-import Prelude hiding (String, FilePath)
-import qualified Prelude
-
-import Types.Values
-import Types (Function(..), Value(..), fromValue, makeString, makeImage)
-
-import qualified Codec.Picture as CP
-import qualified Codec.Picture.STBIR as CPS
-import Data.Char (toLower)
-import qualified Data.Text as T
-import qualified Data.Text.Lazy as TL
-import qualified Text.Pandoc as P
-import qualified Text.Blaze.Html.Renderer.Text as B
-
-fileComponents :: Prelude.String -> (Prelude.String, Prelude.String)
-fileComponents s =
-  let (lastRev, firstRev) = span (/= '.') $ reverse s
-  in case firstRev of
-       _ : firstRev' -> (reverse firstRev', reverse lastRev)
-       [] -> (reverse lastRev, "")
-
-unStringWrapper :: Value -> Prelude.String
-unStringWrapper = \case
-  String (StringWrapper s) -> s
-  _ -> error "unexpected"
-
-evalFunction :: Function -> Value -> Value
-evalFunction f x = case (f, x) of
-  (ConcatStrings, List vs) ->
-    makeString $ concatMap unStringWrapper vs
-
-  (ConcatTexts, List vs) ->
-    Text $ T.concat $ map fromValue vs
-
-  (JoinPaths, Tuple (String (StringWrapper s0), String (StringWrapper s1))) ->
-    makeString (s0 ++ "/" ++ s1)
-
-  (FileComponents, String (StringWrapper s)) ->
-    let (base, ext) = fileComponents s
-    in Tuple (makeString base, makeString ext)
-
-  (LowerString, String (StringWrapper s)) ->
-    makeString $ map toLower s
-
-  (ElemOf, Tuple (y, List ys)) ->
-    Bool (y `elem` ys)
-
-  (MakeTemplate, Tuple (Text t, Text c)) ->
-    let (beforeContent, after) = T.breakOn c t
-        afterContent = T.drop (T.length c) after
-    in Template $ TemplateParts beforeContent afterContent
-
-  (ApplyTemplate, Tuple (Template (TemplateParts beforeContent afterContent), Text t)) ->
-    Text $ T.concat [beforeContent, t, afterContent]
-
-  (ToText, String (StringWrapper s)) ->
-    Text $ T.pack s
-
-  (ConvertImage, Tuple (Image (ImageWrapper image),
-                        ImageConversionSettings (ResizeToWidth widthResized))) ->
-    let sizeFactor :: Double
-        sizeFactor = fromIntegral (CP.imageWidth image) / fromIntegral widthResized
-        heightResized = round (fromIntegral (CP.imageHeight image) / sizeFactor)
-    in makeImage $ CPS.resize CPS.defaultOptions widthResized heightResized image
-
-  (RunPandoc, Text contents) ->
-    let settings = P.def { P.readerExtensions = P.extensionsFromList [ P.Ext_raw_html ] }
-        m = P.writeHtml5 P.def =<< P.readMarkdown settings contents
-    in case P.runPure m of
-         Left e -> error ("unexpected pandoc error: " ++ show e)
-         Right html -> Text $ TL.toStrict $ B.renderHtml html
-
-  _ ->
-    error "unexpected combination of function and argument type"

byg/src/Function.hs

@@ -0,0 +1,136 @@
+module Function
+  ( concatStrings
+  , concatTexts
+  , joinPaths
+  , fileComponents
+  , lowerString
+  , elemOf
+  , makeTemplate
+  , applyTemplate
+  , toText
+  , convertImage
+  , runPandoc
+  ) where
+
+import Prelude hiding (String, FilePath)
+
+import Types.Values
+import Types.Function
+import Types.Token (Token(..))
+import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken, runFunction)
+
+import qualified Codec.Picture as CP
+import qualified Codec.Picture.STBIR as CPS
+import Data.Char (toLower)
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
+import qualified Text.Pandoc as P
+import qualified Text.Blaze.Html.Renderer.Text as B
+import Language.Haskell.TH.Syntax (Lift)
+
+
+data ConcatStrings = ConcatStrings deriving (Show, Lift)
+instance IsFunction ConcatStrings [String] String where
+  evalFunction ConcatStrings = StringWrapper . concatMap unStringWrapper
+
+concatStrings :: TokenableTo [String] a => a -> DepGenM (Token String)
+concatStrings a = runFunction ConcatStrings =<< toToken a
+
+
+data ConcatTexts = ConcatTexts deriving (Show, Lift)
+instance IsFunction ConcatTexts [Text] Text where
+  evalFunction ConcatTexts = T.concat
+
+concatTexts :: TokenableTo [Text] a => a -> DepGenM (Token Text)
+concatTexts a = runFunction ConcatTexts =<< toToken a
+
+
+data JoinPaths = JoinPaths deriving (Show, Lift)
+instance IsFunction JoinPaths (FilePath, FilePath) FilePath where
+  evalFunction JoinPaths (StringWrapper s0, StringWrapper s1) = StringWrapper (s0 ++ "/" ++ s1)
+
+joinPaths :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM (Token FilePath)
+joinPaths a b = runFunction JoinPaths =<< TupleToken <$> toToken a <*> toToken b
+
+
+data FileComponents = FileComponents deriving (Show, Lift)
+instance IsFunction FileComponents FilePath (String, String) where
+  evalFunction FileComponents (StringWrapper s) =
+    let (lastRev, firstRev) = span (/= '.') $ reverse s
+        (base, ext) = case firstRev of
+          _ : firstRev' -> (reverse firstRev', reverse lastRev)
+          [] -> (reverse lastRev, "")
+    in (StringWrapper base, StringWrapper ext)
+
+fileComponents :: TokenableTo FilePath a => a -> DepGenM (Token (String, String))
+fileComponents a = runFunction FileComponents =<< toToken a
+
+
+data LowerString = LowerString deriving (Show, Lift)
+instance IsFunction LowerString String String where
+  evalFunction LowerString (StringWrapper s) = StringWrapper (map toLower s)
+
+lowerString :: TokenableTo String a => a -> DepGenM (Token String)
+lowerString a = runFunction LowerString =<< toToken a
+
+
+data ElemOf = ElemOf deriving (Show, Lift)
+instance IsFunction ElemOf (String, [String]) Bool where
+  evalFunction ElemOf (y, ys) = y `elem` ys
+
+elemOf :: (TokenableTo String a, TokenableTo [String] b) => a -> b -> DepGenM (Token Bool)
+elemOf a b = runFunction ElemOf =<< toTupleToken a b
+
+
+data MakeTemplate = MakeTemplate deriving (Show, Lift)
+instance IsFunction MakeTemplate (Text, Text) Template where
+  evalFunction MakeTemplate (t, c) =
+    let (beforeContent, after) = T.breakOn c t
+        afterContent = T.drop (T.length c) after
+    in TemplateParts beforeContent afterContent
+
+makeTemplate :: (TokenableTo Text a, TokenableTo Text b) => a -> b -> DepGenM (Token Template)
+makeTemplate a b = runFunction MakeTemplate =<< toTupleToken a b
+
+
+data ApplyTemplate = ApplyTemplate deriving (Show, Lift)
+instance IsFunction ApplyTemplate (Template, Text) Text where
+  evalFunction ApplyTemplate (TemplateParts beforeContent afterContent, t) =
+    T.concat [beforeContent, t, afterContent]
+
+applyTemplate :: (TokenableTo Template a, TokenableTo Text b) => a -> b -> DepGenM (Token Text)
+applyTemplate a b = runFunction ApplyTemplate =<< toTupleToken a b
+
+
+data ToText = ToText deriving (Show, Lift)
+instance IsFunction ToText String Text where
+  evalFunction ToText (StringWrapper s) = T.pack s
+
+toText :: TokenableTo String a => a -> DepGenM (Token Text)
+toText a = runFunction ToText =<< toToken a
+
+
+data ConvertImage = ConvertImage deriving (Show, Lift)
+instance IsFunction ConvertImage (Image, ImageConversionSettings) Image where
+  evalFunction ConvertImage (ImageWrapper image, ResizeToWidth widthResized) =
+    let sizeFactor :: Double
+        sizeFactor = fromIntegral (CP.imageWidth image) / fromIntegral widthResized
+        heightResized = round (fromIntegral (CP.imageHeight image) / sizeFactor)
+    in ImageWrapper $ CPS.resize CPS.defaultOptions widthResized heightResized image
+
+convertImage :: (TokenableTo Image a, TokenableTo ImageConversionSettings b) => a -> b -> DepGenM (Token Image)
+convertImage a b = runFunction ConvertImage =<< toTupleToken a b
+
+
+data RunPandoc = RunPandoc deriving (Show, Lift)
+instance IsFunction RunPandoc Text Text where
+  evalFunction RunPandoc contents =
+    let settings = P.def { P.readerExtensions = P.extensionsFromList [ P.Ext_raw_html ] }
+        m = P.writeHtml5 P.def =<< P.readMarkdown settings contents
+    in case P.runPure m of
+         Left e -> error ("unexpected pandoc error: " ++ show e)
+         Right html -> TL.toStrict $ B.renderHtml html
+
+runPandoc :: TokenableTo Text a => a -> DepGenM (Token Text)
+runPandoc a = runFunction RunPandoc =<< toToken a

byg/src/FunctionIO.hs

@@ -11,8 +11,8 @@ module FunctionIO
 
 import Prelude hiding (String, FilePath)
 
-import Types.FunctionIO
 import Types.Values
+import Types.FunctionIO
 import Types.Token (Token(..))
 import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken, runFunctionIO, runFunctionIO_)
 

byg/src/SiteGenerator.hs

@@ -4,6 +4,7 @@ import Prelude hiding (String, FilePath)
 
 import Types
 import DependencyGenerator
+import Function
 import FunctionIO
 
 import Control.Monad (forM_)
@@ -13,6 +14,11 @@ copyTo path targetDir = do
   pathToken <- toToken path
   copyFile pathToken =<< joinPaths targetDir pathToken
 
+hasExtension :: (TokenableTo [String] a, TokenableTo FilePath b) => a -> b -> DepGenM (Token Bool)
+hasExtension exts filename = do
+  ext <- lowerString =<< untupleSndDepGenM =<< fileComponents filename
+  ext `elemOf` exts
+
 handleRecipeDir :: Token FilePath -> Token Template -> Token FilePath -> Token FilePath -> DepGenM ()
 handleRecipeDir outputDir htmlTemplate indexName dir = do
   recipeDirOut <- joinPaths outputDir dir

byg/src/Types/Dependency.hs

@@ -11,7 +11,7 @@ module Types.Dependency
 
 import Types.Token (Token(..))
 import Types.Value (Value)
-import Types.Function (Function)
+import Types.Function (IsFunction())
 import Types.FunctionIO (IsFunctionIO(..))
 
 import Text.Printf (printf)
@@ -20,7 +20,7 @@ import qualified Data.Text as T
 import Language.Haskell.TH.Syntax (Lift)
 
 data Action where
-  Function :: Function -> Action
+  Function :: IsFunction f a b => f -> Action
   FunctionIO :: IsFunctionIO f a b => f -> Action
   Inject :: Value -> Action
   FilterComp :: Action

byg/src/Types/Function.hs

@@ -1,19 +1,11 @@
+{-# LANGUAGE FunctionalDependencies #-}
 module Types.Function
-  ( Function(..)
+  ( IsFunction(..)
   ) where
 
+import Types.Value (Valuable)
+
 import Language.Haskell.TH.Syntax (Lift)
 
-data Function = ConcatStrings
+class (Show f, Lift f, Valuable a, Valuable b) => IsFunction f a b | f -> a b where
-              | ConcatTexts
+  evalFunction :: f -> a -> b
-              | JoinPaths
-              | FileComponents
-              | LowerString
-              | ElemOf
-              | MakeTemplate
-              | ApplyTemplate
-              | ToText
-              | ConvertImage
-              | RunPandoc
-  deriving (Show, Lift)
-

byg/src/Types/Value.hs

@@ -1,17 +1,13 @@
 module Types.Value
   ( Value(..)
   , Valuable(..)
-  , makeString
-  , makeImage
   ) where
 
 import Prelude hiding (String)
-import qualified Prelude
 
 import Types.Values
 
 import Data.Text (Text)
-import qualified Codec.Picture as CP
 import Language.Haskell.TH.Syntax (Lift)
 
 -- Note: We use a wrapper for the String type in order to be able to define the
@@ -33,12 +29,6 @@ data Value = String String
            | List [Value]
   deriving (Eq, Show, Lift)
 
-makeString :: Prelude.String -> Value
-makeString = String . StringWrapper
-
-makeImage :: CP.Image CP.PixelRGB8 -> Value
-makeImage = Image . ImageWrapper
-
 class Valuable a where
   toValue :: a -> Value
   fromValue :: Value -> a

byg/src/Types/Values.hs

@@ -14,7 +14,7 @@ import Data.Text (Text)
 import qualified Codec.Picture as CP
 import Language.Haskell.TH.Syntax (Lift(..))
 
-newtype String = StringWrapper Prelude.String
+newtype String = StringWrapper { unStringWrapper :: Prelude.String }
   deriving (Eq, Lift)
 
 instance Show String where