https://scrapbox.io/mrsekut-p/FreeモナドでDSLを作って%E3%80%81後から実装を変える例

DSL_with_Free_Monad.hs

#! /usr/bin/env nix-shell
#! nix-shell -p "pkgs.haskell.packages.ghc925.ghcWithPackages (p: [p.free])"
#! nix-shell -i "runhaskell"

import           Control.Monad.Free (Free (..), liftF)


-- DSLのInterfaceを定義
data CalcF a
  = Add Int a
  | Sub Int a
  | Mul Int a
  | Div Int a
  deriving (Functor)

-- Freeモナドを作成
type Calc a = Free CalcF a


-- ヘルパー関数の容易
add, sub, mul, div' :: Int -> Calc ()
add  x = liftF (Add x ())
sub  x = liftF (Sub x ())
mul  x = liftF (Mul x ())
div' x = liftF (Div x ())


-- DSLを使ってコードを書く
program :: Calc ()
program = do
  add 10
  sub 5
  mul 2
  div' 2



-- 実装1: 四則演算の結果をIntで返す
interpret :: Calc a -> Int -> Int
interpret (Free (Add x next)) state = interpret next (state + x)
interpret (Free (Sub x next)) state = interpret next (state - x)
interpret (Free (Mul x next)) state = interpret next (state * x)
interpret (Free (Div x next)) state = interpret next (state `div` x)
interpret (Pure _) state            = state


-- 実装2: 四則演算の結果をStringで返す
interpretString :: Calc a -> Int -> String
interpretString (Free (Add x next)) state = interpretString next (state + x)
interpretString (Free (Sub x next)) state = interpretString next (state - x)
interpretString (Free (Mul x next)) state = interpretString next (state * x)
interpretString (Free (Div x next)) state = interpretString next (state `div` x)
interpretString (Pure _) state            = show state



-- 実行
main :: IO ()
main = do
  print $ interpret program 0       -- 5
  print $ interpretString program 0 -- "5"