-- |
-- Module      : Streamly.Internal.Data.Cont
-- Copyright   : (c) 2020 Composewell Technologies
-- License     : BSD-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- Continuation style utilities.
--
module Streamly.Internal.Data.Cont
    ( contListMap
    )
where

import Control.Monad.Cont (runCont, cont)

-- | Given a continuation based transformation from @a@ to @b@ and a
-- continuation based transformation from @[b]@ to @c@, make continuation based
-- transformation from @[a]@ to @c@.
--
-- /Pre-release/

-- You can read the definition as:
--
-- > contListMap f g = \xs final ->
--
contListMap ::
       (a -> (b -> r) -> r)      -- transform a -> b
    -> ([b] -> (c -> r) -> r)    -- transform [b] -> c
    -> ([a] -> (c -> r) -> r)    -- transform [a] -> c
contListMap :: forall a b r c.
(a -> (b -> r) -> r)
-> ([b] -> (c -> r) -> r) -> [a] -> (c -> r) -> r
contListMap a -> (b -> r) -> r
f [b] -> (c -> r) -> r
g [a]
xs c -> r
final =
    let bconts :: [Cont r b]
bconts = (a -> Cont r b) -> [a] -> [Cont r b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((b -> r) -> r) -> Cont r b
forall a r. ((a -> r) -> r) -> Cont r a
cont (((b -> r) -> r) -> Cont r b)
-> (a -> (b -> r) -> r) -> a -> Cont r b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (b -> r) -> r
f) [a]
xs  -- [Cont b]
        blistCont :: ContT r Identity [b]
blistCont = [Cont r b] -> ContT r Identity [b]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Cont r b]
bconts  -- Cont [b]
        k :: [b] -> r
k [b]
ys = [b] -> (c -> r) -> r
g [b]
ys c -> r
final            -- [b] -> r
     in ContT r Identity [b] -> ([b] -> r) -> r
forall r a. Cont r a -> (a -> r) -> r
runCont ContT r Identity [b]
blistCont [b] -> r
k          -- r