foldl, foldrを元にした、蓄積変数付き、脱出可能なloop関数

BreakLoop.hs

-- 参考記事：https://mkotha.hatenadiary.org/entry/20110430/1304122048
module BreakLoop where

import Prelude hiding (take)


myLoop :: (accT -> a -> (accT -> b) -> b) -> (accT -> b) -> accT -> [a] -> b
myLoop _ g acc []     = g acc
myLoop f g acc (x:xs) = f acc x $ \acc' -> myLoop f g acc' xs


-- Prelude> foldl (-) 1 [2, 3, 4]
-- -8
test :: Int
test = myLoop f id 1 [2, 3, 4, 5, 6] -- = -8
  where
    f n x cont
      | n <= -5   = n
      | otherwise = cont (n - x)


take :: Int -> [a] -> [a]
take len = myLoop f g (len, [])
  where
    g = reverse . snd
    f n@(len, xs) x cont
      | len <= 0  = g n
      | otherwise = cont (len - 1, x : xs)

FoldCont.hs

-- 参考記事：https://blog.7nobo.me/2018/01/15/03-haskell-callcc.html
module FoldCont where

import Control.Monad.Trans.Cont (Cont, cont, runCont, callCC)
import Data.Foldable            (foldlM)
import Prelude                  hiding (take)


foldrCont :: (a -> b -> Cont r b) -> b -> [a] -> Cont r b
foldrCont _ acc []       = cont $ \ar -> ar acc
foldrCont f acc (x : xs) = f x acc >>= (\acc' -> foldrCont f acc' xs)

foldlCont :: (b -> a -> Cont r b) -> b -> [a] -> Cont r b
foldlCont = foldlM



-- *FoldCont> foldl (-) 1 [2, 3, 4]
-- -8
test :: Int
test = runCont (callCC $ \exit -> foldrCont (f exit) 1 [2..]) id -- = -8
  where
    f exit x n
      | n <= -5   = exit n
      | otherwise = return (n - x)

test2 :: Int
test2 = runCont (callCC $ \exit -> foldlCont (f exit) 1 [2..]) id -- = -8
  where
    f exit n x
      | n <= -5   = exit n
      | otherwise = return (n - x)


take :: Int -> [a] -> [a]
take l xs = runCont (callCC $ \exit -> foldlCont (f exit) (l, []) xs) (reverse . snd)
  where
    f exit n@(l', xs') x
      | l' <= 0   = exit n
      | otherwise = return (l' - 1, x : xs')