{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}

{- |
Module      : Primus.Fold
Description : fold and unfolds
Copyright   : (c) Grant Weyburne, 2022
License     : BSD-3
-}
module Primus.Fold (
  -- * fill a container
  fillTraversable,
  fillTraversableExact,
  traverseLR,

  -- * extended traversals with access to past and future input
  histMapL,
  histMapR,
  histMapL',
  histMapR',

  -- * change inside of a container
  wrapL,
  wrap1,

  -- * fold and unfolds
  pFoldR,
  pFoldL,
  unfoldl,
  unfoldrM,
  unfoldlM,

  -- * zip
  zipExtrasT,
  zipExtrasRight,
  zipWithExact,
  zipExact,
  zipWithT,

  -- * compare container lengths
  CLCount (..),
  compareLength,
  compareLengthBy,
  compareLengths,
  clOrdering,

  -- * pad containers
  padR,
  padL,

  -- * chunking
  chunkN,
  chunkN',

  -- * scan
  postscanl,
  postscanr,

  -- * miscellaneous
  initsT,
  tailsT,
  reverseT,
  sortByT,
  unzipF,
  reverseF,
) where

import Control.Applicative
import Control.Arrow
import Control.Monad
import Data.Bool
import Data.Foldable
import Data.Kind
import qualified Data.List as L
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as N
import Data.Semigroup.Foldable
import Data.These
import Data.These.Combinators
import Primus.Error
import Primus.Extra

data Hist a b = Hist ![a] ![a] !b

getHistZ :: Hist a b -> b
getHistZ :: Hist a b -> b
getHistZ (Hist [a]
_ [a]
_ b
z) = b
z

{- | left fold over a list giving the caller access to past and future input and state "z"
 if you want previous "b" values then put it in "z"
-}
histMapImpl ::
  Traversable t =>
  Bool ->
  ([a] -> [a] -> z -> a -> (z, b)) ->
  z ->
  t a ->
  (z, t b)
histMapImpl :: Bool -> ([a] -> [a] -> z -> a -> (z, b)) -> z -> t a -> (z, t b)
histMapImpl Bool
isright [a] -> [a] -> z -> a -> (z, b)
f z
z0 t a
lst =
  (Hist a z -> z) -> (Hist a z, t b) -> (z, t b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Hist a z -> z
forall a b. Hist a b -> b
getHistZ ((Hist a z, t b) -> (z, t b)) -> (Hist a z, t b) -> (z, t b)
forall a b. (a -> b) -> a -> b
$
    ((Hist a z -> a -> (Hist a z, b))
 -> Hist a z -> t a -> (Hist a z, t b))
-> ((Hist a z -> a -> (Hist a z, b))
    -> Hist a z -> t a -> (Hist a z, t b))
-> Bool
-> (Hist a z -> a -> (Hist a z, b))
-> Hist a z
-> t a
-> (Hist a z, t b)
forall a. a -> a -> Bool -> a
bool
      (Hist a z -> a -> (Hist a z, b))
-> Hist a z -> t a -> (Hist a z, t b)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
L.mapAccumL
      (Hist a z -> a -> (Hist a z, b))
-> Hist a z -> t a -> (Hist a z, t b)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
L.mapAccumR
      Bool
isright
      Hist a z -> a -> (Hist a z, b)
g
      ([a] -> [a] -> z -> Hist a z
forall a b. [a] -> [a] -> b -> Hist a b
Hist [] ((t a -> [a]) -> (t a -> [a]) -> Bool -> t a -> [a]
forall a. a -> a -> Bool -> a
bool t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
reverseF Bool
isright t a
lst) z
z0)
      t a
lst
 where
  g :: Hist a z -> a -> (Hist a z, b)
g (Hist [a]
ps [a]
ft z
z) a
a =
    case [a]
ft of
      [] -> String -> (Hist a z, b)
forall a. HasCallStack => String -> a
programmError String
"histMapImpl: ran out of data!"
      a
_ : [a]
ft0 ->
        let (z
z', b
b) = [a] -> [a] -> z -> a -> (z, b)
f [a]
ps [a]
ft0 z
z a
a
         in ([a] -> [a] -> z -> Hist a z
forall a b. [a] -> [a] -> b -> Hist a b
Hist (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ps) [a]
ft0 z
z', b
b)

-- | left/right fold over a list giving the caller access state "z" (for finite containers only)
histMapL
  , histMapR ::
    Traversable t =>
    ([a] -> [a] -> z -> a -> (z, b)) ->
    z ->
    t a ->
    (z, t b)
histMapL :: ([a] -> [a] -> z -> a -> (z, b)) -> z -> t a -> (z, t b)
histMapL = Bool -> ([a] -> [a] -> z -> a -> (z, b)) -> z -> t a -> (z, t b)
forall (t :: * -> *) a z b.
Traversable t =>
Bool -> ([a] -> [a] -> z -> a -> (z, b)) -> z -> t a -> (z, t b)
histMapImpl Bool
False
histMapR :: ([a] -> [a] -> z -> a -> (z, b)) -> z -> t a -> (z, t b)
histMapR = Bool -> ([a] -> [a] -> z -> a -> (z, b)) -> z -> t a -> (z, t b)
forall (t :: * -> *) a z b.
Traversable t =>
Bool -> ([a] -> [a] -> z -> a -> (z, b)) -> z -> t a -> (z, t b)
histMapImpl Bool
True

-- | left/right fold that gives access to past input (reverse order) and future input
pFoldL, pFoldR :: forall a b. ([a] -> [a] -> b -> a -> b) -> b -> [a] -> b
pFoldR :: ([a] -> [a] -> b -> a -> b) -> b -> [a] -> b
pFoldR [a] -> [a] -> b -> a -> b
f b
n = [a] -> [a] -> b
go []
 where
  go :: [a] -> [a] -> b
  go :: [a] -> [a] -> b
go [a]
pres = \case
    [] -> b
n
    a
a : [a]
as -> [a] -> [a] -> b -> a -> b
f [a]
pres [a]
as ([a] -> [a] -> b
go (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
pres) [a]
as) a
a
pFoldL :: ([a] -> [a] -> b -> a -> b) -> b -> [a] -> b
pFoldL [a] -> [a] -> b -> a -> b
f = [a] -> b -> [a] -> b
go []
 where
  go :: [a] -> b -> [a] -> b
  go :: [a] -> b -> [a] -> b
go [a]
pres !b
z = \case
    [] -> b
z
    a
a : [a]
as -> [a] -> b -> [a] -> b
go (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
pres) ([a] -> [a] -> b -> a -> b
f [a]
pres [a]
as b
z a
a) [a]
as

histMapImpl' ::
  forall a b t.
  Traversable t =>
  Bool ->
  ([a] -> [a] -> a -> b) ->
  t a ->
  t b
histMapImpl' :: Bool -> ([a] -> [a] -> a -> b) -> t a -> t b
histMapImpl' Bool
isright [a] -> [a] -> a -> b
f = ((), t b) -> t b
forall a b. (a, b) -> b
snd (((), t b) -> t b) -> (t a -> ((), t b)) -> t a -> t b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([a] -> [a] -> () -> a -> ((), b)) -> () -> t a -> ((), t b))
-> (([a] -> [a] -> () -> a -> ((), b)) -> () -> t a -> ((), t b))
-> Bool
-> ([a] -> [a] -> () -> a -> ((), b))
-> ()
-> t a
-> ((), t b)
forall a. a -> a -> Bool -> a
bool ([a] -> [a] -> () -> a -> ((), b)) -> () -> t a -> ((), t b)
forall (t :: * -> *) a z b.
Traversable t =>
([a] -> [a] -> z -> a -> (z, b)) -> z -> t a -> (z, t b)
histMapL ([a] -> [a] -> () -> a -> ((), b)) -> () -> t a -> ((), t b)
forall (t :: * -> *) a z b.
Traversable t =>
([a] -> [a] -> z -> a -> (z, b)) -> z -> t a -> (z, t b)
histMapR Bool
isright [a] -> [a] -> () -> a -> ((), b)
g ()
 where
  g :: [a] -> [a] -> () -> a -> ((), b)
  g :: [a] -> [a] -> () -> a -> ((), b)
g [a]
ps [a]
ft () a
a = ((), [a] -> [a] -> a -> b
f [a]
ps [a]
ft a
a)

-- | same as 'histMapL' or 'histMapR' but skips state
histMapL'
  , histMapR' ::
    forall a b t.
    Traversable t =>
    ([a] -> [a] -> a -> b) ->
    t a ->
    t b
histMapL' :: ([a] -> [a] -> a -> b) -> t a -> t b
histMapL' = Bool -> ([a] -> [a] -> a -> b) -> t a -> t b
forall a b (t :: * -> *).
Traversable t =>
Bool -> ([a] -> [a] -> a -> b) -> t a -> t b
histMapImpl' Bool
False
histMapR' :: ([a] -> [a] -> a -> b) -> t a -> t b
histMapR' = Bool -> ([a] -> [a] -> a -> b) -> t a -> t b
forall a b (t :: * -> *).
Traversable t =>
Bool -> ([a] -> [a] -> a -> b) -> t a -> t b
histMapImpl' Bool
True

-- | like 'Data.List.unfoldr' but reverses the order of the list
unfoldl :: forall s a. (s -> Maybe (a, s)) -> s -> [a]
unfoldl :: (s -> Maybe (a, s)) -> s -> [a]
unfoldl s -> Maybe (a, s)
f = [a] -> s -> [a]
go []
 where
  go :: [a] -> s -> [a]
  go :: [a] -> s -> [a]
go [a]
as !s
s = case s -> Maybe (a, s)
f s
s of
    Maybe (a, s)
Nothing -> [a]
as
    Just (a
a, s
s1) -> [a] -> s -> [a]
go (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as) s
s1

-- | monadic unfoldr
unfoldrM :: forall m s a. Monad m => (s -> m (Maybe (a, s))) -> s -> m [a]
unfoldrM :: (s -> m (Maybe (a, s))) -> s -> m [a]
unfoldrM s -> m (Maybe (a, s))
f s
s = do
  Maybe (a, s)
mas <- s -> m (Maybe (a, s))
f s
s
  case Maybe (a, s)
mas of
    Maybe (a, s)
Nothing -> [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Just (a
a, s
s') -> (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> m [a] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (s -> m (Maybe (a, s))) -> s -> m [a]
forall (m :: * -> *) s a.
Monad m =>
(s -> m (Maybe (a, s))) -> s -> m [a]
unfoldrM s -> m (Maybe (a, s))
f s
s'

-- | monadic unfoldl
unfoldlM :: forall m s a. Monad m => (s -> m (Maybe (a, s))) -> s -> m [a]
unfoldlM :: (s -> m (Maybe (a, s))) -> s -> m [a]
unfoldlM s -> m (Maybe (a, s))
f = [a] -> s -> m [a]
go []
 where
  go :: [a] -> s -> m [a]
  go :: [a] -> s -> m [a]
go [a]
as s
s = do
    Maybe (a, s)
mas <- s -> m (Maybe (a, s))
f s
s
    case Maybe (a, s)
mas of
      Maybe (a, s)
Nothing -> [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
as
      Just (a
a, s
s') -> [a] -> s -> m [a]
go (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as) s
s'

-- | traverse a container using 'StateLR'
traverseLR ::
  forall t a b c.
  Traversable t =>
  (c -> a -> Either String (c, b)) ->
  c ->
  t a ->
  Either String (c, t b)
traverseLR :: (c -> a -> Either String (c, b))
-> c -> t a -> Either String (c, t b)
traverseLR c -> a -> Either String (c, b)
f c
c0 t a
ta =
  let g :: a -> StateLR String c b
      g :: a -> StateLR String c b
g a
a = (c -> Either String (c, b)) -> StateLR String c b
forall e s a. (s -> Either e (s, a)) -> StateLR e s a
StateLR ((c -> Either String (c, b)) -> StateLR String c b)
-> (c -> Either String (c, b)) -> StateLR String c b
forall a b. (a -> b) -> a -> b
$ \c
c -> c -> a -> Either String (c, b)
f c
c a
a
   in StateLR String c (t b) -> c -> Either String (c, t b)
forall e s a. StateLR e s a -> s -> Either e (s, a)
unStateLR ((a -> StateLR String c b) -> t a -> StateLR String c (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> StateLR String c b
g t a
ta) c
c0

-- | fill a traversable with a list and fail if not enough data
fillTraversable ::
  forall t a z.
  Traversable t =>
  t z ->
  [a] ->
  Either String ([a], t a)
fillTraversable :: t z -> [a] -> Either String ([a], t a)
fillTraversable t z
tz [a]
as0 =
  let g :: z -> StateLR String [a] a
      g :: z -> StateLR String [a] a
g z
_ = ([a] -> Either String ([a], a)) -> StateLR String [a] a
forall e s a. (s -> Either e (s, a)) -> StateLR e s a
StateLR (([a] -> Either String ([a], a)) -> StateLR String [a] a)
-> ([a] -> Either String ([a], a)) -> StateLR String [a] a
forall a b. (a -> b) -> a -> b
$ \case
        [] -> String -> Either String ([a], a)
forall a b. a -> Either a b
Left String
"fillTraversable: not enough data"
        a
d : [a]
ds' -> ([a], a) -> Either String ([a], a)
forall a b. b -> Either a b
Right ([a]
ds', a
d)
   in StateLR String [a] (t a) -> [a] -> Either String ([a], t a)
forall e s a. StateLR e s a -> s -> Either e (s, a)
unStateLR ((z -> StateLR String [a] a) -> t z -> StateLR String [a] (t a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse z -> StateLR String [a] a
g t z
tz) [a]
as0

-- | fill a traversable with a list and fail if there are leftovers: see 'fillTraversable'
fillTraversableExact ::
  forall f a z.
  Traversable f =>
  f z ->
  [a] ->
  Either String (f a)
fillTraversableExact :: f z -> [a] -> Either String (f a)
fillTraversableExact = Either String ([a], f a) -> Either String (f a)
forall b. Either String ([a], b) -> Either String b
g (Either String ([a], f a) -> Either String (f a))
-> (f z -> [a] -> Either String ([a], f a))
-> f z
-> [a]
-> Either String (f a)
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ f z -> [a] -> Either String ([a], f a)
forall (t :: * -> *) a z.
Traversable t =>
t z -> [a] -> Either String ([a], t a)
fillTraversable
 where
  g :: Either String ([a], b) -> Either String b
  g :: Either String ([a], b) -> Either String b
g = \case
    Right ([], b
ret) -> b -> Either String b
forall a b. b -> Either a b
Right b
ret
    Right (a
_ : [a]
_, b
_) -> String -> Either String b
forall a b. a -> Either a b
Left String
"fillTraversableExact: too many elements found"
    Left String
e -> String -> Either String b
forall a b. a -> Either a b
Left String
e

-- | run a function against the contents of the 'Foldable1' container as a nonempty list
wrap1 ::
  forall (g :: Type -> Type) a b.
  (Traversable g, Foldable1 g) =>
  (NonEmpty a -> NonEmpty b) ->
  g a ->
  Either String (g b)
wrap1 :: (NonEmpty a -> NonEmpty b) -> g a -> Either String (g b)
wrap1 NonEmpty a -> NonEmpty b
f g a
gx = g a -> [b] -> Either String (g b)
forall (f :: * -> *) a z.
Traversable f =>
f z -> [a] -> Either String (f a)
fillTraversableExact g a
gx (NonEmpty b -> [b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty a -> NonEmpty b
f (g a -> NonEmpty a
forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty g a
gx)))

-- | run a function against the contents of the 'Foldable' container as a list
wrapL ::
  forall (g :: Type -> Type) a b.
  (Traversable g) =>
  ([a] -> [b]) ->
  g a ->
  Either String (g b)
wrapL :: ([a] -> [b]) -> g a -> Either String (g b)
wrapL [a] -> [b]
f g a
gx = g a -> [b] -> Either String (g b)
forall (f :: * -> *) a z.
Traversable f =>
f z -> [a] -> Either String (f a)
fillTraversableExact g a
gx ([a] -> [b]
f (g a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList g a
gx))

-- | pad fill "as" to the right or left with values from "zs"
padR, padL :: forall t a. Traversable t => t a -> [a] -> Either String (t a)
padR :: t a -> [a] -> Either String (t a)
padR = Bool -> t a -> [a] -> Either String (t a)
forall (t :: * -> *) a.
Traversable t =>
Bool -> t a -> [a] -> Either String (t a)
padImpl Bool
True
padL :: t a -> [a] -> Either String (t a)
padL = Bool -> t a -> [a] -> Either String (t a)
forall (t :: * -> *) a.
Traversable t =>
Bool -> t a -> [a] -> Either String (t a)
padImpl Bool
False

-- | pad fill "as" to the left/right with values from "zs"
padImpl :: forall t a. Traversable t => Bool -> t a -> [a] -> Either String (t a)
padImpl :: Bool -> t a -> [a] -> Either String (t a)
padImpl Bool
isright t a
as [a]
zs =
  let ([a]
rs, t a
zz) = (t a -> ([a], t a))
-> (t a -> ([a], t a)) -> Bool -> t a -> ([a], t a)
forall a. a -> a -> Bool -> a
bool (([a] -> a -> ([a], a)) -> [a] -> t a -> ([a], t a)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
L.mapAccumR [a] -> a -> ([a], a)
f ([a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
reverseF [a]
zs)) (([a] -> a -> ([a], a)) -> [a] -> t a -> ([a], t a)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
L.mapAccumL [a] -> a -> ([a], a)
f [a]
zs) Bool
isright t a
as
   in case [a]
rs of
        [] -> t a -> Either String (t a)
forall a b. b -> Either a b
Right t a
zz
        a
_ : [a]
_ -> String -> Either String (t a)
forall a b. a -> Either a b
Left (String -> Either String (t a)) -> String -> Either String (t a)
forall a b. (a -> b) -> a -> b
$ String
"pad" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> Bool -> String
forall a. a -> a -> Bool -> a
bool String
"L" String
"R" Bool
isright String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": negative fill: would need to truncate the data"
 where
  f :: [a] -> a -> ([a], a)
  f :: [a] -> a -> ([a], a)
f [a]
xs a
a =
    case [a]
xs of
      [] -> ([], a
a)
      a
b : [a]
bs -> ([a]
bs, a
b)

-- | have to call a second time if the left container is bigger than the right one
zipExtrasT :: forall a b t. Traversable t => t a -> t b -> t (These a b)
zipExtrasT :: t a -> t b -> t (These a b)
zipExtrasT t a
xs t b
ys =
  let ([a]
rs, t (These a b)
ret) = [a] -> t b -> ([a], t (These a b))
forall a b (t :: * -> *).
Traversable t =>
[a] -> t b -> ([a], t (These a b))
zipExtrasRight (t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
xs) t b
ys
   in case [a]
rs of
        [] -> t (These a b)
ret
        a
_ : [a]
_ -> These b a -> These a b
forall a b. These a b -> These b a
swapThese (These b a -> These a b) -> t (These b a) -> t (These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t b -> t a -> t (These b a)
forall a b (t :: * -> *).
Traversable t =>
t a -> t b -> t (These a b)
zipExtrasT t b
ys t a
xs

-- | zip a foldable into a traversable container and return any leftovers
zipExtrasRight ::
  forall a b t.
  Traversable t =>
  [a] ->
  t b ->
  ([a], t (These a b))
zipExtrasRight :: [a] -> t b -> ([a], t (These a b))
zipExtrasRight = ([a] -> b -> ([a], These a b))
-> [a] -> t b -> ([a], t (These a b))
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
L.mapAccumL [a] -> b -> ([a], These a b)
f
 where
  f :: [a] -> b -> ([a], These a b)
  f :: [a] -> b -> ([a], These a b)
f [a]
zs b
b = case [a]
zs of
    [] -> ([], b -> These a b
forall a b. b -> These a b
That b
b)
    a
a : [a]
as -> ([a]
as, a -> b -> These a b
forall a b. a -> b -> These a b
These a
a b
b)

-- | predicate for 'CEQ'
clOrdering :: CLCount b -> Maybe Ordering
clOrdering :: CLCount b -> Maybe Ordering
clOrdering = \case
  CError{} -> Maybe Ordering
forall a. Maybe a
Nothing
  CLT{} -> Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just Ordering
LT
  CLCount b
CEQ -> Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just Ordering
EQ
  CLCount b
CGT -> Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just Ordering
GT

-- | difference between two foldables but quick exit if lhs is larger than rhs
data CLCount b
  = -- | error
    CError !String
  | -- | leftovers from rhs: ie lhs is smaller than rhs
    CLT !(NonEmpty b)
  | -- | same size
    CEQ
  | -- | lhs is larger than rhs
    CGT
  deriving stock (Eq (CLCount b)
Eq (CLCount b)
-> (CLCount b -> CLCount b -> Ordering)
-> (CLCount b -> CLCount b -> Bool)
-> (CLCount b -> CLCount b -> Bool)
-> (CLCount b -> CLCount b -> Bool)
-> (CLCount b -> CLCount b -> Bool)
-> (CLCount b -> CLCount b -> CLCount b)
-> (CLCount b -> CLCount b -> CLCount b)
-> Ord (CLCount b)
CLCount b -> CLCount b -> Bool
CLCount b -> CLCount b -> Ordering
CLCount b -> CLCount b -> CLCount b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall b. Ord b => Eq (CLCount b)
forall b. Ord b => CLCount b -> CLCount b -> Bool
forall b. Ord b => CLCount b -> CLCount b -> Ordering
forall b. Ord b => CLCount b -> CLCount b -> CLCount b
min :: CLCount b -> CLCount b -> CLCount b
$cmin :: forall b. Ord b => CLCount b -> CLCount b -> CLCount b
max :: CLCount b -> CLCount b -> CLCount b
$cmax :: forall b. Ord b => CLCount b -> CLCount b -> CLCount b
>= :: CLCount b -> CLCount b -> Bool
$c>= :: forall b. Ord b => CLCount b -> CLCount b -> Bool
> :: CLCount b -> CLCount b -> Bool
$c> :: forall b. Ord b => CLCount b -> CLCount b -> Bool
<= :: CLCount b -> CLCount b -> Bool
$c<= :: forall b. Ord b => CLCount b -> CLCount b -> Bool
< :: CLCount b -> CLCount b -> Bool
$c< :: forall b. Ord b => CLCount b -> CLCount b -> Bool
compare :: CLCount b -> CLCount b -> Ordering
$ccompare :: forall b. Ord b => CLCount b -> CLCount b -> Ordering
$cp1Ord :: forall b. Ord b => Eq (CLCount b)
Ord, Int -> CLCount b -> String -> String
[CLCount b] -> String -> String
CLCount b -> String
(Int -> CLCount b -> String -> String)
-> (CLCount b -> String)
-> ([CLCount b] -> String -> String)
-> Show (CLCount b)
forall b. Show b => Int -> CLCount b -> String -> String
forall b. Show b => [CLCount b] -> String -> String
forall b. Show b => CLCount b -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CLCount b] -> String -> String
$cshowList :: forall b. Show b => [CLCount b] -> String -> String
show :: CLCount b -> String
$cshow :: forall b. Show b => CLCount b -> String
showsPrec :: Int -> CLCount b -> String -> String
$cshowsPrec :: forall b. Show b => Int -> CLCount b -> String -> String
Show, CLCount b -> CLCount b -> Bool
(CLCount b -> CLCount b -> Bool)
-> (CLCount b -> CLCount b -> Bool) -> Eq (CLCount b)
forall b. Eq b => CLCount b -> CLCount b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CLCount b -> CLCount b -> Bool
$c/= :: forall b. Eq b => CLCount b -> CLCount b -> Bool
== :: CLCount b -> CLCount b -> Bool
$c== :: forall b. Eq b => CLCount b -> CLCount b -> Bool
Eq, a -> CLCount b -> CLCount a
(a -> b) -> CLCount a -> CLCount b
(forall a b. (a -> b) -> CLCount a -> CLCount b)
-> (forall a b. a -> CLCount b -> CLCount a) -> Functor CLCount
forall a b. a -> CLCount b -> CLCount a
forall a b. (a -> b) -> CLCount a -> CLCount b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CLCount b -> CLCount a
$c<$ :: forall a b. a -> CLCount b -> CLCount a
fmap :: (a -> b) -> CLCount a -> CLCount b
$cfmap :: forall a b. (a -> b) -> CLCount a -> CLCount b
Functor, Functor CLCount
Foldable CLCount
Functor CLCount
-> Foldable CLCount
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> CLCount a -> f (CLCount b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    CLCount (f a) -> f (CLCount a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> CLCount a -> m (CLCount b))
-> (forall (m :: * -> *) a.
    Monad m =>
    CLCount (m a) -> m (CLCount a))
-> Traversable CLCount
(a -> f b) -> CLCount a -> f (CLCount b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => CLCount (m a) -> m (CLCount a)
forall (f :: * -> *) a.
Applicative f =>
CLCount (f a) -> f (CLCount a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CLCount a -> m (CLCount b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CLCount a -> f (CLCount b)
sequence :: CLCount (m a) -> m (CLCount a)
$csequence :: forall (m :: * -> *) a. Monad m => CLCount (m a) -> m (CLCount a)
mapM :: (a -> m b) -> CLCount a -> m (CLCount b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CLCount a -> m (CLCount b)
sequenceA :: CLCount (f a) -> f (CLCount a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
CLCount (f a) -> f (CLCount a)
traverse :: (a -> f b) -> CLCount a -> f (CLCount b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CLCount a -> f (CLCount b)
$cp2Traversable :: Foldable CLCount
$cp1Traversable :: Functor CLCount
Traversable, CLCount a -> Bool
(a -> m) -> CLCount a -> m
(a -> b -> b) -> b -> CLCount a -> b
(forall m. Monoid m => CLCount m -> m)
-> (forall m a. Monoid m => (a -> m) -> CLCount a -> m)
-> (forall m a. Monoid m => (a -> m) -> CLCount a -> m)
-> (forall a b. (a -> b -> b) -> b -> CLCount a -> b)
-> (forall a b. (a -> b -> b) -> b -> CLCount a -> b)
-> (forall b a. (b -> a -> b) -> b -> CLCount a -> b)
-> (forall b a. (b -> a -> b) -> b -> CLCount a -> b)
-> (forall a. (a -> a -> a) -> CLCount a -> a)
-> (forall a. (a -> a -> a) -> CLCount a -> a)
-> (forall a. CLCount a -> [a])
-> (forall a. CLCount a -> Bool)
-> (forall a. CLCount a -> Int)
-> (forall a. Eq a => a -> CLCount a -> Bool)
-> (forall a. Ord a => CLCount a -> a)
-> (forall a. Ord a => CLCount a -> a)
-> (forall a. Num a => CLCount a -> a)
-> (forall a. Num a => CLCount a -> a)
-> Foldable CLCount
forall a. Eq a => a -> CLCount a -> Bool
forall a. Num a => CLCount a -> a
forall a. Ord a => CLCount a -> a
forall m. Monoid m => CLCount m -> m
forall a. CLCount a -> Bool
forall a. CLCount a -> Int
forall a. CLCount a -> [a]
forall a. (a -> a -> a) -> CLCount a -> a
forall m a. Monoid m => (a -> m) -> CLCount a -> m
forall b a. (b -> a -> b) -> b -> CLCount a -> b
forall a b. (a -> b -> b) -> b -> CLCount a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: CLCount a -> a
$cproduct :: forall a. Num a => CLCount a -> a
sum :: CLCount a -> a
$csum :: forall a. Num a => CLCount a -> a
minimum :: CLCount a -> a
$cminimum :: forall a. Ord a => CLCount a -> a
maximum :: CLCount a -> a
$cmaximum :: forall a. Ord a => CLCount a -> a
elem :: a -> CLCount a -> Bool
$celem :: forall a. Eq a => a -> CLCount a -> Bool
length :: CLCount a -> Int
$clength :: forall a. CLCount a -> Int
null :: CLCount a -> Bool
$cnull :: forall a. CLCount a -> Bool
toList :: CLCount a -> [a]
$ctoList :: forall a. CLCount a -> [a]
foldl1 :: (a -> a -> a) -> CLCount a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> CLCount a -> a
foldr1 :: (a -> a -> a) -> CLCount a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> CLCount a -> a
foldl' :: (b -> a -> b) -> b -> CLCount a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> CLCount a -> b
foldl :: (b -> a -> b) -> b -> CLCount a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> CLCount a -> b
foldr' :: (a -> b -> b) -> b -> CLCount a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> CLCount a -> b
foldr :: (a -> b -> b) -> b -> CLCount a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> CLCount a -> b
foldMap' :: (a -> m) -> CLCount a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> CLCount a -> m
foldMap :: (a -> m) -> CLCount a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> CLCount a -> m
fold :: CLCount m -> m
$cfold :: forall m. Monoid m => CLCount m -> m
Foldable)

-- | compare lengths of foldables
compareLengths :: Foldable t => NonEmpty (t a) -> [CLCount a]
compareLengths :: NonEmpty (t a) -> [CLCount a]
compareLengths (t a
xs :| [t a]
xss) = (t a -> CLCount a) -> [t a] -> [CLCount a]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> a -> a -> Maybe String) -> t a -> t a -> CLCount a
forall (t :: * -> *) (u :: * -> *) a b.
(Foldable t, Foldable u) =>
(Int -> a -> b -> Maybe String) -> t a -> u b -> CLCount b
compareLengthBy Int -> a -> a -> Maybe String
forall a. Monoid a => a
mempty t a
xs) [t a]
xss

-- | compare length where lhs or rhs can be infinite but not both
compareLength ::
  forall t u a b.
  (Foldable t, Foldable u) =>
  t a ->
  u b ->
  CLCount b
compareLength :: t a -> u b -> CLCount b
compareLength = (Int -> a -> b -> Maybe String) -> t a -> u b -> CLCount b
forall (t :: * -> *) (u :: * -> *) a b.
(Foldable t, Foldable u) =>
(Int -> a -> b -> Maybe String) -> t a -> u b -> CLCount b
compareLengthBy Int -> a -> b -> Maybe String
forall a. Monoid a => a
mempty

-- | compare length where lhs or rhs can be infinite but not both
compareLengthBy ::
  forall t u a b.
  (Foldable t, Foldable u) =>
  (Int -> a -> b -> Maybe String) ->
  t a ->
  u b ->
  CLCount b
compareLengthBy :: (Int -> a -> b -> Maybe String) -> t a -> u b -> CLCount b
compareLengthBy Int -> a -> b -> Maybe String
p t a
xs u b
ys =
  (a -> ((Int, [b]) -> CLCount b) -> (Int, [b]) -> CLCount b)
-> ((Int, [b]) -> CLCount b) -> t a -> (Int, [b]) -> CLCount b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> ((Int, [b]) -> CLCount b) -> (Int, [b]) -> CLCount b
f (Int, [b]) -> CLCount b
g t a
xs (Int
0, u b -> [b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList u b
ys)
 where
  g :: (Int, [b]) -> CLCount b
  g :: (Int, [b]) -> CLCount b
g (Int
_, [b]
zs) = case [b]
zs of
    [] -> CLCount b
forall b. CLCount b
CEQ
    b
w : [b]
ws -> NonEmpty b -> CLCount b
forall b. NonEmpty b -> CLCount b
CLT (b
w b -> [b] -> NonEmpty b
forall a. a -> [a] -> NonEmpty a
:| [b]
ws)
  f :: a -> ((Int, [b]) -> CLCount b) -> (Int, [b]) -> CLCount b
  f :: a -> ((Int, [b]) -> CLCount b) -> (Int, [b]) -> CLCount b
f a
a (Int, [b]) -> CLCount b
k (Int
i, [b]
zs) = case [b]
zs of
    [] -> CLCount b
forall b. CLCount b
CGT -- quickexit
    b
b : [b]
bs -> case Int -> a -> b -> Maybe String
p Int
i a
a b
b of
      Maybe String
Nothing -> (Int, [b]) -> CLCount b
k (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, [b]
bs)
      Just String
e -> String -> CLCount b
forall b. String -> CLCount b
CError String
e

-- | 'zipWith' with an Applicative result
zipWithT ::
  (Applicative f, Traversable t, Applicative t) =>
  (a -> b -> f c) ->
  t a ->
  t b ->
  f (t c)
zipWithT :: (a -> b -> f c) -> t a -> t b -> f (t c)
zipWithT a -> b -> f c
f = t (f c) -> f (t c)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (t (f c) -> f (t c))
-> (t a -> t b -> t (f c)) -> t a -> t b -> f (t c)
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ (a -> b -> f c) -> t a -> t b -> t (f c)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> f c
f

-- | fills a container with chunks using a user supplied unfold function
chunkN ::
  forall t s b z.
  Traversable t =>
  (s -> Either String (s, b)) ->
  t z ->
  s ->
  Either String (s, t b)
chunkN :: (s -> Either String (s, b)) -> t z -> s -> Either String (s, t b)
chunkN s -> Either String (s, b)
f t z
tz = StateLR String s (t b) -> s -> Either String (s, t b)
forall e s a. StateLR e s a -> s -> Either e (s, a)
unStateLR ((z -> StateLR String s b) -> t z -> StateLR String s (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (StateLR String s b -> z -> StateLR String s b
forall a b. a -> b -> a
const ((s -> Either String (s, b)) -> StateLR String s b
forall e s a. (s -> Either e (s, a)) -> StateLR e s a
StateLR s -> Either String (s, b)
f)) t z
tz)

-- | similar to 'chunkN' but "s" is restricted to a foldable: if there is data left then will fail
chunkN' ::
  forall t a u b z.
  (Traversable t, Foldable u) =>
  (u a -> Either String (u a, b)) ->
  t z ->
  u a ->
  Either String (t b)
chunkN' :: (u a -> Either String (u a, b))
-> t z -> u a -> Either String (t b)
chunkN' u a -> Either String (u a, b)
f t z
tz u a
s = do
  (u a
s', t b
ret) <- (u a -> Either String (u a, b))
-> t z -> u a -> Either String (u a, t b)
forall (t :: * -> *) s b z.
Traversable t =>
(s -> Either String (s, b)) -> t z -> s -> Either String (s, t b)
chunkN u a -> Either String (u a, b)
g t z
tz u a
s
  if u a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null u a
s'
    then t b -> Either String (t b)
forall a b. b -> Either a b
Right t b
ret
    else String -> Either String (t b)
forall a b. a -> Either a b
Left String
"chunkN': there is still data remaining at eof"
 where
  g :: u a -> Either String (u a, b)
g u a
s' =
    if u a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null u a
s'
      then String -> Either String (u a, b)
forall a b. a -> Either a b
Left String
"chunkN': not enough data"
      else u a -> Either String (u a, b)
f u a
s'

-- | splits a container "u" into parts of length "len" and fills container "t"
zipWithExact ::
  forall t u a b c.
  (Traversable t, Foldable u) =>
  (a -> b -> c) ->
  t a ->
  u b ->
  Either String (t c)
zipWithExact :: (a -> b -> c) -> t a -> u b -> Either String (t c)
zipWithExact a -> b -> c
f t a
ta u b
ub = do
  let g :: a -> StateLR String [b] c
g a
a = ([b] -> Either String ([b], c)) -> StateLR String [b] c
forall e s a. (s -> Either e (s, a)) -> StateLR e s a
StateLR (([b] -> Either String ([b], c)) -> StateLR String [b] c)
-> ([b] -> Either String ([b], c)) -> StateLR String [b] c
forall a b. (a -> b) -> a -> b
$ \case
        [] -> String -> Either String ([b], c)
forall a b. a -> Either a b
Left String
"zipWithExact: lhs has more data"
        b
b : [b]
bs -> ([b], c) -> Either String ([b], c)
forall a b. b -> Either a b
Right ([b]
bs, a -> b -> c
f a
a b
b)
  ([b]
vx, t c
ret) <- StateLR String [b] (t c) -> [b] -> Either String ([b], t c)
forall e s a. StateLR e s a -> s -> Either e (s, a)
unStateLR ((a -> StateLR String [b] c) -> t a -> StateLR String [b] (t c)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> StateLR String [b] c
g t a
ta) (u b -> [b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList u b
ub)
  if [b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [b]
vx
    then t c -> Either String (t c)
forall a b. b -> Either a b
Right t c
ret
    else String -> Either String (t c)
forall a b. a -> Either a b
Left String
"zipWithExact: lhs has less data"

-- | see 'zipWithExact'
zipExact ::
  forall t u a b.
  (Traversable t, Foldable u) =>
  t a ->
  u b ->
  Either String (t (a, b))
zipExact :: t a -> u b -> Either String (t (a, b))
zipExact = (a -> b -> (a, b)) -> t a -> u b -> Either String (t (a, b))
forall (t :: * -> *) (u :: * -> *) a b c.
(Traversable t, Foldable u) =>
(a -> b -> c) -> t a -> u b -> Either String (t c)
zipWithExact (,)

-- | combines state and failure as a monad
newtype StateLR e s a = StateLR {StateLR e s a -> s -> Either e (s, a)
unStateLR :: s -> Either e (s, a)}
  deriving stock (a -> StateLR e s b -> StateLR e s a
(a -> b) -> StateLR e s a -> StateLR e s b
(forall a b. (a -> b) -> StateLR e s a -> StateLR e s b)
-> (forall a b. a -> StateLR e s b -> StateLR e s a)
-> Functor (StateLR e s)
forall a b. a -> StateLR e s b -> StateLR e s a
forall a b. (a -> b) -> StateLR e s a -> StateLR e s b
forall e s a b. a -> StateLR e s b -> StateLR e s a
forall e s a b. (a -> b) -> StateLR e s a -> StateLR e s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> StateLR e s b -> StateLR e s a
$c<$ :: forall e s a b. a -> StateLR e s b -> StateLR e s a
fmap :: (a -> b) -> StateLR e s a -> StateLR e s b
$cfmap :: forall e s a b. (a -> b) -> StateLR e s a -> StateLR e s b
Functor)

instance Applicative (StateLR e s) where
  pure :: a -> StateLR e s a
pure a
a = (s -> Either e (s, a)) -> StateLR e s a
forall e s a. (s -> Either e (s, a)) -> StateLR e s a
StateLR ((s -> Either e (s, a)) -> StateLR e s a)
-> (s -> Either e (s, a)) -> StateLR e s a
forall a b. (a -> b) -> a -> b
$ \s
s -> (s, a) -> Either e (s, a)
forall a b. b -> Either a b
Right (s
s, a
a)
  <*> :: StateLR e s (a -> b) -> StateLR e s a -> StateLR e s b
(<*>) = StateLR e s (a -> b) -> StateLR e s a -> StateLR e s b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad (StateLR e s) where
  return :: a -> StateLR e s a
return = a -> StateLR e s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  StateLR s -> Either e (s, a)
sa >>= :: StateLR e s a -> (a -> StateLR e s b) -> StateLR e s b
>>= a -> StateLR e s b
amb =
    (s -> Either e (s, b)) -> StateLR e s b
forall e s a. (s -> Either e (s, a)) -> StateLR e s a
StateLR ((s -> Either e (s, b)) -> StateLR e s b)
-> (s -> Either e (s, b)) -> StateLR e s b
forall a b. (a -> b) -> a -> b
$ \s
s -> case s -> Either e (s, a)
sa s
s of
      Left e
e -> e -> Either e (s, b)
forall a b. a -> Either a b
Left e
e
      Right (s
s1, a
a) -> StateLR e s b -> s -> Either e (s, b)
forall e s a. StateLR e s a -> s -> Either e (s, a)
unStateLR (a -> StateLR e s b
amb a
a) s
s1

-- | 'Data.List.inits' for a traversable container
initsT :: forall a t. Traversable t => t a -> t (NonEmpty a)
initsT :: t a -> t (NonEmpty a)
initsT t a
ta = case t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
ta of
  [] -> (a -> NonEmpty a) -> t a -> t (NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure t a
ta
  a
i : [a]
is -> Either String (t (NonEmpty a)) -> t (NonEmpty a)
forall a. HasCallStack => Either String a -> a
frp (Either String (t (NonEmpty a)) -> t (NonEmpty a))
-> Either String (t (NonEmpty a)) -> t (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ t a -> [NonEmpty a] -> Either String (t (NonEmpty a))
forall (f :: * -> *) a z.
Traversable f =>
f z -> [a] -> Either String (f a)
fillTraversableExact t a
ta (([a] -> NonEmpty a) -> [[a]] -> [NonEmpty a]
forall a b. (a -> b) -> [a] -> [b]
map (a
i a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:|) ([a] -> [[a]]
forall a. [a] -> [[a]]
L.inits [a]
is))

-- | 'Data.List.tails' for a traversable container
tailsT :: forall a t. Traversable t => t a -> t (NonEmpty a)
tailsT :: t a -> t (NonEmpty a)
tailsT t a
ta = String -> Either String (t (NonEmpty a)) -> t (NonEmpty a)
forall a. HasCallStack => String -> Either String a -> a
forceRight String
"tailsT" (Either String (t (NonEmpty a)) -> t (NonEmpty a))
-> Either String (t (NonEmpty a)) -> t (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ do
  ([a]
xs, t (NonEmpty a)
ret) <- ([a] -> a -> Either String ([a], NonEmpty a))
-> [a] -> t a -> Either String ([a], t (NonEmpty a))
forall (t :: * -> *) a b c.
Traversable t =>
(c -> a -> Either String (c, b))
-> c -> t a -> Either String (c, t b)
traverseLR [a] -> a -> Either String ([a], NonEmpty a)
forall p. [a] -> p -> Either String ([a], NonEmpty a)
g (t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
ta) t a
ta
  case [a]
xs of
    [] -> t (NonEmpty a) -> Either String (t (NonEmpty a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure t (NonEmpty a)
ret
    a
_ : [a]
_ -> String -> Either String (t (NonEmpty a))
forall a b. a -> Either a b
Left String
"extra data at eof"
 where
  g :: [a] -> p -> Either String ([a], NonEmpty a)
  g :: [a] -> p -> Either String ([a], NonEmpty a)
g [a]
s p
_ = case [a]
s of
    [] -> String -> Either String ([a], NonEmpty a)
forall a b. a -> Either a b
Left String
"ran out of data"
    a
a : [a]
as -> ([a], NonEmpty a) -> Either String ([a], NonEmpty a)
forall a b. b -> Either a b
Right ([a]
as, a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
as)

-- | 'Data.List.reverse' for a traversable container
reverseT :: forall a t. Traversable t => t a -> t a
reverseT :: t a -> t a
reverseT = Either String (t a) -> t a
forall a. HasCallStack => Either String a -> a
frp (Either String (t a) -> t a)
-> (t a -> Either String (t a)) -> t a -> t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a]) -> t a -> Either String (t a)
forall (g :: * -> *) a b.
Traversable g =>
([a] -> [b]) -> g a -> Either String (g b)
wrapL [a] -> [a]
forall a. [a] -> [a]
reverse

-- | 'Data.List.sortBy' for a traversable container
sortByT :: forall a t. Traversable t => (a -> a -> Ordering) -> t a -> t a
sortByT :: (a -> a -> Ordering) -> t a -> t a
sortByT a -> a -> Ordering
f = Either String (t a) -> t a
forall a. HasCallStack => Either String a -> a
frp (Either String (t a) -> t a)
-> (t a -> Either String (t a)) -> t a -> t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a]) -> t a -> Either String (t a)
forall (g :: * -> *) a b.
Traversable g =>
([a] -> [b]) -> g a -> Either String (g b)
wrapL ((a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy a -> a -> Ordering
f)

-- | 'N.scanr' for a traversable that drops the last value
postscanr :: Traversable f => (a -> b -> b) -> b -> f a -> f b
postscanr :: (a -> b -> b) -> b -> f a -> f b
postscanr a -> b -> b
f b
c = Either String (f b) -> f b
forall a. HasCallStack => Either String a -> a
frp (Either String (f b) -> f b)
-> (f a -> Either String (f b)) -> f a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [b]) -> f a -> Either String (f b)
forall (g :: * -> *) a b.
Traversable g =>
([a] -> [b]) -> g a -> Either String (g b)
wrapL (NonEmpty b -> [b]
forall a. NonEmpty a -> [a]
N.init (NonEmpty b -> [b]) -> ([a] -> NonEmpty b) -> [a] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> b) -> b -> [a] -> NonEmpty b
forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> f a -> NonEmpty b
N.scanr a -> b -> b
f b
c)

-- | 'N.scanl' for a traversable that drops the first value
postscanl :: Traversable f => (b -> a -> b) -> b -> f a -> f b
postscanl :: (b -> a -> b) -> b -> f a -> f b
postscanl b -> a -> b
f b
c = Either String (f b) -> f b
forall a. HasCallStack => Either String a -> a
frp (Either String (f b) -> f b)
-> (f a -> Either String (f b)) -> f a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [b]) -> f a -> Either String (f b)
forall (g :: * -> *) a b.
Traversable g =>
([a] -> [b]) -> g a -> Either String (g b)
wrapL (NonEmpty b -> [b]
forall a. NonEmpty a -> [a]
N.tail (NonEmpty b -> [b]) -> ([a] -> NonEmpty b) -> [a] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> a -> b) -> b -> [a] -> NonEmpty b
forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> f a -> NonEmpty b
N.scanl b -> a -> b
f b
c)

-- | unzip for a functor of pairs
unzipF :: Functor f => f (a, b) -> (f a, f b)
unzipF :: f (a, b) -> (f a, f b)
unzipF = ((a, b) -> a) -> f (a, b) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> a
forall a b. (a, b) -> a
fst (f (a, b) -> f a) -> (f (a, b) -> f b) -> f (a, b) -> (f a, f b)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((a, b) -> b) -> f (a, b) -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> b
forall a b. (a, b) -> b
snd

-- | reverse a foldable
reverseF :: Foldable t => t a -> [a]
reverseF :: t a -> [a]
reverseF = ([a] -> a -> [a]) -> [a] -> t a -> [a]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) []