{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{- |
Module      : Primus.AsMaybe
Description : methods with termination
Copyright   : (c) Grant Weyburne, 2022
License     : BSD-3
-}
module Primus.AsMaybe (
  -- * AsMaybe
  AsMaybe (..),
  iterateT1,
  unfoldrT,
  pairsT,

  -- * ApThese
  ApThese (..),
  toTheseT,
  toTheseTS,
  partitionEithersT,
  partitionTheseT,
  filterT,
  spanT,
  spanTAlt,
  spanTS,
  takeWhileT,
  takeWhileTS,

  -- * ApTheseF for use with 'Primus.LRHist.LRHist'
  ApTheseF (..),
) where

import Control.Arrow
import Data.Bool
import Data.Functor.Identity
import qualified Data.List as L
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.Semigroup as SG
import Data.These
import Data.These.Combinators
import Primus.Error ((.@))

-- | converts to a 'Maybe' for failure types
class AsMaybe x b | x -> b where
  toMaybe :: x -> Maybe b

instance (b ~ b1) => AsMaybe (These e b) b1 where
  toMaybe :: These e b -> Maybe b1
toMaybe = (e -> Maybe b1)
-> (b1 -> Maybe b1)
-> (e -> b1 -> Maybe b1)
-> These e b1
-> Maybe b1
forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these (Maybe b1 -> e -> Maybe b1
forall a b. a -> b -> a
const Maybe b1
forall a. Maybe a
Nothing) b1 -> Maybe b1
forall a. a -> Maybe a
Just ((b1 -> Maybe b1) -> e -> b1 -> Maybe b1
forall a b. a -> b -> a
const b1 -> Maybe b1
forall a. a -> Maybe a
Just)
instance (b ~ b1) => AsMaybe (Either e b) b1 where
  toMaybe :: Either e b -> Maybe b1
toMaybe = (e -> Maybe b1) -> (b1 -> Maybe b1) -> Either e b1 -> Maybe b1
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe b1 -> e -> Maybe b1
forall a b. a -> b -> a
const Maybe b1
forall a. Maybe a
Nothing) b1 -> Maybe b1
forall a. a -> Maybe a
Just
instance (b ~ b1) => AsMaybe (Maybe b) b1 where
  toMaybe :: Maybe b -> Maybe b1
toMaybe = Maybe b -> Maybe b1
forall a. a -> a
id
instance (b1 ~ [b]) => AsMaybe [b] b1 where
  toMaybe :: [b] -> Maybe b1
toMaybe = \case
    [] -> Maybe b1
forall a. Maybe a
Nothing
    as :: [b]
as@(b
_ : [b]
_) -> [b] -> Maybe [b]
forall a. a -> Maybe a
Just [b]
as
instance (z ~ SG.Arg b1 y, AsMaybe x b1) => AsMaybe (SG.Arg x y) z where
  toMaybe :: Arg x y -> Maybe z
toMaybe (SG.Arg x
x y
y) = (b1 -> y -> Arg b1 y
forall a b. a -> b -> Arg a b
`SG.Arg` y
y) (b1 -> Arg b1 y) -> Maybe b1 -> Maybe (Arg b1 y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> x -> Maybe b1
forall x b. AsMaybe x b => x -> Maybe b
toMaybe x
x
instance (b ~ (b1, b2), AsMaybe x b1, AsMaybe y b2) => AsMaybe (x, y) b where
  toMaybe :: (x, y) -> Maybe b
toMaybe (x
x, y
y) = (,) (b1 -> b2 -> (b1, b2)) -> Maybe b1 -> Maybe (b2 -> (b1, b2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> x -> Maybe b1
forall x b. AsMaybe x b => x -> Maybe b
toMaybe x
x Maybe (b2 -> (b1, b2)) -> Maybe b2 -> Maybe (b1, b2)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> y -> Maybe b2
forall x b. AsMaybe x b => x -> Maybe b
toMaybe y
y
instance (b ~ (b1, b2, b3), AsMaybe x b1, AsMaybe y b2, AsMaybe z b3) => AsMaybe (x, y, z) b where
  toMaybe :: (x, y, z) -> Maybe b
toMaybe (x
x, y
y, z
z) = (,,) (b1 -> b2 -> b3 -> (b1, b2, b3))
-> Maybe b1 -> Maybe (b2 -> b3 -> (b1, b2, b3))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> x -> Maybe b1
forall x b. AsMaybe x b => x -> Maybe b
toMaybe x
x Maybe (b2 -> b3 -> (b1, b2, b3))
-> Maybe b2 -> Maybe (b3 -> (b1, b2, b3))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> y -> Maybe b2
forall x b. AsMaybe x b => x -> Maybe b
toMaybe y
y Maybe (b3 -> (b1, b2, b3)) -> Maybe b3 -> Maybe (b1, b2, b3)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> z -> Maybe b3
forall x b. AsMaybe x b => x -> Maybe b
toMaybe z
z

instance AsMaybe x z => AsMaybe (Identity x) z where
  toMaybe :: Identity x -> Maybe z
toMaybe (Identity x
x) = x -> Maybe z
forall x b. AsMaybe x b => x -> Maybe b
toMaybe x
x

-- supports Bool instance so partition can work the same as base [not a requirement but..]

-- | flexible "e" to use with eg 'partitionTheseT': Bool is also valid
class ApThese e a x b | x e a -> b where
  apThese :: a -> x -> These e b

instance (e ~ e1, b ~ b1) => ApThese e1 a (These e b) b1 where
  apThese :: a -> These e b -> These e1 b1
apThese a
_ = These e b -> These e1 b1
forall a. a -> a
id
instance (e ~ e1, b ~ b1) => ApThese e1 a (Either e b) b1 where
  apThese :: a -> Either e b -> These e1 b1
apThese a
_ = (e1 -> These e1 b1)
-> (b1 -> These e1 b1) -> Either e1 b1 -> These e1 b1
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e1 -> These e1 b1
forall a b. a -> These a b
This b1 -> These e1 b1
forall a b. b -> These a b
That
instance (e ~ a, b ~ b1) => ApThese e a (Maybe b) b1 where
  apThese :: a -> Maybe b -> These e b1
apThese a
a = These a b1 -> (b1 -> These a b1) -> Maybe b1 -> These a b1
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> These a b1
forall a b. a -> These a b
This a
a) b1 -> These a b1
forall a b. b -> These a b
That
instance (e ~ a, b ~ a) => ApThese e a Bool b where
  apThese :: a -> Bool -> These e b
apThese a
a = These a a -> These a a -> Bool -> These a a
forall a. a -> a -> Bool -> a
bool (a -> These a a
forall a b. a -> These a b
This a
a) (a -> These a a
forall a b. b -> These a b
That a
a)
instance (e ~ a, b1 ~ [b]) => ApThese e a [b] b1 where
  apThese :: a -> [b] -> These e b1
apThese a
a = \case
    [] -> a -> These a b1
forall a b. a -> These a b
This a
a
    as :: [b]
as@(b
_ : [b]
_) -> [b] -> These e [b]
forall a b. b -> These a b
That [b]
as

instance (z ~ SG.Arg b1 y, ApThese e a x b1) => ApThese e a (SG.Arg x y) z where
  apThese :: a -> Arg x y -> These e z
apThese a
a (SG.Arg x
x y
y) = (b1 -> y -> Arg b1 y
forall a b. a -> b -> Arg a b
`SG.Arg` y
y) (b1 -> Arg b1 y) -> These e b1 -> These e (Arg b1 y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> x -> These e b1
forall e a x b. ApThese e a x b => a -> x -> These e b
apThese a
a x
x
instance (Semigroup e, b ~ (b1, b2), ApThese e a x b1, ApThese e a y b2) => ApThese e a (x, y) b where
  apThese :: a -> (x, y) -> These e b
apThese a
a (x
x, y
y) = (,) (b1 -> b2 -> (b1, b2)) -> These e b1 -> These e (b2 -> (b1, b2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> x -> These e b1
forall e a x b. ApThese e a x b => a -> x -> These e b
apThese a
a x
x These e (b2 -> (b1, b2)) -> These e b2 -> These e (b1, b2)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> y -> These e b2
forall e a x b. ApThese e a x b => a -> x -> These e b
apThese a
a y
y
instance (Semigroup e, b ~ (b1, b2, b3), ApThese e a x b1, ApThese e a y b2, ApThese e a z b3) => ApThese e a (x, y, z) b where
  apThese :: a -> (x, y, z) -> These e b
apThese a
a (x
x, y
y, z
z) = (,,) (b1 -> b2 -> b3 -> (b1, b2, b3))
-> These e b1 -> These e (b2 -> b3 -> (b1, b2, b3))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> x -> These e b1
forall e a x b. ApThese e a x b => a -> x -> These e b
apThese a
a x
x These e (b2 -> b3 -> (b1, b2, b3))
-> These e b2 -> These e (b3 -> (b1, b2, b3))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> y -> These e b2
forall e a x b. ApThese e a x b => a -> x -> These e b
apThese a
a y
y These e (b3 -> (b1, b2, b3)) -> These e b3 -> These e (b1, b2, b3)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> z -> These e b3
forall e a x b. ApThese e a x b => a -> x -> These e b
apThese a
a z
z

instance ApThese e a x z => ApThese e a (Identity x) z where
  apThese :: a -> Identity x -> These e z
apThese a
a (Identity x
x) = a -> x -> These e z
forall e a x b. ApThese e a x b => a -> x -> These e b
apThese a
a x
x

-- for LRHist "e" is fixed
-- supports Bool instance for use with LRHist [this is a requirement]

-- | for use with 'Primus.LRHist.LRHist' using a fixed "e"
class ApTheseF e a x b | x e a -> b where
  apTheseF :: a -> x -> These e b

instance (e ~ e1, b ~ b1) => ApTheseF e1 a (These e b) b1 where
  apTheseF :: a -> These e b -> These e1 b1
apTheseF a
_ = These e b -> These e1 b1
forall a. a -> a
id
instance (e ~ e1, b ~ b1) => ApTheseF e1 a (Either e b) b1 where
  apTheseF :: a -> Either e b -> These e1 b1
apTheseF a
_ = (e1 -> These e1 b1)
-> (b1 -> These e1 b1) -> Either e1 b1 -> These e1 b1
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e1 -> These e1 b1
forall a b. a -> These a b
This b1 -> These e1 b1
forall a b. b -> These a b
That
instance (Monoid e, b ~ b1) => ApTheseF e a (Maybe b) b1 where
  apTheseF :: a -> Maybe b -> These e b1
apTheseF a
_ = These e b1 -> (b1 -> These e b1) -> Maybe b1 -> These e b1
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> These e b1
forall a b. a -> These a b
This e
forall a. Monoid a => a
mempty) b1 -> These e b1
forall a b. b -> These a b
That
instance (Monoid e, b ~ a) => ApTheseF e a Bool b where
  apTheseF :: a -> Bool -> These e b
apTheseF a
a = These e a -> These e a -> Bool -> These e a
forall a. a -> a -> Bool -> a
bool (e -> These e a
forall a b. a -> These a b
This e
forall a. Monoid a => a
mempty) (a -> These e a
forall a b. b -> These a b
That a
a)
instance (Monoid e, b1 ~ [b]) => ApTheseF e a [b] b1 where
  apTheseF :: a -> [b] -> These e b1
apTheseF a
_ = \case
    [] -> e -> These e b1
forall a b. a -> These a b
This e
forall a. Monoid a => a
mempty
    as :: [b]
as@(b
_ : [b]
_) -> [b] -> These e [b]
forall a b. b -> These a b
That [b]
as

instance (z ~ SG.Arg b1 y, ApTheseF e a x b1) => ApTheseF e a (SG.Arg x y) z where
  apTheseF :: a -> Arg x y -> These e z
apTheseF a
a (SG.Arg x
x y
y) = (b1 -> y -> Arg b1 y
forall a b. a -> b -> Arg a b
`SG.Arg` y
y) (b1 -> Arg b1 y) -> These e b1 -> These e (Arg b1 y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> x -> These e b1
forall e a x b. ApTheseF e a x b => a -> x -> These e b
apTheseF a
a x
x
instance (Semigroup e, b ~ (b1, b2), ApTheseF e a x b1, ApTheseF e a y b2) => ApTheseF e a (x, y) b where
  apTheseF :: a -> (x, y) -> These e b
apTheseF a
a (x
x, y
y) = (,) (b1 -> b2 -> (b1, b2)) -> These e b1 -> These e (b2 -> (b1, b2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> x -> These e b1
forall e a x b. ApTheseF e a x b => a -> x -> These e b
apTheseF a
a x
x These e (b2 -> (b1, b2)) -> These e b2 -> These e (b1, b2)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> y -> These e b2
forall e a x b. ApTheseF e a x b => a -> x -> These e b
apTheseF a
a y
y
instance (Semigroup e, b ~ (b1, b2, b3), ApTheseF e a x b1, ApTheseF e a y b2, ApTheseF e a z b3) => ApTheseF e a (x, y, z) b where
  apTheseF :: a -> (x, y, z) -> These e b
apTheseF a
a (x
x, y
y, z
z) = (,,) (b1 -> b2 -> b3 -> (b1, b2, b3))
-> These e b1 -> These e (b2 -> b3 -> (b1, b2, b3))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> x -> These e b1
forall e a x b. ApTheseF e a x b => a -> x -> These e b
apTheseF a
a x
x These e (b2 -> b3 -> (b1, b2, b3))
-> These e b2 -> These e (b3 -> (b1, b2, b3))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> y -> These e b2
forall e a x b. ApTheseF e a x b => a -> x -> These e b
apTheseF a
a y
y These e (b3 -> (b1, b2, b3)) -> These e b3 -> These e (b1, b2, b3)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> z -> These e b3
forall e a x b. ApTheseF e a x b => a -> x -> These e b
apTheseF a
a z
z

instance ApTheseF e a x z => ApTheseF e a (Identity x) z where
  apTheseF :: a -> Identity x -> These e z
apTheseF a
a (Identity x
x) = a -> x -> These e z
forall e a x b. ApTheseF e a x b => a -> x -> These e b
apTheseF a
a x
x

-- | similar to 'Data.List.NonEmpty.iterate' but terminate using 'AsMaybe'
iterateT1 ::
  AsMaybe x a =>
  (a -> x) ->
  a ->
  NonEmpty a
iterateT1 :: (a -> x) -> a -> NonEmpty a
iterateT1 a -> x
f a
a0 = a
a0 a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| a -> [a]
go a
a0
 where
  go :: a -> [a]
go a
a = case x -> Maybe a
forall x b. AsMaybe x b => x -> Maybe b
toMaybe (a -> x
f a
a) of
    Maybe a
Nothing -> []
    Just a
x -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a]
go a
x

{- | like 'Data.List.unfoldr' but terminate using 'AsMaybe'

@
>>> unfoldrT (splitAt 2) [1..8]
[[1,2],[3,4],[5,6],[7,8]]

vs

>>> unfoldr (\s -> if null s then Nothing else Just (splitAt 2 s)) [1..8]
[[1,2],[3,4],[5,6],[7,8]]
@
-}
unfoldrT ::
  AsMaybe t t =>
  (t -> (a, t)) ->
  t ->
  [a]
unfoldrT :: (t -> (a, t)) -> t -> [a]
unfoldrT t -> (a, t)
f t
s0 =
  case t -> Maybe t
forall x b. AsMaybe x b => x -> Maybe b
toMaybe t
s0 of
    Maybe t
Nothing -> []
    Just t
s1 ->
      let (a
a, t
s2) = t -> (a, t)
f t
s1
       in a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (t -> (a, t)) -> t -> [a]
forall t a. AsMaybe t t => (t -> (a, t)) -> t -> [a]
unfoldrT t -> (a, t)
f t
s2

-- | run a functions against each side of a tuple and stitch them together for use with 'unfoldrT' where "s" is a tuple and you want to stop as soon as the either terminates
pairsT :: (x -> (a, x)) -> (y -> (b, y)) -> (x, y) -> ((a, b), (x, y))
pairsT :: (x -> (a, x)) -> (y -> (b, y)) -> (x, y) -> ((a, b), (x, y))
pairsT x -> (a, x)
f y -> (b, y)
g (x
x0, y
y0) =
  let (a
a, x
x) = x -> (a, x)
f x
x0
      (b
b, y
y) = y -> (b, y)
g y
y0
   in ((a
a, b
b), (x
x, y
y))

-- | apply a function to a list and convert to a list of 'These'
toTheseT ::
  forall e a x b.
  (ApThese e a x b) =>
  (a -> x) ->
  [a] ->
  [These e b]
toTheseT :: (a -> x) -> [a] -> [These e b]
toTheseT a -> x
f = (a -> These e b) -> [a] -> [These e b]
forall a b. (a -> b) -> [a] -> [b]
map (\a
a -> a -> x -> These e b
forall e a x b. ApThese e a x b => a -> x -> These e b
apThese a
a (a -> x
f a
a))

-- | like 'toTheseT' with state
toTheseTS ::
  forall e a x b z.
  (ApThese e a x b) =>
  (z -> a -> (z, x)) ->
  z ->
  [a] ->
  (z, [These e b])
toTheseTS :: (z -> a -> (z, x)) -> z -> [a] -> (z, [These e b])
toTheseTS z -> a -> (z, x)
f = (z -> a -> (z, These e b)) -> z -> [a] -> (z, [These e b])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
L.mapAccumL (\z
z a
a -> (x -> These e b) -> (z, x) -> (z, These e b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (a -> x -> These e b
forall e a x b. ApThese e a x b => a -> x -> These e b
apThese a
a) (z -> a -> (z, x)
f z
z a
a))

-- | like 'partitionEithersT' ignoring the second element of the result
filterT ::
  forall e a b x.
  ApThese e a x b =>
  (a -> x) ->
  [a] ->
  [b]
filterT :: (a -> x) -> [a] -> [b]
filterT = [These e b] -> [b]
forall a b. [These a b] -> [b]
catThat ([These e b] -> [b])
-> ((a -> x) -> [a] -> [These e b]) -> (a -> x) -> [a] -> [b]
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ forall a x b. ApThese e a x b => (a -> x) -> [a] -> [These e b]
forall e a x b. ApThese e a x b => (a -> x) -> [a] -> [These e b]
toTheseT @e -- minimal type applications required as "e" isnt used here

-- | like 'toTheseT' but use 'partitionHereThere' on the results (swapped version of 'Data.List.partition')
partitionEithersT ::
  forall e a b x.
  ApThese e a x b =>
  (a -> x) ->
  [a] ->
  ([e], [b])
partitionEithersT :: (a -> x) -> [a] -> ([e], [b])
partitionEithersT = [These e b] -> ([e], [b])
forall a b. [These a b] -> ([a], [b])
partitionHereThere ([These e b] -> ([e], [b]))
-> ((a -> x) -> [a] -> [These e b])
-> (a -> x)
-> [a]
-> ([e], [b])
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ (a -> x) -> [a] -> [These e b]
forall e a x b. ApThese e a x b => (a -> x) -> [a] -> [These e b]
toTheseT

-- | like 'toTheseT' but use 'partitionThese' on the results
partitionTheseT ::
  forall e a b x.
  ApThese e a x b =>
  (a -> x) ->
  [a] ->
  ([e], [b], [(e, b)])
partitionTheseT :: (a -> x) -> [a] -> ([e], [b], [(e, b)])
partitionTheseT = [These e b] -> ([e], [b], [(e, b)])
forall a b. [These a b] -> ([a], [b], [(a, b)])
partitionThese ([These e b] -> ([e], [b], [(e, b)]))
-> ((a -> x) -> [a] -> [These e b])
-> (a -> x)
-> [a]
-> ([e], [b], [(e, b)])
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ (a -> x) -> [a] -> [These e b]
forall e a x b. ApThese e a x b => (a -> x) -> [a] -> [These e b]
toTheseT

-- | similar to 'Data.List.span' using 'ApThese' for failure (support Bool and These)
spanT ::
  forall e a x b.
  ApThese e a x b =>
  (a -> x) ->
  [a] ->
  ([b], [a])
spanT :: (a -> x) -> [a] -> ([b], [a])
spanT a -> x
f = \case
  [] -> ([], [])
  a
a : [a]
as -> case a -> x -> These e b
forall e a x b. ApThese e a x b => a -> x -> These e b
apThese @e a
a (a -> x
f a
a) of
    This e
_ -> ([], a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as)
    That b
b -> ([b] -> [b]) -> ([b], [a]) -> ([b], [a])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (b
b b -> [b] -> [b]
forall a. a -> [a] -> [a]
:) ((a -> x) -> [a] -> ([b], [a])
forall e a x b. ApThese e a x b => (a -> x) -> [a] -> ([b], [a])
spanT @e a -> x
f [a]
as)
    These e
_ b
b -> ((b
b b -> [b] -> [b]
forall a. a -> [a] -> [a]
:) ([b] -> [b]) -> ([a] -> [a]) -> ([b], [a]) -> ([b], [a])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) ((a -> x) -> [a] -> ([b], [a])
forall e a x b. ApThese e a x b => (a -> x) -> [a] -> ([b], [a])
spanT @e a -> x
f [a]
as) -- put in both buckets and keep going

-- | like 'spanT' but doesn't continue in the 'These' case
spanTAlt ::
  forall e a x b.
  ApThese e a x b =>
  (a -> x) ->
  [a] ->
  ([b], [a])
spanTAlt :: (a -> x) -> [a] -> ([b], [a])
spanTAlt a -> x
f = \case
  [] -> ([], [])
  a
a : [a]
as -> case a -> x -> These e b
forall e a x b. ApThese e a x b => a -> x -> These e b
apThese @e a
a (a -> x
f a
a) of
    This e
_ -> ([], a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as)
    That b
b -> ([b] -> [b]) -> ([b], [a]) -> ([b], [a])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (b
b b -> [b] -> [b]
forall a. a -> [a] -> [a]
:) ((a -> x) -> [a] -> ([b], [a])
forall e a x b. ApThese e a x b => (a -> x) -> [a] -> ([b], [a])
spanT @e a -> x
f [a]
as)
    These e
_ b
b -> ([b
b], a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as) -- put in both buckets and stop

-- | like 'spanT' with state
spanTS ::
  forall e a x b z.
  ApThese e a x b =>
  (z -> a -> (z, x)) ->
  z ->
  [a] ->
  (z, ([b], [a]))
spanTS :: (z -> a -> (z, x)) -> z -> [a] -> (z, ([b], [a]))
spanTS z -> a -> (z, x)
f z
z0 = \case
  [] -> (z
z0, ([], []))
  a
a : [a]
as ->
    let (z
z, x
x) = z -> a -> (z, x)
f z
z0 a
a
     in case a -> x -> These e b
forall e a x b. ApThese e a x b => a -> x -> These e b
apThese @e a
a x
x of
          This e
_ -> (z
z, ([], a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as))
          That b
b -> (([b], [a]) -> ([b], [a])) -> (z, ([b], [a])) -> (z, ([b], [a]))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (([b] -> [b]) -> ([b], [a]) -> ([b], [a])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (b
b b -> [b] -> [b]
forall a. a -> [a] -> [a]
:)) ((z -> a -> (z, x)) -> z -> [a] -> (z, ([b], [a]))
forall e a x b z.
ApThese e a x b =>
(z -> a -> (z, x)) -> z -> [a] -> (z, ([b], [a]))
spanTS @e z -> a -> (z, x)
f z
z [a]
as)
          These e
_ b
b -> (([b], [a]) -> ([b], [a])) -> (z, ([b], [a])) -> (z, ([b], [a]))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((b
b b -> [b] -> [b]
forall a. a -> [a] -> [a]
:) ([b] -> [b]) -> ([a] -> [a]) -> ([b], [a]) -> ([b], [a])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) ((z -> a -> (z, x)) -> z -> [a] -> (z, ([b], [a]))
forall e a x b z.
ApThese e a x b =>
(z -> a -> (z, x)) -> z -> [a] -> (z, ([b], [a]))
spanTS @e z -> a -> (z, x)
f z
z [a]
as) -- if these then put in both buckets

-- | like 'takeWhileT' with state
takeWhileTS ::
  forall e a x b z.
  ApThese e a x b =>
  (z -> a -> (z, x)) ->
  z ->
  [a] ->
  (z, [b])
takeWhileTS :: (z -> a -> (z, x)) -> z -> [a] -> (z, [b])
takeWhileTS z -> a -> (z, x)
f = (([b], [a]) -> [b]) -> (z, ([b], [a])) -> (z, [b])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ([b], [a]) -> [b]
forall a b. (a, b) -> a
fst ((z, ([b], [a])) -> (z, [b]))
-> (z -> [a] -> (z, ([b], [a]))) -> z -> [a] -> (z, [b])
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ (z -> a -> (z, x)) -> z -> [a] -> (z, ([b], [a]))
forall e a x b z.
ApThese e a x b =>
(z -> a -> (z, x)) -> z -> [a] -> (z, ([b], [a]))
spanTS @e z -> a -> (z, x)
f

-- | like 'spanT' but ignore the second element of the result
takeWhileT ::
  forall e a x b.
  ApThese e a x b =>
  (a -> x) ->
  [a] ->
  [b]
takeWhileT :: (a -> x) -> [a] -> [b]
takeWhileT = ([b], [a]) -> [b]
forall a b. (a, b) -> a
fst (([b], [a]) -> [b])
-> ((a -> x) -> [a] -> ([b], [a])) -> (a -> x) -> [a] -> [b]
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ forall a x b. ApThese e a x b => (a -> x) -> [a] -> ([b], [a])
forall e a x b. ApThese e a x b => (a -> x) -> [a] -> ([b], [a])
spanT @e