{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

{- |
Module      : Primus.List
Description : list functions
Copyright   : (c) Grant Weyburne, 2022
License     : BSD-3
-}
module Primus.List (
  -- * partition methods
  partitionEithersL,
  partitionEithersL',
  partitionTheseL,
  partitionTheseL',
  partitionM,

  -- * span methods
  spanMaybe,
  spanMaybe',
  lengthExact,
  zipWithLongest,
  zipLongest,

  -- * chunking
  pairsOf1,
  pairsOf2,
  pairsOf',
  chunksOf,

  -- * split methods
  splitAtLGE,
  splits,
  SplitL (..),
  splitAtL,
  atL,
  atNoteL,
  updateAtL,
  setAtL,

  -- * miscellaneous
  allEqual,
  allEqualBy,
  snocL,
  unsnocL,
  unsnocL',
    list,
    list',
  listSnoc,
) where

import Control.Arrow
import Data.Bool
import Data.Either
import qualified Data.List as L
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as N
import Data.Pos
import Data.These
import GHC.Stack
import Primus.Bool
import Primus.Error

-- | split a list into overlapping pairs plus overflow
pairsOf1 :: [a] -> ([(a, a)], Maybe a)
pairsOf1 :: [a] -> ([(a, a)], Maybe a)
pairsOf1 = Pos -> [a] -> ([(a, a)], Maybe a)
forall a. Pos -> [a] -> ([(a, a)], Maybe a)
pairsOf' Pos
_1P

-- | split a list into non-overlapping pairs plus overflow
pairsOf2 :: [a] -> ([(a, a)], Maybe a)
pairsOf2 :: [a] -> ([(a, a)], Maybe a)
pairsOf2 = Pos -> [a] -> ([(a, a)], Maybe a)
forall a. Pos -> [a] -> ([(a, a)], Maybe a)
pairsOf' Pos
_2P

-- | split into pairs skipping given number of values
pairsOf' :: forall a. Pos -> [a] -> ([(a, a)], Maybe a)
pairsOf' :: Pos -> [a] -> ([(a, a)], Maybe a)
pairsOf' (Pos Int
i) = [a] -> ([(a, a)], Maybe a)
go
 where
  go :: [a] -> ([(a, a)], Maybe a)
  go :: [a] -> ([(a, a)], Maybe a)
go =
    \case
      [] -> ([], Maybe a
forall a. Maybe a
Nothing)
      [a
a] -> ([], a -> Maybe a
forall a. a -> Maybe a
Just a
a)
      [a
a, a
a'] -> ([(a
a, a
a')], Maybe a
forall a. Maybe a
Nothing)
      (a
a : a
a' : a
a'' : [a]
as) ->
        let ([(a, a)]
x, Maybe a
y) = [a] -> ([(a, a)], Maybe a)
go (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (a
a' a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
a'' a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as))
         in ((a
a, a
a') (a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
: [(a, a)]
x, Maybe a
y)

-- | simple utility for chunking data but guarantees we make progress
chunksOf :: forall a. Pos -> [a] -> [[a]]
chunksOf :: Pos -> [a] -> [[a]]
chunksOf (Pos Int
n) = ([a] -> Maybe ([a], [a])) -> [a] -> [[a]]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
L.unfoldr [a] -> Maybe ([a], [a])
f
 where
  f :: [a] -> Maybe ([a], [a])
  f :: [a] -> Maybe ([a], [a])
f = \case
    [] -> Maybe ([a], [a])
forall a. Maybe a
Nothing
    xs :: [a]
xs@(a
_ : [a]
_) -> ([a], [a]) -> Maybe ([a], [a])
forall a. a -> Maybe a
Just (Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
xs)

-- | checks that the list has all the same values
allEqual :: Eq a => [a] -> Either (a, a) ()
allEqual :: [a] -> Either (a, a) ()
allEqual = (a -> a -> Bool) -> [a] -> Either (a, a) ()
forall a. (a -> a -> Bool) -> [a] -> Either (a, a) ()
allEqualBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | checks that the list has all the same values with a predicate
allEqualBy :: (a -> a -> Bool) -> [a] -> Either (a, a) ()
allEqualBy :: (a -> a -> Bool) -> [a] -> Either (a, a) ()
allEqualBy a -> a -> Bool
f =
  \case
    [] -> () -> Either (a, a) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    [a
_] -> () -> Either (a, a) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    a
x : a
x' : [a]
xs
      | a -> a -> Bool
f a
x a
x' -> (a -> a -> Bool) -> [a] -> Either (a, a) ()
forall a. (a -> a -> Bool) -> [a] -> Either (a, a) ()
allEqualBy a -> a -> Bool
f (a
x' a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)
      | Bool
otherwise -> (a, a) -> Either (a, a) ()
forall a b. a -> Either a b
Left (a
x, a
x')

-- | represents the status of a split on a list
data SplitL a
  = SplitLNeg !Pos
  | SplitLLT !Int
  | SplitLEQ
  | SplitLGT !(NonEmpty a)
  deriving stock (Eq (SplitL a)
Eq (SplitL a)
-> (SplitL a -> SplitL a -> Ordering)
-> (SplitL a -> SplitL a -> Bool)
-> (SplitL a -> SplitL a -> Bool)
-> (SplitL a -> SplitL a -> Bool)
-> (SplitL a -> SplitL a -> Bool)
-> (SplitL a -> SplitL a -> SplitL a)
-> (SplitL a -> SplitL a -> SplitL a)
-> Ord (SplitL a)
SplitL a -> SplitL a -> Bool
SplitL a -> SplitL a -> Ordering
SplitL a -> SplitL a -> SplitL a
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 a. Ord a => Eq (SplitL a)
forall a. Ord a => SplitL a -> SplitL a -> Bool
forall a. Ord a => SplitL a -> SplitL a -> Ordering
forall a. Ord a => SplitL a -> SplitL a -> SplitL a
min :: SplitL a -> SplitL a -> SplitL a
$cmin :: forall a. Ord a => SplitL a -> SplitL a -> SplitL a
max :: SplitL a -> SplitL a -> SplitL a
$cmax :: forall a. Ord a => SplitL a -> SplitL a -> SplitL a
>= :: SplitL a -> SplitL a -> Bool
$c>= :: forall a. Ord a => SplitL a -> SplitL a -> Bool
> :: SplitL a -> SplitL a -> Bool
$c> :: forall a. Ord a => SplitL a -> SplitL a -> Bool
<= :: SplitL a -> SplitL a -> Bool
$c<= :: forall a. Ord a => SplitL a -> SplitL a -> Bool
< :: SplitL a -> SplitL a -> Bool
$c< :: forall a. Ord a => SplitL a -> SplitL a -> Bool
compare :: SplitL a -> SplitL a -> Ordering
$ccompare :: forall a. Ord a => SplitL a -> SplitL a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (SplitL a)
Ord, Int -> SplitL a -> ShowS
[SplitL a] -> ShowS
SplitL a -> String
(Int -> SplitL a -> ShowS)
-> (SplitL a -> String) -> ([SplitL a] -> ShowS) -> Show (SplitL a)
forall a. Show a => Int -> SplitL a -> ShowS
forall a. Show a => [SplitL a] -> ShowS
forall a. Show a => SplitL a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SplitL a] -> ShowS
$cshowList :: forall a. Show a => [SplitL a] -> ShowS
show :: SplitL a -> String
$cshow :: forall a. Show a => SplitL a -> String
showsPrec :: Int -> SplitL a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> SplitL a -> ShowS
Show, SplitL a -> SplitL a -> Bool
(SplitL a -> SplitL a -> Bool)
-> (SplitL a -> SplitL a -> Bool) -> Eq (SplitL a)
forall a. Eq a => SplitL a -> SplitL a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SplitL a -> SplitL a -> Bool
$c/= :: forall a. Eq a => SplitL a -> SplitL a -> Bool
== :: SplitL a -> SplitL a -> Bool
$c== :: forall a. Eq a => SplitL a -> SplitL a -> Bool
Eq)

-- | split a list preserving information about the split
splitAtL :: forall a. Int -> [a] -> ([a], SplitL a)
splitAtL :: Int -> [a] -> ([a], SplitL a)
splitAtL Int
n [a]
xs
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = ([a]
xs, Pos -> SplitL a
forall a. Pos -> SplitL a
SplitLNeg (HasCallStack => String -> Int -> Pos
String -> Int -> Pos
unsafePos String
"splitAtL" (-Int
n)))
  | Bool
otherwise = Int -> [a] -> ([a], SplitL a)
go Int
0 [a]
xs
 where
  go :: Int -> [a] -> ([a], SplitL a)
  go :: Int -> [a] -> ([a], SplitL a)
go Int
i []
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = ([], SplitL a
forall a. SplitL a
SplitLEQ)
    | Bool
otherwise = ([], Int -> SplitL a
forall a. Int -> SplitL a
SplitLLT Int
i)
  go Int
i (a
a : [a]
as)
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = ([], NonEmpty a -> SplitL a
forall a. NonEmpty a -> SplitL a
SplitLGT (a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
as))
    | Bool
otherwise = ([a] -> [a]) -> ([a], SplitL a) -> ([a], SplitL a)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (Int -> [a] -> ([a], SplitL a)
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
as)

-- | split a list but has to have enough elements else fails
splitAtLGE :: Int -> [a] -> Either String ([a], [a])
splitAtLGE :: Int -> [a] -> Either String ([a], [a])
splitAtLGE Int
n [a]
as =
  let ([a]
ns, SplitL a
z) = Int -> [a] -> ([a], SplitL a)
forall a. Int -> [a] -> ([a], SplitL a)
splitAtL Int
n [a]
as
   in ([a]
ns,) ([a] -> ([a], [a]))
-> Either String [a] -> Either String ([a], [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case SplitL a
z of
        SplitLNeg (Pos Int
j) -> String -> Either String [a]
forall a b. a -> Either a b
Left (String -> Either String [a]) -> String -> Either String [a]
forall a b. (a -> b) -> a -> b
$ String
"negative index " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
j
        SplitLLT Int
len -> String -> Either String [a]
forall a b. a -> Either a b
Left (String -> Either String [a]) -> String -> Either String [a]
forall a b. (a -> b) -> a -> b
$ String
"not enough elements: expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" found " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
len
        SplitL a
SplitLEQ -> [a] -> Either String [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
forall a. Monoid a => a
mempty
        SplitLGT NonEmpty a
ex -> [a] -> Either String [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
N.toList NonEmpty a
ex)

-- | set a value at a given index in a list
setAtL :: Int -> a -> [a] -> Maybe [a]
setAtL :: Int -> a -> [a] -> Maybe [a]
setAtL Int
i0 = Int -> (a -> a) -> [a] -> Maybe [a]
forall a. Int -> (a -> a) -> [a] -> Maybe [a]
updateAtL Int
i0 ((a -> a) -> [a] -> Maybe [a])
-> (a -> a -> a) -> a -> [a] -> Maybe [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a b. a -> b -> a
const

-- | update a value at a given index in a list
updateAtL :: Int -> (a -> a) -> [a] -> Maybe [a]
updateAtL :: Int -> (a -> a) -> [a] -> Maybe [a]
updateAtL Int
i a -> a
f [a]
as0 =
  case Int -> [a] -> Either String (a, ([a], [a]))
forall a. Int -> [a] -> Either String (a, ([a], [a]))
atLImpl Int
i [a]
as0 of
    Right (a
a, ([a]
xs, [a]
ys)) -> [a] -> Maybe [a]
forall a. a -> Maybe a
Just ([a]
xs [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> (a -> a
f a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys))
    Left String
_ -> Maybe [a]
forall a. Maybe a
Nothing

-- | update a value at a given index in a list
atLImpl :: Int -> [a] -> Either String (a, ([a], [a]))
atLImpl :: Int -> [a] -> Either String (a, ([a], [a]))
atLImpl Int
i [a]
as0 =
  let ([a]
xs, SplitL a
ys) = Int -> [a] -> ([a], SplitL a)
forall a. Int -> [a] -> ([a], SplitL a)
splitAtL Int
i [a]
as0
   in case SplitL a
ys of
        SplitLNeg (Pos Int
j) -> String -> Either String (a, ([a], [a]))
forall a b. a -> Either a b
Left (String -> Either String (a, ([a], [a])))
-> String -> Either String (a, ([a], [a]))
forall a b. (a -> b) -> a -> b
$ String
"negative index " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
j
        SplitLLT Int
_ -> String -> Either String (a, ([a], [a]))
forall a b. a -> Either a b
Left (String -> Either String (a, ([a], [a])))
-> String -> Either String (a, ([a], [a]))
forall a b. (a -> b) -> a -> b
$ String
"LT: i=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" out of bounds"
        SplitL a
SplitLEQ -> String -> Either String (a, ([a], [a]))
forall a b. a -> Either a b
Left (String -> Either String (a, ([a], [a])))
-> String -> Either String (a, ([a], [a]))
forall a b. (a -> b) -> a -> b
$ String
"EQ: i=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" out of bounds"
        SplitLGT (a
a :| [a]
as) -> (a, ([a], [a])) -> Either String (a, ([a], [a]))
forall a b. b -> Either a b
Right (a
a, ([a]
xs, [a]
as))

-- | index into a list
atL :: Int -> [a] -> Maybe a
atL :: Int -> [a] -> Maybe a
atL = (String -> Maybe a)
-> ((a, ([a], [a])) -> Maybe a)
-> Either String (a, ([a], [a]))
-> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> String -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a)
-> ((a, ([a], [a])) -> a) -> (a, ([a], [a])) -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, ([a], [a])) -> a
forall a b. (a, b) -> a
fst) (Either String (a, ([a], [a])) -> Maybe a)
-> (Int -> [a] -> Either String (a, ([a], [a])))
-> Int
-> [a]
-> Maybe a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ Int -> [a] -> Either String (a, ([a], [a]))
forall a. Int -> [a] -> Either String (a, ([a], [a]))
atLImpl

-- | unsafe index into a list
atNoteL :: HasCallStack => String -> [a] -> Int -> a
atNoteL :: String -> [a] -> Int -> a
atNoteL String
msg = (a, ([a], [a])) -> a
forall a b. (a, b) -> a
fst ((a, ([a], [a])) -> a)
-> (Either String (a, ([a], [a])) -> (a, ([a], [a])))
-> Either String (a, ([a], [a]))
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String (a, ([a], [a])) -> (a, ([a], [a]))
forall a. HasCallStack => String -> Either String a -> a
forceRight String
msg (Either String (a, ([a], [a])) -> a)
-> ([a] -> Int -> Either String (a, ([a], [a]))) -> [a] -> Int -> a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ (Int -> [a] -> Either String (a, ([a], [a])))
-> [a] -> Int -> Either String (a, ([a], [a]))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> [a] -> Either String (a, ([a], [a]))
forall a. Int -> [a] -> Either String (a, ([a], [a]))
atLImpl

-- | compares the length of a potentially infinite list with "n" and succeeds if they are the same
lengthExact :: Int -> [a] -> Either String [a]
lengthExact :: Int -> [a] -> Either String [a]
lengthExact Int
n [a]
xs =
  let ([a]
as, SplitL a
z) = Int -> [a] -> ([a], SplitL a)
forall a. Int -> [a] -> ([a], SplitL a)
splitAtL Int
n [a]
xs
   in case SplitL a
z of
        SplitLNeg (Pos Int
j) -> String -> Either String [a]
forall a b. a -> Either a b
Left (String -> Either String [a]) -> String -> Either String [a]
forall a b. (a -> b) -> a -> b
$ String
"negative index " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
j
        SplitLLT Int
len -> String -> Either String [a]
forall a b. a -> Either a b
Left (String -> Either String [a]) -> String -> Either String [a]
forall a b. (a -> b) -> a -> b
$ String
"LT: expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" found " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
len
        SplitL a
SplitLEQ -> [a] -> Either String [a]
forall a b. b -> Either a b
Right [a]
as
        SplitLGT NonEmpty a
_ -> String -> Either String [a]
forall a b. a -> Either a b
Left (String -> Either String [a]) -> String -> Either String [a]
forall a b. (a -> b) -> a -> b
$ String
"GT: too many elements: expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

-- | creates the longest of the two lists: fills with 'This' or 'That'
zipWithLongest :: forall a b c. (These a b -> c) -> [a] -> [b] -> [c]
zipWithLongest :: (These a b -> c) -> [a] -> [b] -> [c]
zipWithLongest These a b -> c
f = ([a], [b]) -> [c]
go (([a], [b]) -> [c])
-> ([a] -> [b] -> ([a], [b])) -> [a] -> [b] -> [c]
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ (,)
 where
  go :: ([a], [b]) -> [c]
go = \case
    ([], []) -> []
    (xs :: [a]
xs@(a
_ : [a]
_), []) -> (a -> c) -> [a] -> [c]
forall a b. (a -> b) -> [a] -> [b]
map (These a b -> c
f (These a b -> c) -> (a -> These a b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> These a b
forall a b. a -> These a b
This) [a]
xs
    ([], ys :: [b]
ys@(b
_ : [b]
_)) -> (b -> c) -> [b] -> [c]
forall a b. (a -> b) -> [a] -> [b]
map (These a b -> c
f (These a b -> c) -> (b -> These a b) -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> These a b
forall a b. b -> These a b
That) [b]
ys
    (a
x : [a]
xs, b
y : [b]
ys) -> These a b -> c
f (a -> b -> These a b
forall a b. a -> b -> These a b
These a
x b
y) c -> [c] -> [c]
forall a. a -> [a] -> [a]
: ([a], [b]) -> [c]
go ([a]
xs, [b]
ys)

-- | 'zipWithLongest' for 'id'
zipLongest :: [a] -> [b] -> [These a b]
zipLongest :: [a] -> [b] -> [These a b]
zipLongest = (These a b -> These a b) -> [a] -> [b] -> [These a b]
forall a b c. (These a b -> c) -> [a] -> [b] -> [c]
zipWithLongest These a b -> These a b
forall a. a -> a
id

-- | break up a list into all possible pairs of nonempty lists: see 'Primus.NonEmpty.splits1'
splits :: forall a. [a] -> [([a], [a])]
splits :: [a] -> [([a], [a])]
splits = \case
  [] -> []
  a
x : [a]
xs -> ([a], [a]) -> [([a], [a])]
go ([a
x], [a]
xs)
 where
  go :: ([a], [a]) -> [([a], [a])]
  go :: ([a], [a]) -> [([a], [a])]
go = \case
    ([], [a]
_) -> []
    ([a]
_, []) -> []
    (a
a : [a]
as, a
b : [a]
bs) -> (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as, a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
bs) ([a], [a]) -> [([a], [a])] -> [([a], [a])]
forall a. a -> [a] -> [a]
: ([a], [a]) -> [([a], [a])]
go (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
b], [a]
bs)

-- | like 'Data.List.partition' but allow the user to change the types of "e" and "b" using 'Either'
partitionEithersL' :: Foldable t => (a -> Either e b) -> t a -> ([e], [b])
partitionEithersL' :: (a -> Either e b) -> t a -> ([e], [b])
partitionEithersL' a -> Either e b
f = [Either e b] -> ([e], [b])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either e b] -> ([e], [b]))
-> (t a -> [Either e b]) -> t a -> ([e], [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [Either e b] -> [Either e b])
-> [Either e b] -> t a -> [Either e b]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) (Either e b -> [Either e b] -> [Either e b])
-> (a -> Either e b) -> a -> [Either e b] -> [Either e b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either e b
f) []

-- | like 'partitionEithersL'' using 'Primus.Bool.boolEither'
partitionEithersL :: Foldable t => (a -> Bool) -> (a -> e) -> (a -> b) -> t a -> ([e], [b])
partitionEithersL :: (a -> Bool) -> (a -> e) -> (a -> b) -> t a -> ([e], [b])
partitionEithersL a -> Bool
p a -> e
l a -> b
r = [Either e b] -> ([e], [b])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either e b] -> ([e], [b]))
-> (t a -> [Either e b]) -> t a -> ([e], [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [Either e b] -> [Either e b])
-> [Either e b] -> t a -> [Either e b]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) (Either e b -> [Either e b] -> [Either e b])
-> (a -> Either e b) -> a -> [Either e b] -> [Either e b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> (a -> e) -> (a -> b) -> a -> Either e b
forall a e b.
(a -> Bool) -> (a -> e) -> (a -> b) -> a -> Either e b
boolEither a -> Bool
p a -> e
l a -> b
r) []

-- | like 'Data.List.partition' but allow the user to change the types of "e" and "b" using 'These'
partitionTheseL' :: Foldable t => (a -> These e b) -> t a -> ([e], [b], [(e, b)])
partitionTheseL' :: (a -> These e b) -> t a -> ([e], [b], [(e, b)])
partitionTheseL' a -> These e b
f = [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)]))
-> (t a -> [These e b]) -> t a -> ([e], [b], [(e, b)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [These e b] -> [These e b])
-> [These e b] -> t a -> [These e b]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) (These e b -> [These e b] -> [These e b])
-> (a -> These e b) -> a -> [These e b] -> [These e b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> These e b
f) []

-- | like 'partitionTheseL' using 'Primus.Bool.boolThese'
partitionTheseL :: Foldable t => (a -> Bool) -> (a -> Bool) -> (a -> e) -> (a -> b) -> t a -> ([e], [b], [(e, b)])
partitionTheseL :: (a -> Bool)
-> (a -> Bool)
-> (a -> e)
-> (a -> b)
-> t a
-> ([e], [b], [(e, b)])
partitionTheseL a -> Bool
p a -> Bool
q a -> e
l a -> b
r = [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)]))
-> (t a -> [These e b]) -> t a -> ([e], [b], [(e, b)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [These e b] -> [These e b])
-> [These e b] -> t a -> [These e b]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) (These e b -> [These e b] -> [These e b])
-> (a -> These e b) -> a -> [These e b] -> [These e b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool)
-> (a -> Bool) -> (a -> e) -> (a -> b) -> a -> These e b
forall a e b.
(a -> Bool)
-> (a -> Bool) -> (a -> e) -> (a -> b) -> a -> These e b
boolThese a -> Bool
p a -> Bool
q a -> e
l a -> b
r) []

-- | like 'Data.List.span' but allow the user to change the success type using 'Maybe'
spanMaybe' :: (a -> Maybe b) -> [a] -> ([b], [a])
spanMaybe' :: (a -> Maybe b) -> [a] -> ([b], [a])
spanMaybe' a -> Maybe b
f = [a] -> ([b], [a])
go
 where
  go :: [a] -> ([b], [a])
go = \case
    [] -> ([], [])
    a
a : [a]
as -> case a -> Maybe b
f a
a of
      Maybe b
Nothing -> ([], a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as)
      Just 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] -> ([b], [a])
go [a]
as)

-- | like 'spanMaybe'' using 'Primus.Bool.boolMaybe'
spanMaybe :: (a -> Bool) -> (a -> b) -> [a] -> ([b], [a])
spanMaybe :: (a -> Bool) -> (a -> b) -> [a] -> ([b], [a])
spanMaybe a -> Bool
p a -> b
r = (a -> Maybe b) -> [a] -> ([b], [a])
forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
spanMaybe' ((a -> Bool) -> (a -> b) -> a -> Maybe b
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
boolMaybe a -> Bool
p a -> b
r)

-- | partition for an applicative
partitionM :: Applicative m => (a -> m Bool) -> [a] -> m ([a], [a])
partitionM :: (a -> m Bool) -> [a] -> m ([a], [a])
partitionM a -> m Bool
f = [a] -> m ([a], [a])
go
 where
  go :: [a] -> m ([a], [a])
go = \case
    [] -> ([a], [a]) -> m ([a], [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a], [a])
forall a. Monoid a => a
mempty
    a
a : [a]
as -> (\Bool
b -> (([a] -> [a]) -> ([a], [a]) -> ([a], [a]))
-> (([a] -> [a]) -> ([a], [a]) -> ([a], [a]))
-> Bool
-> ([a] -> [a])
-> ([a], [a])
-> ([a], [a])
forall a. a -> a -> Bool -> a
bool ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Bool
b (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) (Bool -> ([a], [a]) -> ([a], [a]))
-> m Bool -> m (([a], [a]) -> ([a], [a]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m Bool
f a
a m (([a], [a]) -> ([a], [a])) -> m ([a], [a]) -> m ([a], [a])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a] -> m ([a], [a])
go [a]
as

-- | break up a list into cases using cons
list :: b -> (a -> [a] -> b) -> [a] -> b
list :: b -> (a -> [a] -> b) -> [a] -> b
list b
z a -> [a] -> b
s = \case
  [] -> b
z
  a
a:[a]
as -> a -> [a] -> b
s a
a [a]
as

-- | break up a list into cases using cons
list' :: [a] -> b -> (a -> [a] -> b) -> b
list' :: [a] -> b -> (a -> [a] -> b) -> b
list' [a]
as b
z a -> [a] -> b
s = b -> (a -> [a] -> b) -> [a] -> b
forall b a. b -> (a -> [a] -> b) -> [a] -> b
list b
z a -> [a] -> b
s [a]
as

-- | break up a list into cases using snoc
listSnoc :: b -> ([a] -> a -> b) -> [a] -> b
listSnoc :: b -> ([a] -> a -> b) -> [a] -> b
listSnoc b
z [a] -> a -> b
s = b -> (([a], a) -> b) -> Maybe ([a], a) -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
z (([a] -> a -> b) -> ([a], a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [a] -> a -> b
s) (Maybe ([a], a) -> b) -> ([a] -> Maybe ([a], a)) -> [a] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe ([a], a)
forall a. [a] -> Maybe ([a], a)
unsnocL

-- | snoc for a list
snocL :: [a] -> a -> [a]
snocL :: [a] -> a -> [a]
snocL [a]
as a
a = [a]
as [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
a]

-- | unsnoc for a list
unsnocL :: [a] -> Maybe ([a], a)
unsnocL :: [a] -> Maybe ([a], a)
unsnocL = Maybe ([a], a)
-> (a -> [a] -> Maybe ([a], a)) -> [a] -> Maybe ([a], a)
forall b a. b -> (a -> [a] -> b) -> [a] -> b
list Maybe ([a], a)
forall a. Maybe a
Nothing (([a], a) -> Maybe ([a], a)
forall a. a -> Maybe a
Just (([a], a) -> Maybe ([a], a))
-> (a -> [a] -> ([a], a)) -> a -> [a] -> Maybe ([a], a)
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ a -> [a] -> ([a], a)
forall a. a -> [a] -> ([a], a)
unsnocL')

-- | unsnoc for a value and a list
unsnocL' :: a -> [a] -> ([a], a)
unsnocL' :: a -> [a] -> ([a], a)
unsnocL' a
a =
  \case
    [] -> ([], a
a)
    a
x : [a]
xs -> ([a] -> [a]) -> ([a], a) -> ([a], a)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (a -> [a] -> ([a], a)
forall a. a -> [a] -> ([a], a)
unsnocL' a
x [a]
xs)