ApplicativeDo拡張を試す

ApplicativeDoの動作を実際に動かして見てみたいと思いました。

解説は以下などで行われています。
どのようにdesugarされるかもわかります。

<*>と>>=で挙動が違う適当な型を用意して、

{-# LANGUAGE ApplicativeDo #-}

import           Control.Monad

newtype Branch a = Branch { runBranch :: (a, [[String]]) }  
  deriving (Show)
instance Functor Branch where  
  fmap = liftM

instance Applicative Branch where  
  pure = return
  Branch (f, x:v) <*> Branch (y, x':v') =
    Branch (f y, ((x ++ x'):v') ++ v)

instance Monad Branch where  
    return x = Branch (x, mempty)
    (Branch (x,v)) >>= f =
      let (Branch (y, v')) = f x
      in Branch (y, v ++ v')

runBranch' = snd . runBranch

num x = do  
  Branch (x, [[show x]])
  pure x

サンプルにあるパターンを実行してみる。

-- [["5","6"]]
f1 = runBranch' $ do  
  x <- num 5
  y <- num 6
  pure $ x+y

拡張を切れば [["5"], ["6"]] となる

全部試す。

-- [["1","2"],["3"]]
f2 = runBranch' $ do  
  x <- num 1
  y <- num 2
  num (x + y)

-- [["5","6"],["15","16"]]
f3 = runBranch' $ do  
  x <- num 5
  x' <- num 6
  y <- num (x+10)
  y' <- num (x'+10)
  pure $ x+y+x'+y'

-- [["5","7"],["6"]]
f4 = runBranch' $ do  
  x <- num 5
  y <- num (x+1)
  z <- num 7
  pure $ x+y+z

-- [["5","6","7"],["105"]]
f5 = runBranch' $ do  
  x <- num 5
  x' <- num 6
  y <- num (x+100)
  x'' <- num 7
  pure $ x'+x''+y

すごい!完