Move SiteGenerator into executable only and rename library to Byg.*

2024-11-09 22:44:46 +01:00
parent 0f0bde5f18
commit a60f652242
22 changed files with 109 additions and 106 deletions
--- a/byg/src/Byg/DependencyGenerator.hs
+++ b/byg/src/Byg/DependencyGenerator.hs
@@ -0,0 +1,198 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE FunctionalDependencies #-}
+module Byg.DependencyGenerator
+  ( DepGenM
+  , DepGenM'
+  , TokenableTo(..)
+  , toTupleToken
+  , evalDepGenM
+  , inject
+  , onToken
+  , onTupleToken
+  , runFunctionIO
+  , runFunctionIO_
+  , mapDepGenM
+  , mapDepGenM_
+  , forDepGenM
+  , forDepGenM_
+  , filterDepGenM
+  , filterDepGenM'
+  , zipDepGenM
+  , untupleFstDepGenM
+  , untupleSndDepGenM
+  , untupleDepGenM
+  , unzipFstDepGenM
+  , unzipSndDepGenM
+  , unzipDepGenM
+  ) where
+
+import Byg.Types.Token (Token(..))
+import Byg.Types.Functions (IsFunctionIO(..))
+import Byg.Types.Dependency (Action(..), F(..), Dependency, makeDependency)
+
+import Type.Reflection (Typeable, TypeRep, typeRep)
+import Control.Monad.State (MonadState, State, runState, put, get)
+import Control.Monad.Writer (MonadWriter, WriterT, runWriterT, tell)
+
+newtype DepGenM a = DepGenM { unDepGenM :: WriterT [Dependency] (State Int) a }
+  deriving (Functor, Applicative, Monad, MonadState Int, MonadWriter [Dependency])
+
+type DepGenM' a = DepGenM (Token a)
+
+runDepGenM :: Int -> DepGenM a -> ((a, [Dependency]), Int)
+runDepGenM top m = runState (runWriterT (unDepGenM m)) top
+
+evalDepGenM :: DepGenM () -> [Dependency]
+evalDepGenM = snd . fst . runDepGenM 0
+
+tellDep :: Dependency -> DepGenM ()
+tellDep dep = tell [dep]
+
+newToken :: (Typeable a, Show a) => DepGenM (Token a)
+newToken = do
+  top <- get
+  let top' = top + 1
+      target = Token top'
+  put top'
+  pure target
+
+genDependencyM :: (Typeable a, Show a) => (Token a -> DepGenM Dependency) -> DepGenM (Token a)
+genDependencyM f = do
+  target <- newToken
+  result <- f target
+  tellDep result
+  pure target
+
+genDependency :: (Typeable a, Show a) => (Token a -> Dependency) -> DepGenM (Token a)
+genDependency f = genDependencyM (pure . f)
+
+inject :: (Show a, Typeable a) => a -> DepGenM (Token a)
+inject x = genDependency (makeDependency NoToken (Inject x))
+
+onToken :: (TokenableTo a t, Show a, Typeable a, Show b, Typeable b) => (a -> b) -> t -> DepGenM (Token b)
+onToken f input = do
+  input' <- toToken input
+  genDependency (makeDependency input' (Function (F f)))
+
+onTupleToken :: (TokenableTo a t1, Show a, Typeable a, TokenableTo b t2, Show b, Typeable b, Show r, Typeable r) => (a -> b -> r) -> t1 -> t2 -> DepGenM (Token r)
+onTupleToken f input1 input2 = do
+  tup <- toTupleToken input1 input2
+  genDependency (makeDependency tup (Function (F (uncurry f))))
+
+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 (Show t, Typeable t) => TokenableTo t s | s -> t where
+  toToken :: s -> DepGenM (Token t)
+  tokenTypeRep :: s -> TypeRep t
+
+instance (Show a, Typeable a) => TokenableTo a (Token a) where
+  toToken = pure
+  tokenTypeRep _ = typeRep
+
+instance (Show a, Typeable a) => TokenableTo [a] [Token a] where
+  toToken = pure . ListToken
+  tokenTypeRep _ = typeRep
+
+instance (Show a, Typeable a) => TokenableTo a (DepGenM (Token a)) where
+  toToken = id
+  tokenTypeRep _ = typeRep
+
+instance (Show a, Typeable a) => TokenableTo [a] [DepGenM (Token a)] where
+  toToken = fmap ListToken . sequence
+  tokenTypeRep _ = typeRep
+
+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, Typeable a, Show a, Typeable b, Show b) => (Token a -> DepGenM (Token b)) -> v -> DepGenM (Token [b])
+mapDepGenM f input = do
+  input' <- toToken input
+  genDependencyM $ \target -> do
+    top <- get
+    let (((innerInp, innerOutp), subDeps), top') = runDepGenM top $ do
+          inp <- newToken
+          outp <- f inp
+          pure (inp, outp)
+    put top'
+    pure (makeDependency input' (MapComp subDeps innerInp innerOutp) target)
+
+mapDepGenM_ :: (TokenableTo [a] v, Typeable a, Show a) => (Token a -> DepGenM ()) -> v -> DepGenM ()
+mapDepGenM_ f input = do
+  _ <- mapDepGenM (\x -> f x >> pure NoToken) input
+  pure ()
+
+forDepGenM :: (TokenableTo [a] v, Typeable a, Show a, Typeable b, Show b) => v -> (Token a -> DepGenM (Token b)) -> DepGenM (Token [b])
+forDepGenM = flip mapDepGenM
+
+forDepGenM_ :: (TokenableTo [a] v, Typeable a, Show a) => v -> (Token a -> DepGenM ()) -> DepGenM ()
+forDepGenM_ = flip mapDepGenM_
+
+filterDepGenM' :: (TokenableTo [Bool] v, TokenableTo [a] u, Typeable a, Show a) => v -> u -> DepGenM (Token [a])
+filterDepGenM' mask input = do
+  tup <- toTupleToken input mask
+  genDependency (makeDependency tup FilterComp)
+
+filterDepGenM :: (TokenableTo [a] v, Typeable a, Show a) => (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, Typeable a, Show a, Typeable b, Show b) => v -> u -> DepGenM (Token [(a, b)])
+zipDepGenM a b = do
+  a' <- toToken a
+  b' <- toToken b
+  pure $ ZipToken a' b'
+
+untupleFstDepGenM :: (TokenableTo (a, b) t, Typeable a, Show a, Typeable b, Show b) => t -> DepGenM (Token a)
+untupleFstDepGenM t = do
+  t' <- toToken t
+  case t' of
+    TupleToken a _ ->
+      pure a
+    Token _ ->
+      genDependency (makeDependency t' UntupleFst)
+
+untupleSndDepGenM :: (TokenableTo (a, b) t, Typeable a, Show a, Typeable b, Show b) => t -> DepGenM (Token b)
+untupleSndDepGenM t = do
+  t' <- toToken t
+  case t' of
+    TupleToken _ b ->
+      pure b
+    Token _ ->
+      genDependency (makeDependency t' UntupleSnd)
+
+untupleDepGenM :: (TokenableTo (a, b) t, Typeable a, Show a, Typeable b, Show b) => t -> DepGenM (Token a, Token b)
+untupleDepGenM t = do
+  t' <- toToken t
+  a <- untupleFstDepGenM t'
+  b <- untupleSndDepGenM t'
+  pure (a, b)
+
+unzipFstDepGenM :: (TokenableTo [(a, b)] t, Typeable a, Show a, Typeable b, Show b) => t -> DepGenM (Token [a])
+unzipFstDepGenM t = do
+  t' <- toToken t
+  case t' of
+    ZipToken a _ ->
+      pure a
+    _ ->
+      genDependency (makeDependency t' UnzipFst)
+
+unzipSndDepGenM :: (TokenableTo [(a, b)] t, Typeable a, Show a, Typeable b, Show b) => t -> DepGenM (Token [b])
+unzipSndDepGenM t = do
+  t' <- toToken t
+  case t' of
+    ZipToken _ b ->
+      pure b
+    _ ->
+      genDependency (makeDependency t' UnzipSnd)
+
+unzipDepGenM :: (TokenableTo [(a, b)] t, Typeable a, Show a, Typeable b, Show b) => t -> DepGenM (Token [a], Token [b])
+unzipDepGenM t = do
+  t' <- toToken t
+  a <- unzipFstDepGenM t'
+  b <- unzipSndDepGenM t'
+  pure (a, b)
--- a/byg/src/Byg/DependencyRunner.hs
+++ b/byg/src/Byg/DependencyRunner.hs
@@ -0,0 +1,266 @@
+{-# LANGUAGE MonoLocalBinds #-}
+module Byg.DependencyRunner
+  ( DepRunM
+  , runDeps
+  , runDepRunMIO
+  , extractSndToken
+  , extractSndTokenAsList
+  ) where
+
+import Byg.Types (evalFunctionIO, functionIOReads, functionIOWrites)
+import Byg.Types.Value
+import Byg.Types.Token
+import Byg.Types.Dependency
+
+import Type.Reflection (Typeable)
+import Data.Map (Map)
+import qualified Data.Map as M
+import Control.Monad (void, forM, filterM)
+import Control.Monad.State (MonadState, MonadIO, StateT, evalStateT, get, modify, liftIO)
+import Control.Monad.Writer (MonadWriter, WriterT, runWriterT, tell)
+import System.Directory (getModificationTime)
+import Data.Time.Clock (UTCTime(..))
+import qualified System.Directory as SD
+
+data LastUpdated = Never
+                 | NeverDebug String
+                 | NeverInput
+                 | At UTCTime
+  deriving (Show, Eq, Ord)
+
+data ValueExistence = Evaluated Value LastUpdated
+                    | NotEvaluated (LastUpdated -> DepRunM (Maybe (Value, LastUpdated)))
+
+newtype DepRunM a = DepRunM { unDepRunM :: WriterT [FilePath] (StateT (Map Int ValueExistence) IO) a }
+  deriving (Functor, Applicative, Monad, MonadIO,
+            MonadState (Map Int ValueExistence),
+            MonadWriter [FilePath])
+
+runDeps :: [Dependency] -> DepRunM ()
+runDeps = mapM_ runDep
+
+runDepRunMIO :: DepRunM a -> IO (a, [FilePath])
+runDepRunMIO m = evalStateT (runWriterT (unDepRunM m)) M.empty
+
+evaluate :: LastUpdated -> ValueExistence -> DepRunM (Maybe (Value, LastUpdated))
+evaluate luFuture = \case
+  Evaluated v lu -> pure (Just (v, lu))
+  NotEvaluated m -> m luFuture
+
+runDep :: Dependency -> DepRunM ()
+runDep (Dependency _ a action _ b) =
+  if actionWritesAny action
+  then void (m Never)
+  else putTokenValue b $ NotEvaluated m
+  where m :: LastUpdated -> DepRunM (Maybe (Value, LastUpdated))
+        m luFuture = do
+          mr <- runAction action a luFuture
+          case mr of
+            Just (result, luResult) -> do
+              putTokenValue b $ Evaluated result luResult
+              pure $ Just (result, luResult)
+            Nothing ->
+              pure Nothing
+
+extractSndToken :: Token (a, b) -> Token b
+extractSndToken = \case
+  TupleToken _ b ->
+    b
+  _ ->
+    error "unsupported"
+
+extractSndTokenAsList :: (Show b, Typeable b) => Token (a, b) -> Token [b]
+extractSndTokenAsList = ListToken . (: []) . extractSndToken
+
+getTokenValueByIndex :: LastUpdated -> Int -> DepRunM (Maybe (Value, LastUpdated))
+getTokenValueByIndex luFuture i = do
+  m <- get
+  case m M.!? i of
+    Nothing -> pure Nothing
+    Just x -> evaluate luFuture x
+
+-- minimumOrNever :: [LastUpdated] -> LastUpdated
+-- minimumOrNever = \case
+--   [] -> Never
+--   times -> minimum times
+
+maximumOrNever :: [LastUpdated] -> LastUpdated
+maximumOrNever = \case
+  [] -> Never
+  times -> maximum times
+
+maximumOrNever' :: [UTCTime] -> LastUpdated
+maximumOrNever' = maximumOrNever . map At
+
+getTokenValueRaw :: LastUpdated -> Token a -> DepRunM (Maybe (a, LastUpdated))
+getTokenValueRaw luFuture token = case token of
+  Token i -> do
+    m <- getTokenValueByIndex luFuture i
+    pure $ do (a, lu) <- m
+              pure (fromValue a, lu)
+
+  TupleToken a b -> do
+    m0 <- getTokenValueRaw luFuture a
+    m1 <- getTokenValueRaw luFuture b
+    case (m0, m1) of
+      (Just (a', luA), Just (b', luB)) ->
+        pure $ Just ((a', b'), max luA luB)
+      (Just (a', luA), Nothing) -> do -- | luA /= NeverInput -> do
+        r <- getTokenValueRaw (NeverDebug (show (a', luA))) b
+        pure $ case r of
+          Nothing -> error ("unexpected " ++ show b ++ " (" ++ show (a', luA) ++ ")")
+          Just (b', luB) -> Just ((a', b'), max luA luB)
+      (Nothing, Just (b', luB)) -> do -- | luB /= NeverInput -> do
+        r <- getTokenValueRaw (NeverDebug (show (b', luB))) a
+        pure $ case r of
+          Nothing -> error "unexpected"
+          Just (a', luA) -> Just ((a', b'), max luA luB)
+      _ ->
+        pure $ Nothing
+
+  ZipToken a b -> do
+    m0 <- getTokenValueRaw luFuture a
+    m1 <- getTokenValueRaw luFuture b
+    case (m0, m1) of
+      (Just (a', luA), Just (b', luB)) ->
+        pure $ Just (zip a' b', max luA luB)
+      (Just (a', luA), Nothing) -> do -- | luA /= NeverInput -> do
+        r <- getTokenValueRaw Never b
+        pure $ case r of
+          Nothing -> error "unexpected"
+          Just (b', luB) -> Just (zip a' b', max luA luB)
+      (Nothing, Just (b', luB)) -> do -- | luB /= NeverInput -> do
+        r <- getTokenValueRaw Never a
+        pure $ case r of
+          Nothing -> error "unexpected"
+          Just (a', luA) -> Just (zip a' b', max luA luB)
+      _ ->
+        pure $ Nothing
+
+  ListToken ts -> do
+    ms <- mapM (getTokenValueRaw luFuture) ts
+    if False -- null $ filter ((/= NeverInput) . snd) (catMaybes ms)
+      then pure Nothing
+      else do ms' <- case sequence ms of
+                Just x -> pure x
+                Nothing -> do r <- mapM (getTokenValueRaw Never) ts
+                              case sequence r of
+                                Nothing -> error "unexpected"
+                                Just x -> pure x
+              let (as, lus) = unzip ms'
+              pure $ Just (as, maximumOrNever lus)
+
+  NoToken ->
+    pure $ Just ((), Never)
+
+getTokenValue :: Token a -> LastUpdated -> DepRunM (Maybe (Value, LastUpdated))
+getTokenValue token luFuture = case token of
+  Token i ->
+    getTokenValueByIndex luFuture i
+  TupleToken _ _ ->
+    fromRaw token
+  ZipToken _ _ ->
+    fromRaw token
+  ListToken _ ->
+    fromRaw token
+  NoToken ->
+    fromRaw token
+  where fromRaw :: (Typeable a, Show a) => Token a -> DepRunM (Maybe (Value, LastUpdated))
+        fromRaw t = do
+          m <- getTokenValueRaw luFuture t
+          pure $ do (x, lu) <- m
+                    pure (toValue x, lu)
+
+putTokenValue :: Token a -> ValueExistence -> DepRunM ()
+putTokenValue t v = case t of
+  Token i ->
+    modify $ M.insert i v
+  NoToken ->
+    pure ()
+  _ ->
+    error "unexpected"
+
+maximumModTime :: [FilePath] -> DepRunM LastUpdated
+maximumModTime paths = do
+  paths' <- filterM (liftIO . SD.doesPathExist) paths
+  times <- mapM (liftIO . getModificationTime) paths'
+  pure $ maximumOrNever' times
+
+runAction :: forall a b. Action a b -> Token a -> LastUpdated
+          -> DepRunM (Maybe (Value, LastUpdated))
+runAction action tokenInput luFuture = case action of
+  Function (F f) ->
+    calc f
+  FunctionIO f -> do
+    m <- getTokenValueRaw luFuture $ functionIOWrites f tokenInput
+    case m of
+      Nothing ->
+        pure Nothing -- error "unexpected" -- wrong?
+      Just (writes, _writesLu) -> do
+        tell writes
+        lastWritten <- max luFuture <$> maximumModTime writes
+        result <- getTokenValue tokenInput lastWritten
+        case result of
+          Just (inputValue, luInput) -> do
+            let input = inputFromValue inputValue
+            lastUpdated <- max luInput <$> (maximumModTime $ functionIOReads f input)
+            if lastUpdated > lastWritten
+              then do liftIO $ do
+                        putStrLn ("input: " ++ show input)
+                        putStrLn ("input last updated: " ++ show luInput)
+                        putStrLn ("IO function: " ++ show f)
+                        putStrLn ("Source timestamp: " ++ show lastUpdated)
+                        putStrLn ("Target timestamp: " ++ show lastWritten)
+                      v <- toValue <$> (liftIO $ evalFunctionIO f input)
+                      -- tell writes
+                      let luResult = max luInput lastUpdated
+                      liftIO $ do
+                        putStrLn ("output: " ++ show v)
+                        putStrLn ("output last updated: " ++ show luResult)
+                        putStrLn "----------"
+                      pure $ Just (v, luResult)
+              else do -- liftIO $ putStrLn ("Source timestamp "
+                      --                    ++ show lastUpdated
+                      --                    ++ " not newer than target timestamp "
+                      --                    ++ show lastWritten
+                      --                    ++ "; ignoring IO computation.")
+                      pure Nothing -- (toValue (), lastWritten) -- assumes writing FunctionIO always return ()
+          Nothing ->
+            pure Nothing
+  Inject x ->
+    pure $ Just (toValue x, NeverInput)
+  FilterComp ->
+    calc (\(vs, mask) -> map fst $ filter snd $ zip vs mask)
+  UntupleFst ->
+    calc fst
+  UntupleSnd ->
+    calc snd
+  UnzipFst ->
+    calc (map fst)
+  UnzipSnd ->
+    calc (map snd)
+  MapComp subDeps innerInput innerOutput -> do
+    m <- getTokenValue tokenInput luFuture
+    case m of
+      Nothing -> pure Nothing
+      Just (inputValue, luInput) -> do
+        let input = inputFromValue inputValue
+        lastUpdated <- maximumModTime $ actionReads action input
+        result <- forM input $ \x -> do
+          putTokenValue innerInput $ Evaluated (toValue x) (max luInput lastUpdated)
+          runDeps subDeps
+          mr <- getTokenValue innerOutput luFuture
+          pure $ do (vOut, luOut) <- mr
+                    pure (fromValue vOut, luOut)
+        pure $ do result' <- sequence result
+                  let (values, lus) = unzip result'
+                  pure $ (toValueRep (actionTargetType action) values, maximumOrNever lus)
+  where inputFromValue :: Typeable a => Value -> a
+        inputFromValue = fromValueRep (actionSourceType action)
+
+        calc :: (Typeable a, Typeable b, Show b) => (a -> b) -> DepRunM (Maybe (Value, LastUpdated))
+        calc f = do
+          m <- getTokenValue tokenInput luFuture
+          pure $ do (inputValue, luInput) <- m
+                    let input = inputFromValue inputValue
+                    pure (toValue $ f input, luInput)
--- a/byg/src/Byg/Functions.hs
+++ b/byg/src/Byg/Functions.hs
@@ -0,0 +1,17 @@
+module Byg.Functions
+  ( module Byg.Functions.Image
+  , module Byg.Functions.Pandoc
+  , module Byg.Functions.Paths
+  , module Byg.Functions.Template
+  , module Byg.Functions.Text
+  , module Byg.Functions.Date
+  , module Byg.Functions.Atom
+  ) where
+
+import Byg.Functions.Image
+import Byg.Functions.Pandoc
+import Byg.Functions.Paths
+import Byg.Functions.Template
+import Byg.Functions.Text
+import Byg.Functions.Date
+import Byg.Functions.Atom
--- a/byg/src/Byg/Functions/Atom.hs
+++ b/byg/src/Byg/Functions/Atom.hs
@@ -0,0 +1,93 @@
+{-# LANGUAGE RebindableSyntax #-}
+module Byg.Functions.Atom
+  ( generateAtom
+  ) where
+
+import Prelude
+
+import Byg.Types (Token, Date(..), formatDateShort)
+import Byg.DependencyGenerator (DepGenM, TokenableTo(..), onTupleToken)
+
+import Data.Text (Text)
+import qualified Data.Text as T
+
+fromString :: String -> Text
+fromString = T.pack
+
+class IsStructure a where
+  toStructure :: a -> Structure
+
+instance IsStructure Structure where
+  toStructure = id
+
+instance IsStructure [Structure] where
+  toStructure [s] = s
+  toStructure (s1 : s2 : ss) = Merge (Merge s1 s2) (toStructure ss)
+  toStructure [] = Empty
+
+instance IsStructure [Text] where
+  toStructure = Line
+
+instance IsStructure Text where
+  toStructure t = toStructure [t]
+
+data Structure = Line [Text]
+               | Indent Structure
+               | Merge Structure Structure
+               | Empty
+
+structureToText :: Structure -> Text
+structureToText = T.concat . toText ""
+  where toText :: Text -> Structure -> [Text]
+        toText indent = \case
+          Line ts ->
+            indent : ts ++ ["\n"]
+          Indent s ->
+             toText (T.append indent "  ") s
+          Merge a b ->
+            toText indent a ++ toText indent b
+          Empty ->
+            []
+
+(>:) :: (IsStructure a, IsStructure b) => a -> b -> Structure
+a >: b = Merge (toStructure a) (toStructure b)
+
+(>>:) :: (IsStructure a, IsStructure b) => a -> b -> Structure
+a >>: b = Merge (toStructure a) (Indent (toStructure b))
+
+type AtomEntry = ((Text, Date), String)
+
+urlRoot :: Text
+urlRoot = "https://mad.metanohi.name"
+
+generateAtomStructure :: Date -> [AtomEntry] -> Structure
+generateAtomStructure updated entries =
+  "<?xml version=\"1.0\" encoding=\"utf-8\"?>" >:
+  "<feed xmlns=\"http://www.w3.org/2005/Atom\">"
+  >>: ("<title>Niels' mad</title>" >:
+       ["<link href=\"", urlRoot, "/atom.xml\" rel=\"self\" />"] >:
+       ["<link href=\"", urlRoot, "\" />"] >:
+       ["<id>", urlRoot, "/atom.xml</id>"] >:
+       "<author>"
+       >>: ("<name>Niels G. W. Serup</name>" >:
+            "<email>ngws@metanohi.name</email>") >:
+       "</author>" >:
+       ["<updated>", formatDateShort updated, "T00:00:00Z</updated>"])
+  >>: map makeEntry entries >:
+  "</feed>"
+
+makeEntry :: AtomEntry -> Structure
+makeEntry ((title, updated), slug) =
+  "<entry>"
+  >>: (["<title>", title, "</title>"]
+       >: ("<link href=\"" : slugUrl ++ ["\" />"])
+       >: ("<id>" : slugUrl ++ ["</id>"])
+       >: ("<updated>" : updatedDate ++ ["</updated>"])
+       >: ("<published>" : updatedDate ++ ["</published>"]))
+  >: "</entry>"
+  where slugUrl = [urlRoot, "/", T.pack slug, ".html"]
+        updatedDate = [formatDateShort updated, "T00:00:00Z"]
+
+generateAtom :: (TokenableTo Date a, TokenableTo [AtomEntry] b) => a -> b -> DepGenM (Token Text)
+generateAtom = onTupleToken (\updated entries ->
+                               structureToText $ generateAtomStructure updated entries)
--- a/byg/src/Byg/Functions/Date.hs
+++ b/byg/src/Byg/Functions/Date.hs
@@ -0,0 +1,26 @@
+module Byg.Functions.Date
+  ( extractDate
+  ) where
+
+import Byg.Types (Token, Date(..))
+import Byg.DependencyGenerator (DepGenM, TokenableTo(..), onToken)
+
+import Data.List.NonEmpty (NonEmpty(..))
+import qualified Data.List.NonEmpty as NE
+
+split :: Eq a => a -> [a] -> NonEmpty [a]
+split sep = \case
+  [] ->
+    NE.singleton []
+  (c : cs) ->
+    (if sep == c
+     then NE.cons []
+     else \(h :| t) -> (c : h) :| t)
+    $ split sep cs
+
+extractDate :: TokenableTo String a => a -> DepGenM (Token Date)
+extractDate = onToken $ \dirName -> case split '-' dirName of
+  year :| (month : day : _) ->
+    Date (read year) (read month) (read day)
+  _ ->
+    error "unexpected"
--- a/byg/src/Byg/Functions/Image.hs
+++ b/byg/src/Byg/Functions/Image.hs
@@ -0,0 +1,59 @@
+module Byg.Functions.Image
+  ( Image(..)
+  , ImageConversionSettings(..)
+  , openImage
+  , saveImage
+  , convertImage
+  ) where
+
+import Byg.Types (IsFunctionIO(..), Token(..))
+import Byg.DependencyGenerator (DepGenM, TokenableTo(..), onTupleToken, toTupleToken,
+                            runFunctionIO, runFunctionIO_)
+import Byg.DependencyRunner (extractSndTokenAsList)
+
+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
+  functionIOReads OpenImage s = [s]
+  functionIOWrites OpenImage = const (ListToken [])
+  functionIOWritesAny 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
+  functionIOReads SaveImage = const []
+  functionIOWrites SaveImage = extractSndTokenAsList
+  functionIOWritesAny SaveImage = True
+
+saveImage :: (TokenableTo Image a, TokenableTo FilePath b) => a -> b -> DepGenM ()
+saveImage a b = runFunctionIO_ SaveImage =<< toTupleToken a b
+
+
+convertImage :: (TokenableTo Image a, TokenableTo ImageConversionSettings b) => a -> b -> DepGenM (Token Image)
+convertImage = onTupleToken $ \(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
--- a/byg/src/Byg/Functions/Pandoc.hs
+++ b/byg/src/Byg/Functions/Pandoc.hs
@@ -0,0 +1,42 @@
+module Byg.Functions.Pandoc
+  ( readMarkdown
+  , writeHtml
+  , markdownToHtml
+  , extractTitle
+  , injectAfterTitle
+  ) where
+
+import Byg.Types (Token)
+import Byg.DependencyGenerator (DepGenM, TokenableTo(..), onToken, onTupleToken)
+
+import Data.Text (Text)
+import Control.Monad ((>=>))
+import Text.Pandoc.Definition (Pandoc)
+import qualified Text.Pandoc.Definition as PD
+import qualified Text.Pandoc.Shared as PS
+import qualified Text.Pandoc as P
+
+runPandoc :: P.PandocPure a -> a
+runPandoc m = case P.runPure m of
+  Left e -> error ("unexpected pandoc error: " ++ show e)
+  Right result -> result
+
+readMarkdown :: TokenableTo Text a => a -> DepGenM (Token Pandoc)
+readMarkdown = onToken $ runPandoc . P.readMarkdown settings
+  where settings = P.def { P.readerExtensions = P.extensionsFromList [ P.Ext_raw_html ] }
+
+writeHtml :: TokenableTo Pandoc a => a -> DepGenM (Token Text)
+writeHtml = onToken $ runPandoc . P.writeHtml5String P.def
+
+markdownToHtml :: TokenableTo Text a => a -> DepGenM (Token Text)
+markdownToHtml = readMarkdown >=> writeHtml
+
+extractTitle :: TokenableTo Pandoc a => a -> DepGenM (Token Text)
+extractTitle = onToken $ \(PD.Pandoc _ blocks) -> case blocks of
+  (PD.Header 1 _ inlines : _) -> PS.stringify inlines
+  _ -> error "unexpected"
+
+injectAfterTitle :: (TokenableTo Text a, TokenableTo Pandoc b) => a -> b -> DepGenM (Token Pandoc)
+injectAfterTitle = onTupleToken $ \extra (PD.Pandoc meta blocks) -> case blocks of
+  (header@(PD.Header _ _ _) : rest) -> PD.Pandoc meta (header : PD.RawBlock "html" extra : rest)
+  _ -> error "unexpected"
--- a/byg/src/Byg/Functions/Paths.hs
+++ b/byg/src/Byg/Functions/Paths.hs
@@ -0,0 +1,94 @@
+module Byg.Functions.Paths
+  ( joinPaths
+  , fileComponents
+  , hasExtension
+  , listDirectory
+  , isDirectory
+  , makeDir
+  , copyFile
+  , copyTo
+  ) where
+
+import Byg.Types (IsFunctionIO(..), Token(..))
+import Byg.DependencyGenerator (DepGenM, TokenableTo(..), onToken, onTupleToken, toTupleToken,
+                            runFunctionIO, runFunctionIO_, untupleSndDepGenM)
+import Byg.DependencyRunner (extractSndTokenAsList)
+
+import Data.Char (toLower)
+import Control.Monad (when)
+import qualified System.Directory as SD
+
+joinPaths :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM (Token FilePath)
+joinPaths = onTupleToken $ \s0 s1 -> s0 ++ "/" ++ s1
+
+fileComponents :: TokenableTo FilePath a => a -> DepGenM (Token (String, String))
+fileComponents = onToken $ \s ->
+  let (lastRev, firstRev) = span (/= '.') $ reverse s
+      (base, ext) = case firstRev of
+        _ : firstRev' -> (reverse firstRev', reverse lastRev)
+        [] -> (reverse lastRev, "")
+  in (base, ext)
+
+hasExtension :: (TokenableTo [String] a, TokenableTo FilePath b) => a -> b -> DepGenM (Token Bool)
+hasExtension exts filename = do
+  ext <- onToken (map toLower) =<< untupleSndDepGenM =<< fileComponents filename
+  onTupleToken elem ext exts
+
+
+data ListDirectory = ListDirectory deriving Show
+instance IsFunctionIO ListDirectory FilePath [FilePath] where
+  evalFunctionIO ListDirectory s = SD.listDirectory s
+  functionIOReads ListDirectory s = [s]
+  functionIOWrites ListDirectory = const (ListToken [])
+  functionIOWritesAny ListDirectory = False  -- old: force triggering
+
+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
+  functionIOReads IsDirectory s = [s]
+  functionIOWrites IsDirectory = const (ListToken [])
+  functionIOWritesAny 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 = do
+    exists <- SD.doesPathExist s
+    when (not exists) $ SD.createDirectory s
+  functionIOReads MakeDir = const []
+  functionIOWrites MakeDir s = ListToken [s]
+
+
+  -- Old: Don't consider a created
+                                            -- directory "written", as there is
+                                            -- no extra information than its name
+                                            -- and presence.
+  functionIOWritesAny 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
+  functionIOReads CopyFile (i, _) = [i]
+  functionIOWrites CopyFile = extractSndTokenAsList
+  functionIOWritesAny 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
+
--- a/byg/src/Byg/Functions/Template.hs
+++ b/byg/src/Byg/Functions/Template.hs
@@ -0,0 +1,24 @@
+module Byg.Functions.Template
+  ( Template(..)
+  , makeTemplate
+  , applyTemplate
+  ) where
+
+import Byg.Types (Token)
+import Byg.DependencyGenerator (DepGenM, TokenableTo(..), onTupleToken)
+
+import Data.Text (Text)
+import qualified Data.Text as T
+
+data Template = TemplateParts Text Text
+  deriving (Eq, Show)
+
+makeTemplate :: (TokenableTo Text a, TokenableTo Text b) => a -> b -> DepGenM (Token Template)
+makeTemplate = onTupleToken $ \t c ->
+  let (beforeContent, after) = T.breakOn c t
+      afterContent = T.drop (T.length c) after
+  in TemplateParts beforeContent afterContent
+
+applyTemplate :: (TokenableTo Template a, TokenableTo Text b) => a -> b -> DepGenM (Token Text)
+applyTemplate = onTupleToken $ \(TemplateParts beforeContent afterContent) t ->
+  T.concat [beforeContent, t, afterContent]
--- a/byg/src/Byg/Functions/Text.hs
+++ b/byg/src/Byg/Functions/Text.hs
@@ -0,0 +1,33 @@
+module Byg.Functions.Text
+  ( readTextFile
+  , saveTextFile
+  ) where
+
+import Byg.Types (IsFunctionIO(..), Token(..))
+import Byg.DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken,
+                            runFunctionIO, runFunctionIO_)
+import Byg.DependencyRunner (extractSndTokenAsList)
+
+import Data.Text (Text)
+import qualified Data.Text.IO as T
+
+data ReadTextFile = ReadTextFile deriving Show
+instance IsFunctionIO ReadTextFile FilePath Text where
+  evalFunctionIO ReadTextFile s = T.readFile s
+  functionIOReads ReadTextFile s = [s]
+  functionIOWrites ReadTextFile  = const (ListToken [])
+  functionIOWritesAny 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
+  functionIOReads SaveTextFile = const []
+  functionIOWrites SaveTextFile = extractSndTokenAsList
+  functionIOWritesAny SaveTextFile = True
+
+saveTextFile :: (TokenableTo Text a, TokenableTo FilePath b) => a -> b -> DepGenM ()
+saveTextFile a b = runFunctionIO_ SaveTextFile =<< toTupleToken a b
--- a/byg/src/Byg/Types.hs
+++ b/byg/src/Byg/Types.hs
@@ -0,0 +1,13 @@
+module Byg.Types
+  ( module Byg.Types.Token
+  , module Byg.Types.Value
+  , module Byg.Types.Functions
+  , module Byg.Types.Date
+  , Dependency
+  ) where
+
+import Byg.Types.Token
+import Byg.Types.Value
+import Byg.Types.Functions
+import Byg.Types.Date
+import Byg.Types.Dependency (Dependency)
--- a/byg/src/Byg/Types/Date.hs
+++ b/byg/src/Byg/Types/Date.hs
@@ -0,0 +1,39 @@
+module Byg.Types.Date
+  ( Date(..)
+  , formatDate
+  , formatDateShort
+  ) where
+
+import Text.Printf (printf)
+import Data.Text (Text)
+import qualified Data.Text as T
+
+data Date = Date Int Int Int
+  deriving (Eq, Ord, Show)
+
+formatDate :: Date -> Text
+formatDate (Date year month day) =
+  T.concat [ "den "
+           , T.pack (show day)
+           , ". "
+           , months !! (month - 1)
+           , " "
+           , T.pack (show year)
+           ]
+  where months = [ "januar"
+                 , "februar"
+                 , "marts"
+                 , "april"
+                 , "maj"
+                 , "juni"
+                 , "juli"
+                 , "august"
+                 , "september"
+                 , "oktober"
+                 , "november"
+                 , "december"
+                 ]
+
+formatDateShort :: Date -> Text
+formatDateShort (Date year month day) =
+  T.concat [ T.pack (show year), "-", T.pack (printf "%02d" month), "-", T.pack (printf "%02d" day) ]
--- a/byg/src/Byg/Types/Dependency.hs
+++ b/byg/src/Byg/Types/Dependency.hs
@@ -0,0 +1,131 @@
+{-# LANGUAGE GADTs #-}
+module Byg.Types.Dependency
+  ( Action(..)
+  , F(..)
+  , Dependency(..)
+  , makeDependency
+  , actionSourceType
+  , actionTargetType
+  , actionReads
+  , actionWrites
+  , actionWritesAny
+  , formatDependencyTrees
+  ) where
+
+import Byg.Types.Token (Token(..))
+import Byg.Types.Functions (IsFunctionIO(..))
+
+import Type.Reflection (Typeable, TypeRep, typeRep)
+import Text.Printf (printf)
+import Data.Text (Text)
+import qualified Data.Text as T
+
+data Action a b where
+  Function :: (Typeable a, Typeable b, Show b) => F a b -> Action a b
+  FunctionIO :: IsFunctionIO f a b => f -> Action a b
+  Inject :: (Typeable a, Show a) => a -> Action () a
+  FilterComp :: (Typeable a, Show a) => Action ([a], [Bool]) [a]
+  UntupleFst :: (Typeable a, Show a, Typeable b, Show b) => Action (a, b) a
+  UntupleSnd :: (Typeable a, Show a, Typeable b, Show b) => Action (a, b) b
+  UnzipFst :: (Typeable a, Show a, Typeable b, Show b) => Action [(a, b)] [a]
+  UnzipSnd :: (Typeable a, Show a, Typeable b, Show b) => Action [(a, b)] [b]
+  MapComp :: (Typeable a, Show a, Typeable b, Show b) => [Dependency] -> Token a -> Token b -> Action [a] [b]
+
+deriving instance Show (Action a b)
+
+newtype F a b = F (a -> b)
+
+instance Show (F a b) where
+  show = const "<function>"
+
+data Dependency where
+  Dependency :: TypeRep a -> Token a -> Action a b -> TypeRep b -> Token b -> Dependency
+deriving instance Show Dependency
+
+makeDependency :: (Typeable a, Show a, Typeable b, Show b) => Token a -> Action a b -> Token b -> Dependency
+makeDependency a action b = Dependency typeRep a action typeRep b
+
+actionSourceType :: Typeable a => Action a b -> TypeRep a
+actionSourceType _ = typeRep
+
+actionTargetType :: Typeable b => Action a b -> TypeRep b
+actionTargetType _ = typeRep
+
+actionReads :: Action a b -> a -> [FilePath]
+actionReads = \case
+  FunctionIO f -> functionIOReads f
+  _ -> const []
+
+actionWrites :: Action a b -> Token a -> Token [FilePath]
+actionWrites = \case
+  FunctionIO f -> functionIOWrites f
+  _ -> const (ListToken [])
+
+actionWritesAny :: Action a b -> Bool
+actionWritesAny = \case
+  FunctionIO f -> functionIOWritesAny f
+  MapComp subDeps _ _ -> any dependencyWritesAny subDeps
+  _ -> False
+  where dependencyWritesAny :: Dependency -> Bool
+        dependencyWritesAny (Dependency _ _ action _ _) = actionWritesAny action
+
+formatDependencyTrees :: [Dependency] -> Text
+formatDependencyTrees = T.concat . (formatDependencyTrees' "")
+  where formatDependencyTrees' indentation = concatMap (formatDependencyTree indentation)
+
+        formatDependencyTree indentation (Dependency _ a action _ b) =
+          concat [ [ indentation ]
+                 , formatToken a
+                 , [ " -> " ]
+                 , formatToken b
+                 , [ ": " ]
+                 , formatAction indentation action
+                 ]
+
+        formatToken :: Token a -> [Text]
+        formatToken = \case
+          Token i ->
+            [ T.pack (printf "%03d" i) ]
+          TupleToken a b ->
+            concat [ [ "tup(" ]
+                   , formatToken a
+                   , [ ", " ]
+                   , formatToken b
+                   , [ ")" ]
+                   ]
+          ZipToken a b ->
+            concat [ [ "zip(" ]
+                   , formatToken a
+                   , [ ", " ]
+                   , formatToken b
+                   , [ ")" ]
+                   ]
+          ListToken ts ->
+            [ "["
+            , T.intercalate ", " (map (T.concat . formatToken) ts)
+            , "]"
+            ]
+          NoToken ->
+            [ "--" ]
+
+        formatAction :: forall a b. Text -> Action a b -> [Text]
+        formatAction indentation = \case
+          Function _ ->
+            [ "Function "
+            , T.pack (show (typeRep :: TypeRep a))
+            , " -> "
+            , T.pack (show (typeRep :: TypeRep b))
+            , "\n"
+            ]
+          MapComp subDeps innerInput innerOutput ->
+            concat [ [ "MapComp(" ]
+                   , formatToken innerInput
+                   , [ " -> " ]
+                   , formatToken innerOutput
+                   , [ "):\n" ]
+                   , formatDependencyTrees' (T.append indentation "|  ") subDeps
+                   ]
+          action ->
+            [ T.pack (show action)
+            , "\n"
+            ]
--- a/byg/src/Byg/Types/Functions.hs
+++ b/byg/src/Byg/Types/Functions.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE FunctionalDependencies #-}
+module Byg.Types.Functions
+  ( IsFunctionIO(..)
+  ) where
+
+import Byg.Types.Token (Token)
+
+import Type.Reflection (Typeable)
+
+class (Show f, Show a, Typeable a, Show b, Typeable b) => IsFunctionIO f a b | f -> a b where
+  evalFunctionIO :: f -> a -> IO b
+  functionIOReads :: f -> a -> [FilePath]
+  functionIOWritesAny :: f -> Bool
+  functionIOWrites :: f -> Token a -> Token [FilePath]
--- a/byg/src/Byg/Types/Token.hs
+++ b/byg/src/Byg/Types/Token.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE GADTs #-}
+module Byg.Types.Token
+  ( Token(..)
+  ) where
+
+import Type.Reflection (Typeable)
+
+data Token a where
+  Token :: (Typeable a, Show a) => Int -> Token a
+  TupleToken :: (Typeable a, Show a, Typeable b, Show b) => Token a -> Token b -> Token (a, b)
+  ZipToken :: (Typeable a, Show a, Typeable b, Show b) => Token [a] -> Token [b] -> Token [(a, b)]
+  ListToken :: (Typeable a, Show a) => [Token a] -> Token [a]
+  NoToken :: Token ()
+
+deriving instance Show (Token a)
--- a/byg/src/Byg/Types/Value.hs
+++ b/byg/src/Byg/Types/Value.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE MonoLocalBinds #-}
+module Byg.Types.Value
+  ( Value(..)
+  , toValue
+  , toValueRep
+  , fromValue
+  , fromValueRep
+  ) where
+
+import Type.Reflection (TypeRep, typeRep, eqTypeRep)
+import Data.Type.Equality ((:~~:)(HRefl))
+import Data.Dynamic
+
+data Value = Value { valueDynamic :: Dynamic
+                   , valueShow :: String
+                   }
+
+instance Show Value where
+  show = valueShow
+
+fromDynRep :: TypeRep a -> Dynamic -> a
+fromDynRep tr (Dynamic t v)
+  | Just HRefl <- t `eqTypeRep` tr = v
+  | otherwise = error ("unexpected; expected " ++ show tr ++ " but has " ++ show t)
+
+toValue :: (Show a, Typeable a) => a -> Value
+toValue = toValueRep typeRep
+
+toValueRep :: Show a => TypeRep a -> a -> Value
+toValueRep tr a = Value { valueDynamic = Dynamic tr a
+                        , valueShow = show a
+                        }
+
+fromValue :: Typeable a => Value -> a
+fromValue = fromValueRep typeRep
+
+fromValueRep :: TypeRep a -> Value -> a
+fromValueRep tr = fromDynRep tr . valueDynamic