{-|

Module      : TermFold
Description : Explorer Early Termination with Folds
Copyright   : © Frank Jung, 2020
License     : GPL-3

This module explores different techniques for folding over a list with
the ability to terminate early. It serves as a practical example of
control flow patterns in Haskell, including strict folds,
continuation-passing style (CPS), and monadic control flow with `Either`.

This module focuses on the foundational concept of using a monad (`Either`)
for short-circuiting.

Code based on
<https://www.fpcomplete.com/haskell/tutorial/monad-transformers/ FPComplete Folds with early termination>

The functions are defined to sum a list of integers, stopping
when a negative value is encountered.

  (1) `sumTillNegative`: A baseline implementation using `sum` and `takeWhile`.
  2. `sumTillNegative'`: A strict, tail-recursive version.
  3. `sumTillNegative''`: An implementation using `foldr` with continuation-passing style.
  4. `sumTillNegative'''`: Uses a generic `_foldTerminate` helper that employs the `Either` monad for early exit.
-}

{-# LANGUAGE BangPatterns #-}

module TermFold ( sumTillNegative     -- | baseline implementation using `sum` and `takeWhile`
                , sumTillNegative'    -- | strict, tail-recursive version
                , sumTillNegative''   -- | continuation-passing style with `foldr`
                , sumTillNegative'''  -- | uses `Either` for early exit
                ) where

-- | Basic implementation.
sumTillNegative :: [Int] -> Int
sumTillNegative :: [Int] -> Int
sumTillNegative = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> ([Int] -> [Int]) -> [Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0)

-- | Fold strict sum with early termination.
--
-- This function:
--  * uses a strict accumulator (`total`) for efficiency
--  * recursively adds values until a negative is found or the list ends
--  * returns the sum up to (but not including) the first negative
sumTillNegative' :: [Int] -> Int
sumTillNegative' :: [Int] -> Int
sumTillNegative' = Int -> [Int] -> Int
forall {t}. (Ord t, Num t) => t -> [t] -> t
go Int
0
  where
    go :: t -> [t] -> t
go !t
total [t]
rest =
      case [t]
rest of
        [] -> t
total
        t
x:[t]
xs
          | t
x t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
0     -> t
total
          | Bool
otherwise -> t -> [t] -> t
go (t
total t -> t -> t
forall a. Num a => a -> a -> a
+ t
x) [t]
xs

-- | Using foldr with continuation passing style.
-- This approach leverages Haskell's laziness by using continuations to
-- short-circuit computation when encountering a negative value.
--
-- This function:
--  * Single-pass processing
--  * Clean, declarative style
--  * Explicit control over strictness
sumTillNegative'' :: [Int] -> Int
sumTillNegative'' :: [Int] -> Int
sumTillNegative'' [Int]
xs = (Int -> (Int -> Int) -> Int -> Int)
-> (Int -> Int) -> [Int] -> Int -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> (Int -> Int) -> Int -> Int
forall {t}. (Ord t, Num t) => t -> (t -> t) -> t -> t
step Int -> Int
forall a. a -> a
id [Int]
xs Int
0
  where
    step :: t -> (t -> t) -> t -> t
step t
x t -> t
cont t
acc
      | t
x t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
0     = t
acc  -- Early termination
      | Bool
otherwise = t -> t
cont (t
acc t -> t -> t
forall a. Num a => a -> a -> a
+ t
x)

-- | Returns either the total (left value)
-- or the current accumulation and the rest of the list.
-- The left value will terminate the loop.
-- See also
-- <https://hackage.haskell.org/package/base/docs/Prelude.html#v:either either>
sumTillNegative''' :: [Int] -> Int
sumTillNegative''' :: [Int] -> Int
sumTillNegative''' = (Int -> Int -> Either Int Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> Either b b) -> b -> [a] -> b
_foldTerminate Int -> Int -> Either Int Int
forall {b}. (Ord b, Num b) => b -> b -> Either b b
go Int
0
  where
    go :: b -> b -> Either b b
go !b
total b
x
      | b
x b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
0     = b -> Either b b
forall a b. a -> Either a b
Left b
total
      | Bool
otherwise = b -> Either b b
forall a b. b -> Either a b
Right (b
total b -> b -> b
forall a. Num a => a -> a -> a
+ b
x)

-- Returns either the total (left value) or the current accumulation and the
-- rest of the list.
--
-- This function:
--  * generalizes fold that can terminate early
--  * the folding function returns Left to terminate, or Right to continue.
--  * returns the accumulated value when terminated.
-- See also
-- <https://hackage.haskell.org/package/base/docs/Prelude.html#v:either either>
_foldTerminate :: (b -> a -> Either b b) -> b -> [a] -> b
_foldTerminate :: forall b a. (b -> a -> Either b b) -> b -> [a] -> b
_foldTerminate b -> a -> Either b b
f b
accum0 [a]
list0 = (b -> b) -> (b -> b) -> Either b b -> b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> b
forall a. a -> a
id b -> b
forall a. a -> a
id (b -> [a] -> Either b b
forall {b}. b -> [a] -> Either b b
go b
accum0 [a]
list0)
  where
    go :: b -> [a] -> Either b b
go !b
accum [a]
rest = do
      (a
x, [a]
xs) <- case [a]
rest of
                    []   -> b -> Either b (a, [a])
forall a b. a -> Either a b
Left b
accum      -- termination
                    a
x:[a]
xs -> (a, [a]) -> Either b (a, [a])
forall a b. b -> Either a b
Right (a
x, [a]
xs)   -- keep going
      b
accum' <- b -> a -> Either b b
f b
accum a
x
      b -> [a] -> Either b b
go b
accum' [a]
xs