{- |
Functions that cope both with plain and non-empty structures.

If there are two versions of a function,
where one works on fixed-length lists,
then place the fixed-length list variant in NonEmpty
and the other one here.
-}
module Data.NonEmpty.Mixed where

import qualified Data.NonEmpty.Foldable as FoldU
import qualified Data.NonEmpty.Class as C
import qualified Data.NonEmpty as NonEmpty
import qualified Data.Empty as Empty
import qualified Data.List.HT as ListHT
import Data.Traversable (Traversable, mapAccumL, sequenceA, )
import Data.Foldable (Foldable, foldr, )
import Data.Tuple.HT (mapFst, mapSnd, )
import Data.Eq.HT (equating, )

import Prelude hiding (splitAt, take, foldr, scanl, scanr, )


groupBy ::
   (Foldable f) =>
   (a -> a -> Bool) -> f a -> [NonEmpty.T [] a]
groupBy :: (a -> a -> Bool) -> f a -> [T [] a]
groupBy a -> a -> Bool
p =
   (a -> [T [] a] -> [T [] a]) -> [T [] a] -> f a -> [T [] a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      (\a
x0 [T [] a]
yt ->
         let ([a]
xr,[T [] a]
yr) =
               case [T [] a]
yt of
                  NonEmpty.Cons x1 xs : ys ->
                     if a -> a -> Bool
p a
x0 a
x1
                       then (a
x1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs,[T [] a]
ys)
                       else ([],[T [] a]
yt)
                  [] -> ([],[T [] a]
yt)
         in  a -> [a] -> T [] a
forall (f :: * -> *) a. a -> f a -> T f a
NonEmpty.Cons a
x0 [a]
xr T [] a -> [T [] a] -> [T [] a]
forall a. a -> [a] -> [a]
: [T [] a]
yr)
      []

groupPairs :: (Foldable f, Eq a) => f (a,b) -> [(a, NonEmpty.T [] b)]
groupPairs :: f (a, b) -> [(a, T [] b)]
groupPairs =
   (T [] (a, b) -> (a, T [] b)) -> [T [] (a, b)] -> [(a, T [] b)]
forall a b. (a -> b) -> [a] -> [b]
map (\T [] (a, b)
xs -> ((a, b) -> a
forall a b. (a, b) -> a
fst ((a, b) -> a) -> (a, b) -> a
forall a b. (a -> b) -> a -> b
$ T [] (a, b) -> (a, b)
forall (f :: * -> *) a. T f a -> a
NonEmpty.head T [] (a, b)
xs, ((a, b) -> b) -> T [] (a, b) -> T [] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> b
forall a b. (a, b) -> b
snd T [] (a, b)
xs)) ([T [] (a, b)] -> [(a, T [] b)])
-> (f (a, b) -> [T [] (a, b)]) -> f (a, b) -> [(a, T [] b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ((a, b) -> (a, b) -> Bool) -> f (a, b) -> [T [] (a, b)]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [T [] a]
groupBy (((a, b) -> a) -> (a, b) -> (a, b) -> Bool
forall b a. Eq b => (a -> b) -> a -> a -> Bool
equating (a, b) -> a
forall a b. (a, b) -> a
fst)

groupKey :: (Foldable f, Eq a) => (b -> a) -> f b -> [(a, NonEmpty.T [] b)]
groupKey :: (b -> a) -> f b -> [(a, T [] b)]
groupKey b -> a
f = Mapped f b (a, b) -> [(a, T [] b)]
forall (f :: * -> *) a b.
(Foldable f, Eq a) =>
f (a, b) -> [(a, T [] b)]
groupPairs (Mapped f b (a, b) -> [(a, T [] b)])
-> (f b -> Mapped f b (a, b)) -> f b -> [(a, T [] b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> (a, b)) -> f b -> Mapped f b (a, b)
forall (f :: * -> *) a b. (a -> b) -> f a -> Mapped f a b
FoldU.Mapped (\b
b -> (b -> a
f b
b, b
b))

groupEithers ::
   (Foldable f) =>
   f (Either a b) -> [Either (NonEmpty.T [] a) (NonEmpty.T [] b)]
groupEithers :: f (Either a b) -> [Either (T [] a) (T [] b)]
groupEithers =
   (Either a b
 -> [Either (T [] a) (T [] b)] -> [Either (T [] a) (T [] b)])
-> [Either (T [] a) (T [] b)]
-> f (Either a b)
-> [Either (T [] a) (T [] b)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      (\Either a b
x [Either (T [] a) (T [] b)]
xs ->
         case Either a b
x of
            Left a
a ->
               (Either (T [] a) (T [] b)
 -> [Either (T [] a) (T [] b)] -> [Either (T [] a) (T [] b)])
-> (Either (T [] a) (T [] b), [Either (T [] a) (T [] b)])
-> [Either (T [] a) (T [] b)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) ((Either (T [] a) (T [] b), [Either (T [] a) (T [] b)])
 -> [Either (T [] a) (T [] b)])
-> (Either (T [] a) (T [] b), [Either (T [] a) (T [] b)])
-> [Either (T [] a) (T [] b)]
forall a b. (a -> b) -> a -> b
$ ([a] -> Either (T [] a) (T [] b))
-> ([a], [Either (T [] a) (T [] b)])
-> (Either (T [] a) (T [] b), [Either (T [] a) (T [] b)])
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (T [] a -> Either (T [] a) (T [] b)
forall a b. a -> Either a b
Left (T [] a -> Either (T [] a) (T [] b))
-> ([a] -> T [] a) -> [a] -> Either (T [] a) (T [] b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a] -> T [] a
forall (f :: * -> *) a. a -> f a -> T f a
NonEmpty.Cons a
a) (([a], [Either (T [] a) (T [] b)])
 -> (Either (T [] a) (T [] b), [Either (T [] a) (T [] b)]))
-> ([a], [Either (T [] a) (T [] b)])
-> (Either (T [] a) (T [] b), [Either (T [] a) (T [] b)])
forall a b. (a -> b) -> a -> b
$
               case [Either (T [] a) (T [] b)]
xs of
                  Left T [] a
as : [Either (T [] a) (T [] b)]
ys -> (T [] a -> [a]
forall (f :: * -> *) a. Cons f => T f a -> f a
NonEmpty.flatten T [] a
as, [Either (T [] a) (T [] b)]
ys)
                  [Either (T [] a) (T [] b)]
ys -> ([], [Either (T [] a) (T [] b)]
ys)
            Right b
b ->
               (Either (T [] a) (T [] b)
 -> [Either (T [] a) (T [] b)] -> [Either (T [] a) (T [] b)])
-> (Either (T [] a) (T [] b), [Either (T [] a) (T [] b)])
-> [Either (T [] a) (T [] b)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) ((Either (T [] a) (T [] b), [Either (T [] a) (T [] b)])
 -> [Either (T [] a) (T [] b)])
-> (Either (T [] a) (T [] b), [Either (T [] a) (T [] b)])
-> [Either (T [] a) (T [] b)]
forall a b. (a -> b) -> a -> b
$ ([b] -> Either (T [] a) (T [] b))
-> ([b], [Either (T [] a) (T [] b)])
-> (Either (T [] a) (T [] b), [Either (T [] a) (T [] b)])
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (T [] b -> Either (T [] a) (T [] b)
forall a b. b -> Either a b
Right (T [] b -> Either (T [] a) (T [] b))
-> ([b] -> T [] b) -> [b] -> Either (T [] a) (T [] b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> [b] -> T [] b
forall (f :: * -> *) a. a -> f a -> T f a
NonEmpty.Cons b
b) (([b], [Either (T [] a) (T [] b)])
 -> (Either (T [] a) (T [] b), [Either (T [] a) (T [] b)]))
-> ([b], [Either (T [] a) (T [] b)])
-> (Either (T [] a) (T [] b), [Either (T [] a) (T [] b)])
forall a b. (a -> b) -> a -> b
$
               case [Either (T [] a) (T [] b)]
xs of
                  Right T [] b
bs : [Either (T [] a) (T [] b)]
ys -> (T [] b -> [b]
forall (f :: * -> *) a. Cons f => T f a -> f a
NonEmpty.flatten T [] b
bs, [Either (T [] a) (T [] b)]
ys)
                  [Either (T [] a) (T [] b)]
ys -> ([], [Either (T [] a) (T [] b)]
ys))
      []


segmentAfter ::
   (Foldable f) =>
   (a -> Bool) -> f a -> ([NonEmpty.T [] a], [a])
segmentAfter :: (a -> Bool) -> f a -> ([T [] a], [a])
segmentAfter a -> Bool
p =
   (a -> ([T [] a], [a]) -> ([T [] a], [a]))
-> ([T [] a], [a]) -> f a -> ([T [] a], [a])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      (\a
x ~([T [] a]
ys,[a]
zs) ->
         if a -> Bool
p a
x
           then (a -> T [] a
forall (f :: * -> *) a. Empty f => a -> T f a
NonEmpty.singleton a
x T [] a -> [T [] a] -> [T [] a]
forall a. a -> [a] -> [a]
: [T [] a]
ys, [a]
zs)
           else
              case [T [] a]
ys of
                 [] -> ([T [] a]
ys, a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
zs)
                 T [] a
w:[T [] a]
ws -> (a -> T [] a -> T [] a
forall (f :: * -> *) a. Cons f => a -> f a -> f a
C.cons a
x T [] a
w T [] a -> [T [] a] -> [T [] a]
forall a. a -> [a] -> [a]
: [T [] a]
ws, [a]
zs))
      ([],[])

segmentBefore ::
   (Foldable f) =>
   (a -> Bool) -> f a -> ([a], [NonEmpty.T [] a])
segmentBefore :: (a -> Bool) -> f a -> ([a], [T [] a])
segmentBefore a -> Bool
p =
   (a -> ([a], [T [] a]) -> ([a], [T [] a]))
-> ([a], [T [] a]) -> f a -> ([a], [T [] a])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      (\ a
x ([a], [T [] a])
ys ->
         if a -> Bool
p a
x
           then ([], a -> [a] -> T [] a
forall (f :: * -> *) a. a -> f a -> T f a
NonEmpty.Cons a
x (([a], [T [] a]) -> [a]
forall a b. (a, b) -> a
fst ([a], [T [] a])
ys) T [] a -> [T [] a] -> [T [] a]
forall a. a -> [a] -> [a]
: ([a], [T [] a]) -> [T [] a]
forall a b. (a, b) -> b
snd ([a], [T [] a])
ys)
           else (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ([a], [T [] a]) -> [a]
forall a b. (a, b) -> a
fst ([a], [T [] a])
ys, ([a], [T [] a]) -> [T [] a]
forall a b. (a, b) -> b
snd ([a], [T [] a])
ys))
      ([],[])

filterToInfixes ::
   (Foldable f) =>
   (a -> Bool) -> f a -> [NonEmpty.T [] a]
filterToInfixes :: (a -> Bool) -> f a -> [T [] a]
filterToInfixes a -> Bool
p =
   let cons :: ([a], [T [] a]) -> [T [] a]
cons = ([a] -> [T [] a] -> [T [] a]) -> ([a], [T [] a]) -> [T [] a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (([a] -> [T [] a] -> [T [] a]) -> ([a], [T [] a]) -> [T [] a])
-> ([a] -> [T [] a] -> [T [] a]) -> ([a], [T [] a]) -> [T [] a]
forall a b. (a -> b) -> a -> b
$ ([T [] a] -> [T [] a])
-> (T [] a -> [T [] a] -> [T [] a])
-> Maybe (T [] a)
-> [T [] a]
-> [T [] a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [T [] a] -> [T [] a]
forall a. a -> a
id (:) (Maybe (T [] a) -> [T [] a] -> [T [] a])
-> ([a] -> Maybe (T [] a)) -> [a] -> [T [] a] -> [T [] a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (T [] a)
forall (f :: * -> *) a. ViewL f => f a -> Maybe (T f a)
NonEmpty.fetch
   in  ([a], [T [] a]) -> [T [] a]
forall a. ([a], [T [] a]) -> [T [] a]
cons (([a], [T [] a]) -> [T [] a])
-> (f a -> ([a], [T [] a])) -> f a -> [T [] a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       (a -> ([a], [T [] a]) -> ([a], [T [] a]))
-> ([a], [T [] a]) -> f a -> ([a], [T [] a])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
          (\a
x ([a], [T [] a])
yzs ->
             if a -> Bool
p a
x
               then ([a] -> [a]) -> ([a], [T [] a]) -> ([a], [T [] a])
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a], [T [] a])
yzs
               else ([], ([a], [T [] a]) -> [T [] a]
forall a. ([a], [T [] a]) -> [T [] a]
cons ([a], [T [] a])
yzs))
          ([], [])

mapAdjacent ::
   (C.Cons f, C.Zip f) => (a -> a -> b) -> NonEmpty.T f a -> f b
mapAdjacent :: (a -> a -> b) -> T f a -> f b
mapAdjacent a -> a -> b
f T f a
xs =
   (a -> a -> b) -> f a -> f a -> f b
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
C.zipWith a -> a -> b
f (T f a -> f a
forall (f :: * -> *) a. Cons f => T f a -> f a
NonEmpty.flatten T f a
xs) (T f a -> f a
forall (f :: * -> *) a. T f a -> f a
NonEmpty.tail T f a
xs)


take ::
   (C.View g, C.Repeat f, Traversable f) =>
   g a -> Maybe (f a)
take :: g a -> Maybe (f a)
take = (Maybe (f a), g a) -> Maybe (f a)
forall a b. (a, b) -> a
fst ((Maybe (f a), g a) -> Maybe (f a))
-> (g a -> (Maybe (f a), g a)) -> g a -> Maybe (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g a -> (Maybe (f a), g a)
forall (g :: * -> *) (f :: * -> *) a.
(View g, Repeat f, Traversable f) =>
g a -> (Maybe (f a), g a)
splitAt

splitAt ::
   (C.View g, C.Repeat f, Traversable f) =>
   g a -> (Maybe (f a), g a)
splitAt :: g a -> (Maybe (f a), g a)
splitAt g a
xs0 =
   (\(g a
xs1, Maybe (f a)
mys) -> (Maybe (f a)
mys, g a -> (f a -> g a) -> Maybe (f a) -> g a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe g a
xs0 (g a -> f a -> g a
forall a b. a -> b -> a
const g a
xs1) Maybe (f a)
mys)) ((g a, Maybe (f a)) -> (Maybe (f a), g a))
-> (g a, Maybe (f a)) -> (Maybe (f a), g a)
forall a b. (a -> b) -> a -> b
$
   (f (Maybe a) -> Maybe (f a))
-> (g a, f (Maybe a)) -> (g a, Maybe (f a))
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd f (Maybe a) -> Maybe (f a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ((g a, f (Maybe a)) -> (g a, Maybe (f a)))
-> (g a, f (Maybe a)) -> (g a, Maybe (f a))
forall a b. (a -> b) -> a -> b
$
   (g a -> () -> (g a, Maybe a)) -> g a -> f () -> (g a, f (Maybe a))
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL
      (\g a
xt () ->
         case g a -> Maybe (a, g a)
forall (f :: * -> *) a. ViewL f => f a -> Maybe (a, f a)
C.viewL g a
xt of
            Maybe (a, g a)
Nothing -> (g a
xt, Maybe a
forall a. Maybe a
Nothing)
            Just (a
x,g a
xs) -> (g a
xs, a -> Maybe a
forall a. a -> Maybe a
Just a
x))
      g a
xs0 (() -> f ()
forall (f :: * -> *) a. Repeat f => a -> f a
C.repeat ())

sliceVertical ::
   (C.View g, C.Repeat f, Traversable f) =>
   g a -> ([f a], g a)
sliceVertical :: g a -> ([f a], g a)
sliceVertical g a
x0 =
   case g a -> (Maybe (f a), g a)
forall (g :: * -> *) (f :: * -> *) a.
(View g, Repeat f, Traversable f) =>
g a -> (Maybe (f a), g a)
splitAt g a
x0 of
      (Maybe (f a)
my,g a
x1) ->
         case Maybe (f a)
my of
            Maybe (f a)
Nothing -> ([], g a
x1)
            Just f a
y -> ([f a] -> [f a]) -> ([f a], g a) -> ([f a], g a)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (f a
yf a -> [f a] -> [f a]
forall a. a -> [a] -> [a]
:) (([f a], g a) -> ([f a], g a)) -> ([f a], g a) -> ([f a], g a)
forall a b. (a -> b) -> a -> b
$ g a -> ([f a], g a)
forall (g :: * -> *) (f :: * -> *) a.
(View g, Repeat f, Traversable f) =>
g a -> ([f a], g a)
sliceVertical g a
x1



{- |
This implementation is more efficient for Sequence than 'NonEmpty.viewR'.
-}
viewR :: (C.ViewR f, C.Empty f, C.Cons f) => NonEmpty.T f a -> (f a, a)
viewR :: T f a -> (f a, a)
viewR (NonEmpty.Cons a
x f a
xs) =
   case f a -> Maybe (f a, a)
forall (f :: * -> *) a. ViewR f => f a -> Maybe (f a, a)
C.viewR f a
xs of
      Maybe (f a, a)
Nothing -> (f a
forall (f :: * -> *) a. Empty f => f a
C.empty, a
x)
      Just (f a
ys, a
y) -> (a -> f a -> f a
forall (f :: * -> *) a. Cons f => a -> f a -> f a
C.cons a
x f a
ys, a
y)

init :: (C.ViewR f, C.Empty f, C.Cons f) => NonEmpty.T f a -> f a
init :: T f a -> f a
init = (f a, a) -> f a
forall a b. (a, b) -> a
fst ((f a, a) -> f a) -> (T f a -> (f a, a)) -> T f a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T f a -> (f a, a)
forall (f :: * -> *) a.
(ViewR f, Empty f, Cons f) =>
T f a -> (f a, a)
viewR

last :: (C.ViewR f) => NonEmpty.T f a -> a
last :: T f a -> a
last (NonEmpty.Cons a
x f a
xs) =
   case f a -> Maybe (f a, a)
forall (f :: * -> *) a. ViewR f => f a -> Maybe (f a, a)
C.viewR f a
xs of
      Maybe (f a, a)
Nothing -> a
x
      Just (f a
_, a
y) -> a
y


tails ::
   (C.ViewL f, C.Empty f) =>
   f a -> NonEmpty.T [] (f a)
tails :: f a -> T [] (f a)
tails f a
xt =
   T [] (f a) -> T [] (f a)
forall (f :: * -> *) a. T f a -> T f a
NonEmpty.force (T [] (f a) -> T [] (f a)) -> T [] (f a) -> T [] (f a)
forall a b. (a -> b) -> a -> b
$
   case f a -> Maybe (a, f a)
forall (f :: * -> *) a. ViewL f => f a -> Maybe (a, f a)
C.viewL f a
xt of
      Maybe (a, f a)
Nothing -> f a -> [f a] -> T [] (f a)
forall (f :: * -> *) a. a -> f a -> T f a
NonEmpty.Cons f a
forall (f :: * -> *) a. Empty f => f a
C.empty []
      Just (a
_, f a
xs) -> f a -> T [] (f a) -> T [] (f a)
forall (f :: * -> *) a. Cons f => a -> f a -> f a
C.cons f a
xt (T [] (f a) -> T [] (f a)) -> T [] (f a) -> T [] (f a)
forall a b. (a -> b) -> a -> b
$ f a -> T [] (f a)
forall (f :: * -> *) a. (ViewL f, Empty f) => f a -> T [] (f a)
tails f a
xs

inits ::
   (C.ViewL f, C.Cons f, C.Empty f) =>
   f a -> NonEmpty.T [] (f a)
inits :: f a -> T [] (f a)
inits f a
xt =
   f a -> [f a] -> T [] (f a)
forall (f :: * -> *) a. a -> f a -> T f a
NonEmpty.Cons f a
forall (f :: * -> *) a. Empty f => f a
C.empty ([f a] -> T [] (f a)) -> [f a] -> T [] (f a)
forall a b. (a -> b) -> a -> b
$
   case f a -> Maybe (a, f a)
forall (f :: * -> *) a. ViewL f => f a -> Maybe (a, f a)
C.viewL f a
xt of
      Maybe (a, f a)
Nothing -> []
      Just (a
x,f a
xs) -> (f a -> f a) -> [f a] -> [f a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> f a -> f a
forall (f :: * -> *) a. Cons f => a -> f a -> f a
C.cons a
x) ([f a] -> [f a]) -> [f a] -> [f a]
forall a b. (a -> b) -> a -> b
$ T [] (f a) -> [f a]
forall (f :: * -> *) a. Cons f => T f a -> f a
NonEmpty.flatten (T [] (f a) -> [f a]) -> T [] (f a) -> [f a]
forall a b. (a -> b) -> a -> b
$ f a -> T [] (f a)
forall (f :: * -> *) a.
(ViewL f, Cons f, Empty f) =>
f a -> T [] (f a)
inits f a
xs


appendLeft :: (C.Cons f) => [a] -> f a -> f a
appendLeft :: [a] -> f a -> f a
appendLeft = (f a -> [a] -> f a) -> [a] -> f a -> f a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((f a -> [a] -> f a) -> [a] -> f a -> f a)
-> (f a -> [a] -> f a) -> [a] -> f a -> f a
forall a b. (a -> b) -> a -> b
$ (a -> f a -> f a) -> f a -> [a] -> f a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> f a -> f a
forall (f :: * -> *) a. Cons f => a -> f a -> f a
C.cons


iterate :: (C.Repeat f, Traversable f) => (a -> a) -> a -> f a
iterate :: (a -> a) -> a -> f a
iterate a -> a
f a
x0 =
   (a, f a) -> f a
forall a b. (a, b) -> b
snd ((a, f a) -> f a) -> (a, f a) -> f a
forall a b. (a -> b) -> a -> b
$ (a -> (a -> a) -> (a, a)) -> a -> f (a -> a) -> (a, f a)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (\a
xi a -> a
fi -> (a -> a
fi a
xi, a
xi)) a
x0 (f (a -> a) -> (a, f a)) -> f (a -> a) -> (a, f a)
forall a b. (a -> b) -> a -> b
$ (a -> a) -> f (a -> a)
forall (f :: * -> *) a. Repeat f => a -> f a
C.repeat a -> a
f


class Choose f where
   {- |
   Select tuples of list elements:
   @choose "abc" == ['a'!:'b'!:empty,'a'!:'c'!:empty,'b'!:'c'!:empty]@
   -}
   choose :: [a] -> [f a]

instance Choose Empty.T where
   choose :: [a] -> [T a]
choose [a]
_ = [T a
forall a. T a
Empty.Cons]

instance (Choose f) => Choose (NonEmpty.T f) where
   choose :: [a] -> [T f a]
choose [a]
xs = do
      (a
y:[a]
ys) <- [a] -> [[a]]
forall a. [a] -> [[a]]
ListHT.tails [a]
xs
      (f a -> T f a) -> [f a] -> [T f a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> f a -> T f a
forall a (f :: * -> *). a -> f a -> T f a
NonEmpty.cons a
y) ([f a] -> [T f a]) -> [f a] -> [T f a]
forall a b. (a -> b) -> a -> b
$ [a] -> [f a]
forall (f :: * -> *) a. Choose f => [a] -> [f a]
choose [a]
ys

instance Choose [] where
   choose :: [a] -> [[a]]
choose [] = [[]]
   choose (a
x:[a]
xs) =
      let ys :: [[a]]
ys = [a] -> [[a]]
forall (f :: * -> *) a. Choose f => [a] -> [f a]
choose [a]
xs
      in  ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) [[a]]
ys [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]]
ys