継続モナドについて

継続モナドについて勉強したこと、考えたことのまとめです。

#継続渡しスタイル(CPS)
例として階乗を求めるプログラムを通常の書き方とCPSで書いてみる。
**※コメントで指摘いただきましたがこの例はCPSになってませんでした。:skull:**

```haskell
-- 通常スタイル
fact :: (Eq a, Num a) => a -> a
fact 0 = 1
fact n = n * fact (n-1)

fact 3 == 3 * fact 2
       == 3 * 2 * fact 1
       == 3 * 2 * 1 * fact 0
       == 3 * 2 * 1 * 1

-- CPS
cFact :: (Eq a, Num a) => a -> (a -> r) -> r
cFact 0 f = f 1
cFact n f = f $ cFact (n-1) (n*)

cFact 3 id == cFact 2 (3*)
           == 3 * cFact 1 (2*)
           == 3 * 2 * cFact 0 (1*)
           == 3 * 2 * 1 * 1
```

#継続モナド
```haskell
newtype ContT r m a = ContT{runContT :: (a -> m r) -> m r}
type Cont r a = ContT r Identity a

instance Monad (ContT r m) where
  return a = ContT $ \k -> k a
  x >>= f  = ContT $ \k ->
    runContT x $ \a -> runContT (f a) k
```
地味に`m`をモナドに制限しなくても継続モナドのモナド変換子が定義できます。
最終継続`a -> m r`がモナド変換の役割をするので`ContT`自体のモナドの定義には`m`がモナドである必要がないのです。たぶん。
大抵`runContT`の最終継続には`return`を渡しますし。(=`evalContT`)

```haskell
instance MonadTrans (ContT r) where
  lift ma = ContT (ma>>=)
```
`lift`の定義をよくみるとわかるけど、そもそもバインド`(>>=)::m a -> (a -> m b) -> m b`が継続そのものなのです。

##使いみち１
なにかの処理の結果を受けてなにかする

```haskell
withBenchmark :: IO () -> (POSIXTime -> IO r) -> IO r
withBenchmark act fn = do
  t1 <- getPOSIXTime
  act
  t2 <- getPOSIXTime
  fn (t2 - t1)

main :: IO ()
main = evalContT $ do
  t1 <- ContT $ withBenchmark $
    print $ sum [1..10000]
  t2 <- ContT $ withBenchmark $
    print $ sum [1..1000000]
  liftIO $ print t1
  liftIO $ print t2

>>> main
50005000
500000500000
0.0330019s
0.3710212s
```

##使いみち２（リソース管理）
以下の記事がわかりやすくまとめてくれています。
[継続モナドによるリソース管理](https://qiita.com/tanakh/items/81fc1a0d9ae0af3865cb)



#callCC
callCCをつかうと継続の中断ができます。

```haskell
callCC :: ((a -> ContT r m b) -> ContT r m a) -> ContT r m a
callCC f = ContT $ \k ->
  let
    exit a = ContT $ \_ -> k a
  in
    runContT (f exit) k
```
callCCは処理を中断するための函数`exit`を提供します。
`exit`は以降の継続を破棄して最終継続まで脱出します。

```haskell:例1
fizzBuzzList :: ContT r [] String
fizzBuzzList = callCC $ \exit -> do
  i <- lift [1..100]
  when (i`mod`15==0) $ exit "FizzBuzz"
  when (i`mod`5==0) $ exit "Fizz"
  when (i`mod`3==0) $ exit "Buzz"
  return $ show i

>>> evalContT fizzBuzzList
["1","2","Buzz","4","Fizz","Buzz","7","8","Buzz","Fizz","11","Buzz","13","14","FizzBuzz","16","17","Buzz","19","Fizz","Buzz","22","23","Buzz","Fizz","26","Buzz","28","29","FizzBuzz","31","32","Buzz","34","Fizz","Buzz","37","38","Buzz","Fizz","41","Buzz","43","44","FizzBuzz","46","47","Buzz","49","Fizz","Buzz","52","53","Buzz","Fizz","56","Buzz","58","59","FizzBuzz","61","62","Buzz","64","Fizz","Buzz","67","68","Buzz","Fizz","71","Buzz","73","74","FizzBuzz","76","77","Buzz","79","Fizz","Buzz","82","83","Buzz","Fizz","86","Buzz","88","89","FizzBuzz","91","92","Buzz","94","Fizz","Buzz","97","98","Buzz","Fizz"]
```

２段階で脱出したりもできる

```haskell:例2
hoge :: ContT r [] (Int,Int)
hoge = callCC $ \exit1 -> do
  i <- lift [1..9]
  when (i>3) $ exit1 (0,0)
  j <- callCC $ \exit2 -> do
    j <- lift [1..9]
    when (j == 5) $ exit2 0
    when (j == 7) $ exit1 (-1,-1)
    return j
  return (i,j)

>>> evalContT hoge
[(1,1),(1,2),(1,3),(1,4),(1,0),(1,6),(-1,-1),(1,8),(1,9),(2,1),(2,2),(2,3),(2,4),(2,0),(2,6),(-1,-1),(2,8),(2,9),(3,1),(3,2),(3,3),(3,4),(3,0),(3,6),(-1,-1),(3,8),(3,9),(0,0),(0,0),(0,0),(0,0),(0,0),(0,0)]
```

#CPS版モナド
モナドはCPSで書き直すことができます。
CPSスタイルで書くと、もとの性質と継続モナドの性質を併せ持った形になるので結構嬉しいです。
CPS版のモナドの方がパフォーマンスもいいらしい（未検証）

```haskell:CPS版State
newtype CStateT r s m a = CStateT{runCStateT :: s -> ((a,s) -> m r) -> m r}

-- Monad
instance Functor (CStateT r s m) where
  fmap f x = CStateT $ \s k -> runCStateT x s $ \(a,s') -> k (f a,s')

instance Applicative (CStateT r s m) where
  pure a = CStateT $ \s k -> k (a,s)
  f <*> x = CStateT $ \s k ->
    runCStateT f s $ \(g,s') ->
    runCStateT x s' $ \(a,s'') -> k (g a,s'')

instance Monad (CStateT r s m) where
  x >>= f = CStateT $ \s k ->
    runCStateT x s $ \(a,s') ->
    runCStateT (f a) s' k

-- StateT
type StateT s m a = CStateT (a,s) s m a
stateT :: Monad m => (s -> m (a,s)) -> StateT s m a
stateT f = CStateT $ \s k -> f s >>= k

runStateT :: Monad m => StateT s m a -> s -> m (a,s)
runStateT x s = runCStateT x s return

get :: CStateT r s m s
get = CStateT $ \s k -> k (s,s)

put :: s -> CStateT r s m ()
put s = CStateT $ \_ k -> k ((),s)

-- callCC
callCC :: ((a -> CStateT r s m b) -> CStateT r s m a) -> CStateT r s m a
callCC f = CStateT $ \s k ->
  let
    exit a = CStateT $ \_ _ -> k (a,s)
  in
    runCStateT (f exit) s k
```
```haskell:CPS版List
newtype CListT r m a = CListT{runCListT :: ([a]->m r)->m r}

instance Functor (CListT r m) where
  fmap f x = CListT $ \k ->
    runCListT x $ \as -> k (fmap f as)

instance Applicative (CListT r m) where
  pure a = CListT $ \k -> k [a]
  f <*> x = CListT $ \k ->
    runCListT f $ \fs ->
    runCListT x $ \as -> k (fs <*> as)

instance Monad (CListT r m) where
  x >>= f = CListT $ \k ->
    let
      fn [] = k
      fn (a:as) = \bs ->
        runCListT (f a) $ \bs' -> fn as (bs ++ bs')
    in
      runCListT x $ \as -> fn as []

callCC :: ((a -> CListT r m b) -> CListT r m a) -> CListT r m a
callCC f = CListT $ \k ->
  let
    exit a = CListT $ \_ -> k [a]
  in
    runCListT (f exit) k
```

#shift/rest（限定継続）
```haskell
-- fに以降の継続を渡す。
shiftT :: Monad m => ((a -> m r) -> ContT r m r) -> ContT r m a
shiftT f = ContT $ \k -> evalContT (f k)

-- xの継続を一旦終了して、結果を次の継続に渡す。
resetT :: Monad m => ContT r m r -> ContT r' m r
resetT x = ContT $ \k -> evalContT x >>= k
```
##`reset`は継続の範囲を限定する
例１では、ハンドラは最後の処理が終わるまで閉じられない

```haskell:例１
ex1 :: ContT r IO ()
ex1 = do
  rh <- ContT $ withFile "hoge.txt" ReadMode
  contents <- liftIO $ hGetContents rh
  wh <- ContT $ withFile "fuga.txt" WriteMode
  liftIO $ hPutStr wh contents
  liftIO $ putStrLn "Hello,World!"
  -- ※whはここで閉じる
  -- ※rhはここで閉じる
```
---
例２では`resetT`を使って、ハンドラの継続を限定することで、必要な処理が終わったらすぐにハンドラを閉じることができる。

```haskell:例２
ex2 :: ContT r IO ()
ex2 = do
  contents <- resetT $ do
    rh <- ContT $ withFile "hoge.txt" ReadMode
    liftIO $ hGetContents rh
    -- ※rhはここで閉じる
  resetT $ do
    wh <- ContT $ withFile "fuga.txt" WriteMode
    liftIO $ hPutStr wh contents
    -- ※whはここで閉じる
  liftIO $ putStrLn "Hello,World!"
```
※例２は実際には遅延評価のせいでうまく動作しない。
`Control.DeepSeq`を使うなどして正格評価されるようにしてやる必要がある。
参考：[What caused this “delayed read on closed handle” error?](https://stackoverflow.com/questions/26949378/what-caused-this-delayed-read-on-closed-handle-error)


```haskell:例２'
ex2 :: ContT r IO ()
ex2 = do
  contents <- resetT $ do
    rh <- ContT $ withFile "hoge.txt" ReadMode
    contents <- liftIO $ hGetContents rh
    return $!! contents
    -- ※rhはここで閉じる
  resetT $ do
    wh <- ContT $ withFile "fuga.txt" WriteMode
    liftIO $ hPutStr wh contents
    -- ※whはここで閉じる
  liftIO $ putStrLn "Hello,World!"
```

## shiftは継続を取り出す
```haskell
sh1 :: ContT r [] (Integer, Integer)
sh1 = do
  i <- lift [1..3]
  x <- shiftT $ \k -> lift $ k 5 ++ k 6
  return (i,x)

>>>evalContT sh1
[(1,5),(1,6),(2,5),(2,6),(3,5),(3,6)]
```

継続モナドが絡むとわかりにくいですが、上記のコードは以下と同じです。

```haskell
sh1' :: ((Integer, Integer)->[r]) -> [r]
sh1' g = [1..3] >>= f1 where
  f1 i = k 5 ++ k 6 where
    k x = g (i,x)

>>>evalContT sh1'
[(1,5),(1,6),(2,5),(2,6),(3,5),(3,6)]
```

`shift`を使って継続を破棄してやれば、`callCC`と同じことができます。

```haskell
fizzBuzzList :: ContT String [] String
fizzBuzzList = do
  i <- lift [1..100]
  when (i`mod`15==0) $ shiftT $ \_ -> return "FizzBuzz"
  when (i`mod`5==0) $ shiftT $ \_ -> return "Fizz"
  when (i`mod`3==0) $ shiftT $ \_ -> return "Buzz"
  return $ show i
```

ただし、`callCC`の脱出函数は`a -> ContT r m b`なので`a`を渡すのに対して`shiftT`は`ContT r m r`をかえしてあげる必要があります。
その点で利用できなかったり、つかいにくい場面があります。

#おわりに
継続モナドについて学んでみて、リソース管理と脱出への利用が便利だと思いました。
あと、コールバック地獄がdo記法でスッキリかけるのようになるのは便利。

`shift/reset`についてはまだまだ理解の及ばないところが多いです。
`reset`についてはリソース管理と合わせると使いみちが思いつくんですけど、`shift`については`callCC`のかわりに継続破棄する以外の実用的な利用方法があまり思いつきません。
[shift/reset プログラミング入門](http://pllab.is.ocha.ac.jp/~asai/cw2011tutorial/main-j.pdf)に色々なことが解説されているんですけど、Haskellで定義されてる形の`shift/reset`だと継続の取り出しとか継続の保存がうまく定義できない気がしてます。
詳しい人いたら教えてください。