{- |
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 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [T [] a]
groupBy a -> a -> Bool
p =
   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 a
x1 [a]
xs : [T [] a]
ys ->
                     if a -> a -> Bool
p a
x0 a
x1
                       then (a
x1forall a. a -> [a] -> [a]
:[a]
xs,[T [] a]
ys)
                       else ([],[T [] a]
yt)
                  [] -> ([],[T [] a]
yt)
         in  forall (f :: * -> *) a. a -> f a -> T f a
NonEmpty.Cons a
x0 [a]
xr forall a. a -> [a] -> [a]
: [T [] a]
yr)
      []

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

groupKey :: (Foldable f, Eq a) => (b -> a) -> f b -> [(a, NonEmpty.T [] b)]
groupKey :: forall (f :: * -> *) a b.
(Foldable f, Eq a) =>
(b -> a) -> f b -> [(a, T [] b)]
groupKey b -> a
f = forall (f :: * -> *) a b.
(Foldable f, Eq a) =>
f (a, b) -> [(a, T [] b)]
groupPairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (f :: * -> *) a b.
Foldable f =>
f (Either a b) -> [Either (T [] a) (T [] b)]
groupEithers =
   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 ->
               forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. a -> f a -> T f a
NonEmpty.Cons a
a) 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 -> (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 ->
               forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. a -> f a -> T f a
NonEmpty.Cons b
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 -> (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 :: forall (f :: * -> *) a.
Foldable f =>
(a -> Bool) -> f a -> ([T [] a], [a])
segmentAfter a -> Bool
p =
   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 (forall (f :: * -> *) a. Empty f => a -> T f a
NonEmpty.singleton a
x forall a. a -> [a] -> [a]
: [T [] a]
ys, [a]
zs)
           else
              case [T [] a]
ys of
                 [] -> ([T [] a]
ys, a
xforall a. a -> [a] -> [a]
:[a]
zs)
                 T [] a
w:[T [] a]
ws -> (forall (f :: * -> *) a. Cons f => a -> f a -> f a
C.cons a
x T [] a
w forall a. a -> [a] -> [a]
: [T [] a]
ws, [a]
zs))
      ([],[])

segmentBefore ::
   (Foldable f) =>
   (a -> Bool) -> f a -> ([a], [NonEmpty.T [] a])
segmentBefore :: forall (f :: * -> *) a.
Foldable f =>
(a -> Bool) -> f a -> ([a], [T [] a])
segmentBefore a -> Bool
p =
   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 ([], forall (f :: * -> *) a. a -> f a -> T f a
NonEmpty.Cons a
x (forall a b. (a, b) -> a
fst ([a], [T [] a])
ys) forall a. a -> [a] -> [a]
: forall a b. (a, b) -> b
snd ([a], [T [] a])
ys)
           else (a
x forall a. a -> [a] -> [a]
: forall a b. (a, b) -> a
fst ([a], [T [] a])
ys, forall a b. (a, b) -> b
snd ([a], [T [] a])
ys))
      ([],[])

filterToInfixes ::
   (Foldable f) =>
   (a -> Bool) -> f a -> [NonEmpty.T [] a]
filterToInfixes :: forall (f :: * -> *) a.
Foldable f =>
(a -> Bool) -> f a -> [T [] a]
filterToInfixes a -> Bool
p =
   let cons :: ([a], [T [] a]) -> [T [] a]
cons = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. ViewL f => f a -> Maybe (T f a)
NonEmpty.fetch
   in  forall {a}. ([a], [T [] a]) -> [T [] a]
cons forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       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 forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (a
xforall a. a -> [a] -> [a]
:) ([a], [T [] a])
yzs
               else ([], 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 :: forall (f :: * -> *) a b.
(Cons f, Zip f) =>
(a -> a -> b) -> T f a -> f b
mapAdjacent a -> a -> b
f T f a
xs =
   forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
C.zipWith a -> a -> b
f (forall (f :: * -> *) a. Cons f => T f a -> f a
NonEmpty.flatten T f a
xs) (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 :: forall (g :: * -> *) (f :: * -> *) a.
(View g, Repeat f, Traversable f) =>
g a -> Maybe (f a)
take = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (g :: * -> *) (f :: * -> *) a.
(View g, Repeat f, Traversable f) =>
g a -> (Maybe (f a), g a)
splitAt g a
xs0 =
   (\(g a
xs1, Maybe (f a)
mys) -> (Maybe (f a)
mys, forall b a. b -> (a -> b) -> Maybe a -> b
maybe g a
xs0 (forall a b. a -> b -> a
const g a
xs1) Maybe (f a)
mys)) forall a b. (a -> b) -> a -> b
$
   forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall a b. (a -> b) -> a -> b
$
   forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL
      (\g a
xt () ->
         case 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, forall a. Maybe a
Nothing)
            Just (a
x,g a
xs) -> (g a
xs, forall a. a -> Maybe a
Just a
x))
      g a
xs0 (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 :: forall (g :: * -> *) (f :: * -> *) a.
(View g, Repeat f, Traversable f) =>
g a -> ([f a], g a)
sliceVertical g a
x0 =
   case 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 -> forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (f a
yforall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ 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 :: forall (f :: * -> *) a.
(ViewR f, Empty f, Cons f) =>
T f a -> (f a, a)
viewR (NonEmpty.Cons a
x f a
xs) =
   case forall (f :: * -> *) a. ViewR f => f a -> Maybe (f a, a)
C.viewR f a
xs of
      Maybe (f a, a)
Nothing -> (forall (f :: * -> *) a. Empty f => f a
C.empty, a
x)
      Just (f a
ys, a
y) -> (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 :: forall (f :: * -> *) a. (ViewR f, Empty f, Cons f) => T f a -> f a
init = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (f :: * -> *) a. ViewR f => T f a -> a
last (NonEmpty.Cons a
x f a
xs) =
   case 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 :: forall (f :: * -> *) a. (ViewL f, Empty f) => f a -> T [] (f a)
tails f a
xt =
   forall (f :: * -> *) a. T f a -> T f a
NonEmpty.force forall a b. (a -> b) -> a -> b
$
   case forall (f :: * -> *) a. ViewL f => f a -> Maybe (a, f a)
C.viewL f a
xt of
      Maybe (a, f a)
Nothing -> forall (f :: * -> *) a. a -> f a -> T f a
NonEmpty.Cons forall (f :: * -> *) a. Empty f => f a
C.empty []
      Just (a
_, f a
xs) -> forall (f :: * -> *) a. Cons f => a -> f a -> f a
C.cons f a
xt forall a b. (a -> b) -> a -> b
$ 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 :: forall (f :: * -> *) a.
(ViewL f, Cons f, Empty f) =>
f a -> T [] (f a)
inits f a
xt =
   forall (f :: * -> *) a. a -> f a -> T f a
NonEmpty.Cons forall (f :: * -> *) a. Empty f => f a
C.empty forall a b. (a -> b) -> a -> b
$
   case 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) -> forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a. Cons f => a -> f a -> f a
C.cons a
x) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Cons f => T f a -> f a
NonEmpty.flatten forall a b. (a -> b) -> a -> b
$ 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 :: forall (f :: * -> *) a. Cons f => [a] -> f a -> f a
appendLeft = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (f :: * -> *) a. Cons f => a -> f a -> f a
C.cons


iterate :: (C.Repeat f, Traversable f) => (a -> a) -> a -> f a
iterate :: forall (f :: * -> *) a.
(Repeat f, Traversable f) =>
(a -> a) -> a -> f a
iterate a -> a
f a
x0 =
   forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (\a
xi a -> a
fi -> (a -> a
fi a
xi, a
xi)) a
x0 forall a b. (a -> b) -> a -> b
$ 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 :: forall a. [a] -> [T a]
choose [a]
_ = [forall a. T a
Empty.Cons]

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

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