Saturday, December 22, 2018

CommandBuilder-Monad as EDSL (sort of WriterMonad)


{-# LANGUAGE OverloadedStrings #-}
module Main where

import Control.Applicative
import Control.Monad
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.List as L

main :: IO ()
main = do
  putStrLn "build actions"
  let actions = do
        fooAction
        barAction "aaa"
        barAction "bbb"
        do
          fooAction
          barAction "ccc"
          barAction "ddd"
        fooAction
        barAction "eee"
        barAction "fff"
  putStrLn "execute actions"                                                                                                 
  let results = execute actions
  forM_ results T.putStrLn

fooAction :: Builder
fooAction = build $ Action "foo action"

barAction :: Text -> Builder
barAction text = build $ Action $ T.concat ["bar action (", text, ")"]                                                       


build :: Action -> Builder
build action = BuilderM () [action]

execute :: Builder -> [Text]
execute (BuilderM _ actions) = L.map actionText actions

actionText :: Action -> Text
actionText (Action text) = text

data Action = Action Text
  deriving Show

data BuilderM a = BuilderM a [Action]
  deriving Show

type Builder = BuilderM ()

instance Functor BuilderM where
  fmap = liftM

instance Applicative BuilderM where
  pure  = return
  (<*>) = ap

instance Monad BuilderM where
  return a            = BuilderM a []
  BuilderM a xs >>= f = let BuilderM b ys = f a
                        in  BuilderM b (xs++ys)


$ stack build && stack exec ...                                                       
build actions
execute actions
foo action
bar action (aaa)
bar action (bbb)
foo action
bar action (ccc)
bar action (ddd)
foo action
bar action (eee)
bar action (fff)

No comments: