Change Value type to just be Dynamic

Restructure into more modules.

byg/byg.cabal

@@ -21,15 +21,18 @@ library
     hs-source-dirs: src
     exposed-modules:
         Types.Token
-        Types.Values
         Types.Value
-        Types.Function
+        Types.Functions
-        Types.FunctionIO
         Types.Dependency
         Types
         DependencyGenerator
-        Function
+        Functions.General
-        FunctionIO
+        Functions.Image
+        Functions.Pandoc
+        Functions.Paths
+        Functions.Template
+        Functions.Text
+        Functions
         DependencyRunner
         SiteGenerator
         Precomputer
@@ -50,5 +53,4 @@ executable byg
     main-is: src/Main.hs
     build-depends:
         base >=4.14 && <4.20
-      , text
       , byg

byg/src/DependencyGenerator.hs

@@ -25,12 +25,9 @@ module DependencyGenerator
   , unzipDepGenM
   ) where
 
-import Prelude hiding (String, FilePath)
-
 import Types.Token (Token(..))
 import Types.Value (Valuable(..))
-import Types.FunctionIO (IsFunctionIO(..))
+import Types.Functions (IsFunction(), IsFunctionIO(..))
-import Types.Function (IsFunction(..))
 import Types.Dependency (Action(..), Dependency, makeDependency, makeUToken)
 
 import Control.Monad.State (MonadState, State, runState, put, get)

byg/src/DependencyRunner.hs

@@ -4,12 +4,12 @@ module DependencyRunner
   , runDepRunMIO
   ) where
 
-import Types (Value(..), Valuable(..), evalFunction, evalFunctionIO)
+import Types (Value(..), fromValue, toValue, evalFunction, evalFunctionIO)
 import Types.Dependency
 
 import Data.Map (Map)
 import qualified Data.Map as M
-import Control.Monad (void)
+import Control.Monad (void, forM)
 import Control.Monad.State (MonadState, MonadIO, StateT, evalStateT, get, modify, liftIO)
 
 data ValueExistence = Evaluated Value
@@ -46,6 +46,12 @@ runDep (Dependency a action b) =
             putStrLn "----------"
           pure result
 
+foo' :: [Value] -> [Value] -> [(Value, Value)]
+foo' = zip
+
+foo :: Value -> Value -> Value
+foo va vb = toValue $ foo' (fromValue va) (fromValue vb)
+
 getTokenValue :: UToken -> DepRunM Value
 getTokenValue = \case
   UToken i -> do
@@ -54,20 +60,16 @@ getTokenValue = \case
   UTupleToken a b -> do
     va <- getTokenValue a
     vb <- getTokenValue b
-    pure $ Tuple (va, vb)
+    pure $ toValue (va, vb)
   UZipToken a b -> do
     va <- getTokenValue a
     vb <- getTokenValue b
-    case (va, vb) of
+    pure $ foo va vb
-      (List as, List bs) ->
-        pure $ List $ zipWith (curry Tuple) as bs
-      _ ->
-        error "unexpected"
   UListToken ts -> do
     vs <- mapM getTokenValue ts
-    pure $ List vs
+    pure $ toValue vs
   UNoToken ->
-    pure Empty
+    pure $ toValue ()
 
 putTokenValue :: UToken -> ValueExistence -> DepRunM ()
 putTokenValue t e = case t of
@@ -87,41 +89,18 @@ runAction action input = case action of
   Inject v ->
     pure v
   FilterComp ->
-    case input of
+    let (vs, mask) = fromValue input :: ([Value], [Value])
-      Tuple (List vs, List mask) ->
+    in pure $ toValue $ map fst $ filter (fromValue . snd) $ zip vs mask
-        pure $ List $ map fst $ filter (fromValue . snd) $ zip vs mask
-      _ ->
-        error "unexpected"
   UntupleFst ->
-    case input of
+    pure $ fst (fromValue input :: (Value, Value))
-      Tuple (v, _) ->
-        pure v
-      _ ->
-        error "unexpected"
   UntupleSnd ->
-    case input of
+    pure $ snd (fromValue input :: (Value, Value))
-      Tuple (_, v) ->
-        pure v
-      _ ->
-        error "unexpected"
   UnzipFst ->
-    case input of
+    toValue <$> mapM (runAction UntupleFst) (fromValue input :: [Value])
-      List vs ->
-        List <$> mapM (runAction UntupleFst) vs
-      _ ->
-        error "unexpected"
   UnzipSnd ->
-    case input of
+    toValue <$> mapM (runAction UntupleSnd) (fromValue input :: [Value])
-      List vs ->
-        List <$> mapM (runAction UntupleSnd) vs
-      _ ->
-        error "unexpected"
   MapComp subDeps innerInput innerOutput ->
-    case input of
+    (toValue <$>) $ forM (fromValue input :: [Value]) $ \v -> do
-      List vs ->
-        (List <$>) $ flip mapM vs $ \v -> do
       putTokenValue innerInput $ Evaluated v
       runDeps subDeps
       getTokenValue innerOutput
-      _ ->
-        error "unexpected"

byg/src/Function.hs

@@ -1,139 +0,0 @@
-{-# LANGUAGE GADTs #-}
-module Function
-  ( concatStrings
-  , concatTexts
-  , joinPaths
-  , fileComponents
-  , lowerString
-  , elemOf
-  , makeTemplate
-  , applyTemplate
-  , toText
-  , convertImage
-  , runPandoc
-  ) where
-
-import Prelude hiding (String, FilePath)
-
-import Types.Values
-import Types.Value (Valuable)
-import Types.Function
-import Types.Token (Token(..))
-import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken, runFunction)
-
-import Type.Reflection (Typeable, TypeRep, typeRep)
-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
-
-
-data ConcatStrings = ConcatStrings deriving Show
-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
-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
-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
-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
-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 a where ElemOf :: TypeRep a -> ElemOf a
-deriving instance Show (ElemOf a)
-instance (Show a, Valuable a, Eq a) => IsFunction (ElemOf a) (a, [a]) Bool where
-  evalFunction (ElemOf _) (y, ys) = y `elem` ys
-
-elemOf :: forall t a b. (Show t, Valuable t, Eq t, TokenableTo t a, TokenableTo [t] b, Typeable t) => a -> b -> DepGenM (Token Bool)
-elemOf a b = runFunction (ElemOf (typeRep :: TypeRep t)) =<< toTupleToken a b
-
-
-data MakeTemplate = MakeTemplate deriving Show
-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
-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
-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
-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
-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

@@ -1,105 +0,0 @@
-module FunctionIO
-  ( listDirectory
-  , isDirectory
-  , readTextFile
-  , openImage
-  , saveImage
-  , saveTextFile
-  , copyFile
-  , makeDir
-  ) where
-
-import Prelude hiding (String, FilePath)
-
-import Types.Values
-import Types.FunctionIO
-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
-
-
-data ListDirectory = ListDirectory deriving Show
-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
-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
-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
-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
-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
-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
-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
-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/Functions.hs

@@ -0,0 +1,15 @@
+module Functions
+  ( module Functions.General
+  , module Functions.Image
+  , module Functions.Pandoc
+  , module Functions.Paths
+  , module Functions.Template
+  , module Functions.Text
+  ) where
+
+import Functions.General
+import Functions.Image
+import Functions.Pandoc
+import Functions.Paths
+import Functions.Template
+import Functions.Text

byg/src/Functions/General.hs

@@ -0,0 +1,18 @@
+{-# LANGUAGE GADTs #-}
+module Functions.General
+  ( elemOf
+  ) where
+
+import Types (Valuable, IsFunction(..), Token)
+import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken, runFunction)
+
+import Type.Reflection (Typeable, TypeRep, typeRep)
+
+
+data ElemOf a where ElemOf :: TypeRep a -> ElemOf a
+deriving instance Show (ElemOf a)
+instance (Show a, Valuable a, Eq a) => IsFunction (ElemOf a) (a, [a]) Bool where
+  evalFunction (ElemOf _) (y, ys) = y `elem` ys
+
+elemOf :: forall t a b. (Show t, Valuable t, Eq t, TokenableTo t a, TokenableTo [t] b, Typeable t) => a -> b -> DepGenM (Token Bool)
+elemOf a b = runFunction (ElemOf (typeRep :: TypeRep t)) =<< toTupleToken a b

byg/src/Functions/Image.hs

@@ -0,0 +1,58 @@
+module Functions.Image
+  ( Image(..)
+  , ImageConversionSettings(..)
+  , openImage
+  , saveImage
+  , convertImage
+  ) where
+
+import Types (IsFunction(..), IsFunctionIO(..), Token)
+import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken,
+                            runFunction, runFunctionIO, runFunctionIO_)
+
+import qualified Codec.Picture as CP
+import qualified Codec.Picture.STBIR as CPS
+
+
+newtype Image = ImageWrapper (CP.Image CP.PixelRGB8)
+  deriving (Eq)
+
+instance Show Image where
+  show = const "<image>"
+
+data ImageConversionSettings = ResizeToWidth Int
+  deriving (Eq, Show)
+
+data OpenImage = OpenImage deriving Show
+instance IsFunctionIO OpenImage FilePath Image where
+  evalFunctionIO OpenImage 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
+instance IsFunctionIO SaveImage (Image, FilePath) () where
+  evalFunctionIO SaveImage (ImageWrapper image, 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 ConvertImage = ConvertImage deriving Show
+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

byg/src/Functions/Pandoc.hs

@@ -0,0 +1,24 @@
+module Functions.Pandoc
+  ( runPandoc
+  ) where
+
+import Types (IsFunction(..), Token)
+import DependencyGenerator (DepGenM, TokenableTo(..), runFunction)
+
+import Data.Text (Text)
+import qualified Data.Text.Lazy as TL
+import qualified Text.Pandoc as P
+import qualified Text.Blaze.Html.Renderer.Text as B
+
+
+data RunPandoc = RunPandoc deriving Show
+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/Functions/Paths.hs

@@ -0,0 +1,90 @@
+module Functions.Paths
+  ( joinPaths
+  , fileComponents
+  , hasExtension
+  , listDirectory
+  , isDirectory
+  , makeDir
+  , copyFile
+  , copyTo
+  ) where
+
+import Functions.Text (lowerString)
+import Functions.General (elemOf)
+import Types (IsFunction(..), IsFunctionIO(..), Token(..))
+import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken, runFunction,
+                            runFunctionIO, runFunctionIO_, untupleSndDepGenM)
+
+import qualified System.Directory as SD
+
+
+data JoinPaths = JoinPaths deriving Show
+instance IsFunction JoinPaths (FilePath, FilePath) FilePath where
+  evalFunction JoinPaths (s0, s1) = 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
+instance IsFunction FileComponents FilePath (String, String) where
+  evalFunction FileComponents s =
+    let (lastRev, firstRev) = span (/= '.') $ reverse s
+        (base, ext) = case firstRev of
+          _ : firstRev' -> (reverse firstRev', reverse lastRev)
+          [] -> (reverse lastRev, "")
+    in (base, ext)
+
+fileComponents :: TokenableTo FilePath a => a -> DepGenM (Token (String, String))
+fileComponents a = runFunction FileComponents =<< 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
+
+
+data ListDirectory = ListDirectory deriving Show
+instance IsFunctionIO ListDirectory FilePath [FilePath] where
+  evalFunctionIO ListDirectory s =
+    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
+instance IsFunctionIO IsDirectory FilePath Bool where
+  evalFunctionIO IsDirectory s =
+    SD.doesDirectoryExist s
+  functionIOTouchesFilesystem IsDirectory = False
+
+isDirectory :: TokenableTo FilePath a => a -> DepGenM (Token Bool)
+isDirectory a = runFunctionIO IsDirectory =<< toToken a
+
+
+data MakeDir = MakeDir deriving Show
+instance IsFunctionIO MakeDir FilePath () where
+  evalFunctionIO MakeDir s =
+    SD.createDirectory s
+  functionIOTouchesFilesystem MakeDir = True
+
+makeDir :: TokenableTo FilePath a => a -> DepGenM ()
+makeDir a = runFunctionIO_ MakeDir =<< toToken a
+
+
+data CopyFile = CopyFile deriving Show
+instance IsFunctionIO CopyFile (FilePath, FilePath) () where
+  evalFunctionIO CopyFile (source, 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
+
+copyTo :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM ()
+copyTo path targetDir = do
+  pathToken <- toToken path
+  copyFile pathToken =<< joinPaths targetDir pathToken
+

byg/src/Functions/Template.hs

@@ -0,0 +1,33 @@
+module Functions.Template
+  ( Template(..)
+  , makeTemplate
+  , applyTemplate
+  ) where
+
+import Types (IsFunction(..), Token)
+import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken, runFunction)
+
+import Data.Text (Text)
+import qualified Data.Text as T
+
+data Template = TemplateParts Text Text
+  deriving (Eq, Show)
+
+data MakeTemplate = MakeTemplate deriving Show
+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
+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

byg/src/Functions/Text.hs

@@ -0,0 +1,69 @@
+module Functions.Text
+  ( concatStrings
+  , concatTexts
+  , lowerString
+  , toText
+  , readTextFile
+  , saveTextFile
+  ) where
+
+import Types (IsFunction(..), IsFunctionIO(..), Token)
+import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken,
+                            runFunction, runFunctionIO, runFunctionIO_)
+
+import Data.Char (toLower)
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+
+
+data ConcatStrings = ConcatStrings deriving Show
+instance IsFunction ConcatStrings [String] String where
+  evalFunction ConcatStrings = concat
+
+concatStrings :: TokenableTo [String] a => a -> DepGenM (Token String)
+concatStrings a = runFunction ConcatStrings =<< toToken a
+
+
+data ConcatTexts = ConcatTexts deriving Show
+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 LowerString = LowerString deriving Show
+instance IsFunction LowerString String String where
+  evalFunction LowerString s = map toLower s
+
+lowerString :: TokenableTo String a => a -> DepGenM (Token String)
+lowerString a = runFunction LowerString =<< toToken a
+
+
+data ToText = ToText deriving Show
+instance IsFunction ToText String Text where
+  evalFunction ToText s = T.pack s
+
+toText :: TokenableTo String a => a -> DepGenM (Token Text)
+toText a = runFunction ToText =<< toToken a
+
+
+data ReadTextFile = ReadTextFile deriving Show
+instance IsFunctionIO ReadTextFile FilePath Text where
+  evalFunctionIO ReadTextFile s =
+    T.readFile s
+  functionIOTouchesFilesystem ReadTextFile = False
+
+readTextFile :: TokenableTo FilePath a => a -> DepGenM (Token Text)
+readTextFile a = runFunctionIO ReadTextFile =<< toToken a
+
+
+data SaveTextFile = SaveTextFile deriving Show
+instance IsFunctionIO SaveTextFile (Text, FilePath) () where
+  evalFunctionIO SaveTextFile (t, 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

byg/src/SiteGenerator.hs

@@ -1,24 +1,11 @@
 module SiteGenerator (generateSite) where
 
-import Prelude hiding (String, FilePath)
+import Types (Token)
-
-import Types
 import DependencyGenerator
-import Function
+import Functions
-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
-
-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.hs

@@ -1,15 +1,11 @@
 module Types
   ( module Types.Token
-  , module Types.Values
   , module Types.Value
-  , module Types.Function
+  , module Types.Functions
-  , module Types.FunctionIO
   , Dependency
   ) where
 
 import Types.Token
-import Types.Values
 import Types.Value
-import Types.Function
+import Types.Functions
-import Types.FunctionIO
 import Types.Dependency (Dependency)

byg/src/Types/Dependency.hs

@@ -11,8 +11,7 @@ module Types.Dependency
 
 import Types.Token (Token(..))
 import Types.Value (Value)
-import Types.Function (IsFunction())
+import Types.Functions (IsFunction(), IsFunctionIO(..))
-import Types.FunctionIO (IsFunctionIO(..))
 
 import Text.Printf (printf)
 import Data.Text (Text)

byg/src/Types/Function.hs

@@ -1,9 +0,0 @@
-{-# LANGUAGE FunctionalDependencies #-}
-module Types.Function
-  ( IsFunction(..)
-  ) where
-
-import Types.Value (Valuable)
-
-class (Show f, Valuable a, Valuable b) => IsFunction f a b | f -> a b where
-  evalFunction :: f -> a -> b

byg/src/Types/Functions.hs

@@ -1,10 +1,14 @@
 {-# LANGUAGE FunctionalDependencies #-}
-module Types.FunctionIO
+module Types.Functions
-  ( IsFunctionIO(..)
+  ( IsFunction(..)
+  , IsFunctionIO(..)
   ) where
 
 import Types.Value (Valuable)
 
+class (Show f, Valuable a, Valuable b) => IsFunction f a b | f -> a b where
+  evalFunction :: f -> a -> b
+
 class (Show f, Valuable a, Valuable b) => IsFunctionIO f a b | f -> a b where
   evalFunctionIO :: f -> a -> IO b
   functionIOTouchesFilesystem :: f -> Bool

byg/src/Types/Value.hs

@@ -1,117 +1,47 @@
 {-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
 module Types.Value
   ( Value(..)
   , Valuable(..)
-  , WitnessFor(..)
   ) where
 
-import Prelude hiding (String)
+import Data.Dynamic
 
-import Types.Values
+data Value = Value { valueDynamic :: Dynamic
+                   , valueShow :: String
+                   }
 
-import Data.Text (Text)
+instance Show Value where
+  show = valueShow
 
--- Note: We use a wrapper for the String type in order to be able to define the
+class Typeable a => Valuable a where
--- general Valuable [a] instance further down.  Otherwise it would conflict with
--- our Valuable String instance, since the non-wrapped String type is just an
--- alias for [Char].
-data Value = String String
-           | Text Text
-           | Bool Bool
-           | Image Image
-           | ImageConversionSettings ImageConversionSettings
-           | Template Template
-           | Empty
-           | Tuple (Value, Value)
-           | List [Value]
-  deriving (Show)
-
-class Valuable a where
   toValue :: a -> Value
   fromValue :: Value -> a
 
-instance Valuable String where
+toValueOnce :: (Typeable a, Show a) => a -> Value
-  toValue = String
+toValueOnce x = Value { valueDynamic = toDyn x
-  fromValue = \case
+                      , valueShow = show x
-    String a -> a
+                      }
-    _ -> error "unexpected"
 
-instance Valuable Text where
+fromValueOnce :: Typeable a => Value -> a
-  toValue = Text
+fromValueOnce = flip fromDyn (error "unexpected") . valueDynamic
-  fromValue = \case
-    Text a -> a
-    _ -> error "unexpected"
 
-instance Valuable Bool where
+instance Valuable Value where
-  toValue = Bool
+  toValue = id
-  fromValue = \case
+  fromValue = id
-    Bool a -> a
-    _ -> error "unexpected"
 
-instance Valuable Image where
+instance {-# OVERLAPPABLE #-} Valuable String where
-  toValue = Image
+  toValue = toValueOnce
-  fromValue = \case
+  fromValue = fromValueOnce
-    Image a -> a
-    _ -> error "unexpected"
 
-instance Valuable ImageConversionSettings where
+instance {-# OVERLAPPABLE #-} Valuable a => Valuable [a] where
-  toValue = ImageConversionSettings
+  toValue = toValueOnce . map toValue
-  fromValue = \case
+  fromValue = map fromValue . fromValueOnce
-    ImageConversionSettings a -> a
-    _ -> error "unexpected"
 
-instance Valuable Template where
+instance {-# OVERLAPPABLE #-} (Valuable a, Valuable b) => Valuable (a, b) where
-  toValue = Template
+  toValue (a, b) = toValueOnce (toValue a, toValue b)
-  fromValue = \case
+  fromValue v = let (va, vb) = fromValueOnce v
-    Template a -> a
+                in (fromValue va, fromValue vb)
-    _ -> error "unexpected"
 
-instance Valuable () where
+instance {-# OVERLAPPABLE #-} (Typeable a, Show a) => Valuable a where
-  toValue () = Empty
+  toValue = toValueOnce
-  fromValue = \case
+  fromValue = fromValueOnce
-    Empty -> ()
-    _ -> error "unexpected"
-
-instance (Valuable a, Valuable b) => Valuable (a, b) where
-  toValue (a, b) = Tuple (toValue a, toValue b)
-  fromValue = \case
-    Tuple (va, vb) -> (fromValue va, fromValue vb)
-    _ -> error "unexpected"
-
-instance Valuable a => Valuable [a] where
-  toValue = List . map toValue
-  fromValue = \case
-    List a -> map fromValue a
-    _ -> error "unexpected"
-
-
-class Show w => WitnessFor w t | w -> t, t -> w where
-  witnessValue :: w
-
-data StringType = StringType deriving Show
-instance WitnessFor StringType String where witnessValue = StringType
-
-data TextType = TextType deriving Show
-instance WitnessFor TextType Text where witnessValue = TextType
-
-data BoolType = BoolType deriving Show
-instance WitnessFor BoolType Bool where witnessValue = BoolType
-
-data ImageType = ImageType deriving Show
-instance WitnessFor ImageType Image where witnessValue = ImageType
-
-data ImageConversionSettingsType = ImageConversionSettingsType deriving Show
-instance WitnessFor ImageConversionSettingsType ImageConversionSettings where witnessValue = ImageConversionSettingsType
-
-data TemplateType = TemplateType deriving Show
-instance WitnessFor TemplateType Template where witnessValue = TemplateType
-
-data EmptyType = EmptyType deriving Show
-instance WitnessFor EmptyType () where witnessValue = EmptyType
-
-data TupleType ta tb = TupleType ta tb deriving Show
-instance (WitnessFor ta a, WitnessFor tb b) => WitnessFor (TupleType ta tb) (a, b) where witnessValue = TupleType witnessValue witnessValue
-
-data ListType t = ListType t deriving Show
-instance WitnessFor t a => WitnessFor (ListType t) [a] where witnessValue = ListType witnessValue

byg/src/Types/Values.hs

@@ -1,37 +0,0 @@
-module Types.Values
-  ( String(..)
-  , FilePath
-  , Image(..)
-  , ImageConversionSettings(..)
-  , Template(..)
-  ) where
-
-import Prelude hiding (String, FilePath)
-import qualified Prelude
-
-import Data.String (IsString(..))
-import Data.Text (Text)
-import qualified Codec.Picture as CP
-
-newtype String = StringWrapper { unStringWrapper :: Prelude.String }
-  deriving (Eq)
-
-instance Show String where
-  show (StringWrapper s) = show s
-
-type FilePath = String
-
-instance IsString String where
-  fromString = StringWrapper
-
-newtype Image = ImageWrapper (CP.Image CP.PixelRGB8)
-  deriving (Eq)
-
-instance Show Image where
-  show = const "Image"
-
-data ImageConversionSettings = ResizeToWidth Int
-  deriving (Eq, Show)
-
-data Template = TemplateParts Text Text
-  deriving (Eq, Show)