{-# 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:
Post a Comment