-- |
-- Module: Data.List1
-- Description: Helpers for working with NonEmpty lists.
-- Copyright: (c) Melanie Phoenix Brown, 2023-2025
-- Maintainer: brown.m@proton.me
module Data.List1 (
  List1 {- ((:|)) -},
  pattern Sole,
  pattern (:||),
  pattern (:?),
  (<|),
  (|>),
  (|:),
  (||:),
  (?:),
  list1,
  toList,
  unList1,
  onList,
  asList,
  ifList1,
  withList1,
  whenList1,
  has01,
  has1Plus,
  uncons,
  unsnoc,
  (++),
  reverse,
  head,
  tail,
  init,
  last,
  inits,
  tails,
  take,
  drop,
  takeWhile,
  dropWhile,
  delete,
  deleteBy,
  (\\),
  filter,
  span,
  break,
  partition,
  splitAt,
  index,
  elem,
  notElem,
  elemIndex,
  elemIndices,
  find,
  findIndex,
  findIndices,
  (!?),
  lookup,
  map,
  foldMap1,
  mapMaybe,
  catMaybes,
  zip,
  zipWith,
  unzip,
  accuml,
  accumr,
  scanl,
  scanl',
  scanl1,
  scanl1',
  scanr,
  scanr1,
  unfoldr,
  build1,
  sort,
  sortOn,
  sortBy,
  group,
  groupOn,
  groupBy,
  intersect,
  intersectOn,
  intersectBy,
  union,
  unionOn,
  unionBy,
  nub,
  nubOn,
  nubBy,
  maximum,
  maximumOf,
  maximumOn,
  maximumBy,
  minimum,
  minimumOf,
  minimumOn,
  minimumBy,
  iterate,
  iterated,
  repeat,
  replicate,
  cycle,
  intersperse,
  intercalate,
  transpose,
  subsequences,
  windows,
  consecutiveSubsequences,
  permutations,
  diagonally,
  diagonals,
  insertions,
  -- zipWithTruncate,
  -- zipWithTruncate',
  -- zipWithTruncate1,
) where

import Control.Applicative (Alternative (empty), Applicative (pure))
import Control.Monad (ap, guard, join, liftM2, (<=<), (=<<), (>>=))
import Control.Monad.Fix (fix)
import Data.Bifunctor (Bifunctor (first), bimap)
import Data.Bits ((.&.))
import Data.Bool (Bool (..), not, otherwise, (||))
import Data.Eq (Eq (..))
import Data.Foldable qualified as Fold
import Data.Foldable1 (Foldable1 (foldMap1))
import Data.Function (const, flip, id, on, ($), (.))
import Data.Functor (Functor, fmap, ($>), (<$>), (<&>))
import Data.Int (Int)
import Data.List qualified as List
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Maybe (Maybe (..), fromJust, fromMaybe, isJust, maybe)
import Data.Ord (Ord (..), Ordering (..), comparing)
import Data.Semigroup (Semigroup ((<>)))
import Data.Tuple (fst, snd)
import Data.Word (Word)
import GHC.Enum (Enum (pred, succ))
import GHC.Err (error)
import GHC.Num qualified as Num
import GHC.Real (Integral)
import GHC.Stack (HasCallStack)
import Prelude ()

infixr 5 {- :|, -} :||, :?, |:, ||:, ?:

infixl 4 <|, |>

type List1 = NonEmpty

-- data List1 x = x :| [x]
--   deriving
--     ( Eq
--     , Ord
--     , Show
--     , Read
--     , Data
--     , Generic
--     , Generic1
--     , Functor
--     , Foldable
--     , Traversable
--     )

-- | Match a singleton 'List1'.
pattern Sole :: x -> List1 x
pattern $mSole :: forall {r} {x}. List1 x -> (x -> r) -> ((# #) -> r) -> r
$bSole :: forall x. x -> List1 x
Sole x = x :| []

-- | Match a 'List1' of length at least 2.
pattern (:||) :: x -> List1 x -> List1 x
pattern x $m:|| :: forall {r} {x}. List1 x -> (x -> List1 x -> r) -> ((# #) -> r) -> r
$b:|| :: forall x. x -> List1 x -> List1 x
:|| y <- (x :| (list1 -> Just y))
  where
    x
x :|| ~(x
y :| [x]
ys) = x
x x -> [x] -> NonEmpty x
forall a. a -> [a] -> NonEmpty a
:| (x
y x -> [x] -> [x]
forall a. a -> [a] -> [a]
: [x]
ys)

{-# COMPLETE Sole, (:||) #-}

-- | Isomorphic to '(:|)', but instead with a 'Maybe' 'List1'.
pattern (:?) :: x -> Maybe (List1 x) -> List1 x
pattern x $m:? :: forall {r} {x}.
List1 x -> (x -> Maybe (List1 x) -> r) -> ((# #) -> r) -> r
$b:? :: forall x. x -> Maybe (List1 x) -> List1 x
:? y <- (x :| ~(list1 -> y))
  where
    x
x :? Maybe (List1 x)
y = List1 x -> (List1 x -> List1 x) -> Maybe (List1 x) -> List1 x
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (x -> List1 x
forall x. x -> List1 x
Sole x
x) (x
x :||) Maybe (List1 x)
y

{-# COMPLETE (:?) #-}

-- | Prepend a 'List1' to a list.
(<|) :: List1 x -> [x] -> List1 x
(x
x :| [x]
xs) <| :: forall x. List1 x -> [x] -> List1 x
<| [x]
ys = x
x x -> [x] -> NonEmpty x
forall a. a -> [a] -> NonEmpty a
:| ([x]
xs [x] -> [x] -> [x]
forall a. Semigroup a => a -> a -> a
<> [x]
ys)

-- | Append a 'List1' to a list.
(|>) :: [x] -> List1 x -> List1 x
[x]
xs |> :: forall x. [x] -> List1 x -> List1 x
|> List1 x
ys = [x] -> List1 x -> (List1 x -> List1 x) -> List1 x
forall x y. [x] -> y -> (List1 x -> y) -> y
has01 [x]
xs List1 x
ys \(x
x :| [x]
zs) -> x
x x -> List1 x -> List1 x
forall x. x -> List1 x -> List1 x
:|| ([x]
zs [x] -> List1 x -> List1 x
forall x. [x] -> List1 x -> List1 x
|> List1 x
ys)

-- | Append an element to a list. C.f. '(:|)'.
(|:) :: [x] -> x -> List1 x
[x]
ys |: :: forall x. [x] -> x -> List1 x
|: x
x = [x]
ys [x] -> List1 x -> List1 x
forall x. [x] -> List1 x -> List1 x
|> x -> List1 x
forall x. x -> List1 x
Sole x
x

-- | Append an element to a 'List1'. C.f. '(:||)'.
(||:) :: List1 x -> x -> List1 x
List1 x
ys ||: :: forall x. List1 x -> x -> List1 x
||: x
x = List1 x
ys List1 x -> List1 x -> List1 x
forall a. Semigroup a => a -> a -> a
<> x -> List1 x
forall x. x -> List1 x
Sole x
x

-- | Append an element to a 'Maybe' 'List1'. C.f. '(:?)'.
(?:) :: Maybe (List1 x) -> x -> List1 x
Maybe (List1 x)
ys ?: :: forall x. Maybe (List1 x) -> x -> List1 x
?: x
x = List1 x -> (List1 x -> List1 x) -> Maybe (List1 x) -> List1 x
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (x -> List1 x
forall x. x -> List1 x
Sole x
x) (List1 x -> x -> List1 x
forall x. List1 x -> x -> List1 x
||: x
x) Maybe (List1 x)
ys

-- | Together with 'unList1', witness the isomorphism @[x] ~ Maybe (List1 x)@.
list1 :: [x] -> Maybe (List1 x)
list1 :: forall x. [x] -> Maybe (List1 x)
list1 [x]
xs = [x]
-> Maybe (List1 x)
-> (List1 x -> Maybe (List1 x))
-> Maybe (List1 x)
forall x y. [x] -> y -> (List1 x -> y) -> y
has01 [x]
xs Maybe (List1 x)
forall a. Maybe a
Nothing List1 x -> Maybe (List1 x)
forall a. a -> Maybe a
Just

-- | Forget the nonemptiness information.
toList :: List1 x -> [x]
toList :: forall x. List1 x -> [x]
toList (x
x :| [x]
xs) = x
x x -> [x] -> [x]
forall a. a -> [a] -> [a]
: [x]
xs

-- | Together with 'list1', witness the isomorphism @[x] ~ Maybe (List1 x)@.
unList1 :: Maybe (List1 x) -> [x]
unList1 :: forall x. Maybe (List1 x) -> [x]
unList1 = [x] -> (List1 x -> [x]) -> Maybe (List1 x) -> [x]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] List1 x -> [x]
forall x. List1 x -> [x]
toList

-- | Apply a 'List1' function on a regular list.
onList :: (List1 x -> List1 x) -> [x] -> [x]
onList :: forall x. (List1 x -> List1 x) -> [x] -> [x]
onList List1 x -> List1 x
f = [x] -> (List1 x -> [x]) -> Maybe (List1 x) -> [x]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (List1 x -> [x]
forall x. List1 x -> [x]
toList (List1 x -> [x]) -> (List1 x -> List1 x) -> List1 x -> [x]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List1 x -> List1 x
f) (Maybe (List1 x) -> [x]) -> ([x] -> Maybe (List1 x)) -> [x] -> [x]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [x] -> Maybe (List1 x)
forall x. [x] -> Maybe (List1 x)
list1

-- | Apply a regular list function on a 'List1'. Avoid shortening the list.
asList :: (HasCallStack) => ([x] -> [x]) -> List1 x -> List1 x
asList :: forall x. HasCallStack => ([x] -> [x]) -> List1 x -> List1 x
asList [x] -> [x]
f List1 x
xs = [x] -> List1 x -> (List1 x -> List1 x) -> List1 x
forall x y. [x] -> y -> (List1 x -> y) -> y
has01 ([x] -> [x]
f (List1 x -> [x]
forall x. List1 x -> [x]
toList List1 x
xs)) ([Char] -> List1 x
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.List1.asList: list got shortened") List1 x -> List1 x
forall a. a -> a
id

-- | Apply a 'List1' function if the list is not empty.
ifList1 :: (Alternative m) => [x] -> (List1 x -> y) -> m y
ifList1 :: forall (m :: * -> *) x y.
Alternative m =>
[x] -> (List1 x -> y) -> m y
ifList1 [x]
xs = [x] -> m y -> (List1 x -> m y) -> m y
forall x y. [x] -> y -> (List1 x -> y) -> y
has01 [x]
xs m y
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty ((List1 x -> m y) -> m y)
-> ((List1 x -> y) -> List1 x -> m y) -> (List1 x -> y) -> m y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (y -> m y
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure .)

-- | Flipped version of 'has01', consistent with other libraries' @withNonEmpty@.
withList1 :: y -> (List1 x -> y) -> [x] -> y
withList1 :: forall y x. y -> (List1 x -> y) -> [x] -> y
withList1 y
y List1 x -> y
f [x]
xs = [x] -> y -> (List1 x -> y) -> y
forall x y. [x] -> y -> (List1 x -> y) -> y
has01 [x]
xs y
y List1 x -> y
f

-- | Run an action taking a 'List1' if the list is not empty.
whenList1 :: (Applicative m) => [x] -> (List1 x -> m ()) -> m ()
whenList1 :: forall (m :: * -> *) x.
Applicative m =>
[x] -> (List1 x -> m ()) -> m ()
whenList1 = ([x] -> m () -> (List1 x -> m ()) -> m ()
forall x y. [x] -> y -> (List1 x -> y) -> y
`has01` () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- |
-- Case split on a list with a default value and a 'List1' function.
-- Flipped variant of what some call @withNonEmpty@ or @withNotNull@.
has01 :: [x] -> y -> (List1 x -> y) -> y
has01 :: forall x y. [x] -> y -> (List1 x -> y) -> y
has01 [x]
lx y
y List1 x -> y
xy = case [x]
lx of [] -> y
y; x
x : [x]
xs -> List1 x -> y
xy (x
x x -> [x] -> List1 x
forall a. a -> [a] -> NonEmpty a
:| [x]
xs)

-- |
-- Case split on a 'List1' with a simple function and a 'List1' function.
has1Plus :: List1 x -> (x -> y) -> (x -> List1 x -> y) -> y
has1Plus :: forall x y. List1 x -> (x -> y) -> (x -> List1 x -> y) -> y
has1Plus List1 x
lx x -> y
y x -> List1 x -> y
xy = case List1 x
lx of Sole x
x -> x -> y
y x
x; x
x :|| List1 x
xs -> x -> List1 x -> y
xy x
x List1 x
xs

-- instance GHC.IsList (List1 x) where
--   type Item (List1 x) = x

--   fromList :: [x] -> List1 x
--   fromList = fromMaybe (error "Data.List.List1.fromList []") . list1

--   toList :: List1 x -> [x]
--   toList = toList

-- instance Semigroup (List1 x) where
--   (<>) :: List1 x -> List1 x -> List1 x
--   (x :| xs) <> ys = x :| (xs <> Fold.toList ys)

-- | Type-restricted concatenation.
(++) :: List1 x -> List1 x -> List1 x
++ :: forall x. List1 x -> List1 x -> List1 x
(++) = List1 x -> List1 x -> List1 x
forall a. Semigroup a => a -> a -> a
(<>)

-- | 'List1' the elements backwards.
reverse :: List1 x -> List1 x
reverse :: forall x. List1 x -> List1 x
reverse = ((List1 x -> List1 x) -> List1 x -> List1 x) -> List1 x -> List1 x
forall a. (a -> a) -> a
fix \List1 x -> List1 x
rec (x
x :| [x]
xs) -> [x] -> List1 x -> (List1 x -> List1 x) -> List1 x
forall x y. [x] -> y -> (List1 x -> y) -> y
has01 [x]
xs (x -> List1 x
forall x. x -> List1 x
Sole x
x) ((List1 x -> x -> List1 x
forall x. List1 x -> x -> List1 x
||: x
x) (List1 x -> List1 x) -> (List1 x -> List1 x) -> List1 x -> List1 x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List1 x -> List1 x
rec)

-- instance Foldable1 List1 where
--   foldMap1 :: (Semigroup s) => (x -> s) -> List1 x -> s
--   foldMap1 f = \case
--     Sole x -> f x
--     x :|| y -> f x <> foldMap1 f y

-- instance Applicative List1 where
--   pure :: x -> List1 x
--   pure = Sole

--   (<*>) :: List1 (x -> y) -> List1 x -> List1 y
--   (<*>) = ap

-- instance Monad List1 where
--   (>>=) :: List1 x -> (x -> List1 y) -> List1 y
--   (>>=) = flip foldMap1

-- instance MonadZip List1 where
--   mzip :: List1 x -> List1 y -> List1 (x, y)
--   mzip = zip
--   mzipWith :: (x -> y -> z) -> List1 x -> List1 y -> List1 z
--   mzipWith = zipWith
--   munzip :: List1 (x, y) -> (List1 x, List1 y)
--   munzip = unzip

-- instance MonadFix List1 where
--   mfix :: (x -> List1 x) -> List1 x
--   mfix f = case fix (f . head) of (x :| _) -> x :| mfix (tail . f)

-- | Extract the first element of a 'List1'.
head :: List1 x -> x
head :: forall x. List1 x -> x
head (x
x :| [x]
_) = x
x

-- | Extract all but the first element of a 'List1'.
tail :: List1 x -> [x]
tail :: forall x. List1 x -> [x]
tail (x
_ :| [x]
xs) = [x]
xs

-- | Extract all but the last element of a 'List1'.
init :: List1 x -> [x]
init :: forall x. List1 x -> [x]
init = ((List1 x -> [x]) -> List1 x -> [x]) -> List1 x -> [x]
forall a. (a -> a) -> a
fix \List1 x -> [x]
rec List1 x
xs -> List1 x -> (x -> [x]) -> (x -> List1 x -> [x]) -> [x]
forall x y. List1 x -> (x -> y) -> (x -> List1 x -> y) -> y
has1Plus List1 x
xs ([x] -> x -> [x]
forall a b. a -> b -> a
const []) \x
y List1 x
ys -> x
y x -> [x] -> [x]
forall a. a -> [a] -> [a]
: List1 x -> [x]
rec List1 x
ys

-- | Extract the last element of a 'List1'.
last :: List1 x -> x
last :: forall x. List1 x -> x
last = ((List1 x -> x) -> List1 x -> x) -> List1 x -> x
forall a. (a -> a) -> a
fix \List1 x -> x
rec List1 x
xs -> List1 x -> (x -> x) -> (x -> List1 x -> x) -> x
forall x y. List1 x -> (x -> y) -> (x -> List1 x -> y) -> y
has1Plus List1 x
xs x -> x
forall a. a -> a
id ((List1 x -> x) -> x -> List1 x -> x
forall a b. a -> b -> a
const List1 x -> x
rec)

-- | Convenience function for decomposing 'List1' into its 'head' and 'tail'.
uncons :: List1 x -> (x, [x])
uncons :: forall x. List1 x -> (x, [x])
uncons (x
x :| [x]
xs) = (x
x, [x]
xs)

-- | Convenience function for decomposing 'List1' into its 'init' and 'last'.
unsnoc :: List1 x -> ([x], x)
unsnoc :: forall x. List1 x -> ([x], x)
unsnoc = ((List1 x -> ([x], x)) -> List1 x -> ([x], x))
-> List1 x -> ([x], x)
forall a. (a -> a) -> a
fix \List1 x -> ([x], x)
rec (x
x :| [x]
xs) -> [x] -> ([x], x) -> (List1 x -> ([x], x)) -> ([x], x)
forall x y. [x] -> y -> (List1 x -> y) -> y
has01 [x]
xs ([], x
x) (([x] -> [x]) -> ([x], x) -> ([x], x)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (x
x :) (([x], x) -> ([x], x))
-> (List1 x -> ([x], x)) -> List1 x -> ([x], x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List1 x -> ([x], x)
rec)

data Snoc1 x = Snoc1 {-# UNPACK #-} !Word (List1 x) [x]

-- | The sequence of prefixes of a 'List1', from shortest to longest.
inits :: List1 x -> List1 (List1 x)
inits :: forall x. List1 x -> List1 (List1 x)
inits (x
x :| [x]
xs) =
  (Snoc1 x -> x -> Snoc1 x) -> Snoc1 x -> [x] -> List1 (Snoc1 x)
forall y x. (y -> x -> y) -> y -> [x] -> List1 y
scanl' Snoc1 x -> x -> Snoc1 x
forall x. Snoc1 x -> x -> Snoc1 x
snoc (Word -> NonEmpty x -> [x] -> Snoc1 x
forall x. Word -> List1 x -> [x] -> Snoc1 x
snoc1 Word
1 (x -> NonEmpty x
forall x. x -> List1 x
Sole x
x) []) [x]
xs
    List1 (Snoc1 x) -> (Snoc1 x -> NonEmpty x) -> NonEmpty (NonEmpty x)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Snoc1 Word
_ NonEmpty x
front [x]
rear) -> NonEmpty x
front NonEmpty x -> [x] -> NonEmpty x
forall x. List1 x -> [x] -> List1 x
<| [x] -> [x]
forall a. [a] -> [a]
List.reverse [x]
rear
 where
  snoc1 :: Word -> List1 x -> [x] -> Snoc1 x
  snoc1 :: forall x. Word -> List1 x -> [x] -> Snoc1 x
snoc1 Word
len List1 x
front [x]
rear
    | Word
len Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
255 Bool -> Bool -> Bool
|| (Word
len Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word -> Word
forall a. Enum a => a -> a
succ Word
len) Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0 = Word -> List1 x -> [x] -> Snoc1 x
forall x. Word -> List1 x -> [x] -> Snoc1 x
Snoc1 Word
len List1 x
front [x]
rear
    | Bool
otherwise = Word -> List1 x -> [x] -> Snoc1 x
forall x. Word -> List1 x -> [x] -> Snoc1 x
Snoc1 Word
len (List1 x
front List1 x -> [x] -> List1 x
forall x. List1 x -> [x] -> List1 x
<| [x] -> [x]
forall a. [a] -> [a]
List.reverse [x]
rear) []

  snoc :: Snoc1 x -> x -> Snoc1 x
  snoc :: forall x. Snoc1 x -> x -> Snoc1 x
snoc (Snoc1 Word
len List1 x
front [x]
rear) x
y = Word -> List1 x -> [x] -> Snoc1 x
forall x. Word -> List1 x -> [x] -> Snoc1 x
snoc1 (Word -> Word
forall a. Enum a => a -> a
succ Word
len) List1 x
front (x
y x -> [x] -> [x]
forall a. a -> [a] -> [a]
: [x]
rear)

-- | The 'List1' analogue of 'build'.
build1 :: forall x. (forall y. (x -> Maybe y -> y) -> Maybe y -> y) -> List1 x
build1 :: forall x.
(forall y. (x -> Maybe y -> y) -> Maybe y -> y) -> List1 x
build1 forall y. (x -> Maybe y -> y) -> Maybe y -> y
f = (x -> Maybe (List1 x) -> List1 x) -> Maybe (List1 x) -> List1 x
forall y. (x -> Maybe y -> y) -> Maybe y -> y
f x -> Maybe (List1 x) -> List1 x
forall x. x -> Maybe (List1 x) -> List1 x
(:?) Maybe (List1 x)
forall a. Maybe a
Nothing

-- | The sequence of suffixes of a 'List1', from longest to shortest.
tails :: List1 x -> List1 (List1 x)
tails :: forall x. List1 x -> List1 (List1 x)
tails List1 x
xs = (forall y. (List1 x -> Maybe y -> y) -> Maybe y -> y)
-> List1 (List1 x)
forall x.
(forall y. (x -> Maybe y -> y) -> Maybe y -> y) -> List1 x
build1 \List1 x -> Maybe y -> y
(.?) Maybe y
end ->
  ((List1 x -> y) -> List1 x -> y) -> List1 x -> y
forall a. (a -> a) -> a
fix (\List1 x -> y
rec x :: List1 x
x@(x
_ :? Maybe (List1 x)
y) -> List1 x
x List1 x -> Maybe y -> y
.? Maybe y -> (List1 x -> Maybe y) -> Maybe (List1 x) -> Maybe y
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe y
end (y -> Maybe y
forall a. a -> Maybe a
Just (y -> Maybe y) -> (List1 x -> y) -> List1 x -> Maybe y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List1 x -> y
rec) Maybe (List1 x)
y) List1 x
xs

-- | Pointwise product of two 'List1's.
zip :: List1 x -> List1 y -> List1 (x, y)
zip :: forall x y. List1 x -> List1 y -> List1 (x, y)
zip = (x -> y -> (x, y)) -> List1 x -> List1 y -> List1 (x, y)
forall x y z. (x -> y -> z) -> List1 x -> List1 y -> List1 z
zipWith (,)

-- | Pointwise application of two 'List1's.
zipWith :: (x -> y -> z) -> List1 x -> List1 y -> List1 z
zipWith :: forall x y z. (x -> y -> z) -> List1 x -> List1 y -> List1 z
zipWith x -> y -> z
f = ((List1 z, Wedge (List1 x) (List1 y)) -> List1 z
forall a b. (a, b) -> a
fst .) ((List1 y -> (List1 z, Wedge (List1 x) (List1 y)))
 -> List1 y -> List1 z)
-> (List1 x -> List1 y -> (List1 z, Wedge (List1 x) (List1 y)))
-> List1 x
-> List1 y
-> List1 z
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> y -> z)
-> List1 x -> List1 y -> (List1 z, Wedge (List1 x) (List1 y))
forall a b c.
(a -> b -> c)
-> List1 a -> List1 b -> (List1 c, Wedge (List1 a) (List1 b))
zipWithTruncate1 x -> y -> z
f

-- | Decompose a 'List1' of pairs into a pair of 'List1's.
unzip :: List1 (x, y) -> (List1 x, List1 y)
unzip :: forall x y. List1 (x, y) -> (List1 x, List1 y)
unzip = ((List1 (x, y) -> (List1 x, List1 y))
 -> List1 (x, y) -> (List1 x, List1 y))
-> List1 (x, y) -> (List1 x, List1 y)
forall a. (a -> a) -> a
fix \List1 (x, y) -> (List1 x, List1 y)
rec -> \case
  Sole (x
x, y
y) -> (x -> List1 x
forall x. x -> List1 x
Sole x
x, y -> List1 y
forall x. x -> List1 x
Sole y
y)
  (x
x, y
y) :|| List1 (x, y)
xys -> case List1 (x, y) -> (List1 x, List1 y)
rec List1 (x, y)
xys of (List1 x
xs, List1 y
ys) -> (x
x x -> List1 x -> List1 x
forall x. x -> List1 x -> List1 x
:|| List1 x
xs, y
y y -> List1 y -> List1 y
forall x. x -> List1 x -> List1 x
:|| List1 y
ys)

-- | Traverse a 'List1' with an accumulating parameter from left to right.
accuml :: (a -> x -> (a, y)) -> a -> List1 x -> (a, List1 y)
accuml :: forall a x y. (a -> x -> (a, y)) -> a -> List1 x -> (a, List1 y)
accuml a -> x -> (a, y)
(+) = ((a -> List1 x -> (a, List1 y)) -> a -> List1 x -> (a, List1 y))
-> a -> List1 x -> (a, List1 y)
forall a. (a -> a) -> a
fix \a -> List1 x -> (a, List1 y)
rec a
a0 -> \case
  Sole x
x -> y -> List1 y
forall x. x -> List1 x
Sole (y -> List1 y) -> (a, y) -> (a, List1 y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a
a0 a -> x -> (a, y)
+ x
x)
  x
x :|| List1 x
xs -> case a
a0 a -> x -> (a, y)
+ x
x of (a
a, y
y) -> (y
y :||) (List1 y -> List1 y) -> (a, List1 y) -> (a, List1 y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> List1 x -> (a, List1 y)
rec a
a List1 x
xs

-- | Traverse a 'List1' with an accumulating parameter from right to left.
accumr :: (a -> x -> (a, y)) -> a -> List1 x -> (a, List1 y)
accumr :: forall a x y. (a -> x -> (a, y)) -> a -> List1 x -> (a, List1 y)
accumr a -> x -> (a, y)
(+) a
a0 = ((List1 x -> (a, List1 y)) -> List1 x -> (a, List1 y))
-> List1 x -> (a, List1 y)
forall a. (a -> a) -> a
fix \List1 x -> (a, List1 y)
rec -> \case
  Sole x
x -> y -> List1 y
forall x. x -> List1 x
Sole (y -> List1 y) -> (a, y) -> (a, List1 y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a
a0 a -> x -> (a, y)
+ x
x)
  x
x :|| List1 x
xs -> case List1 x -> (a, List1 y)
rec List1 x
xs of (a
a, List1 y
ys) -> (a
a a -> x -> (a, y)
+ x
x) (a, y) -> (y -> List1 y) -> (a, List1 y)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (y -> List1 y -> List1 y
forall x. x -> List1 x -> List1 x
:|| List1 y
ys)

-- | 'scanl' is similar to 'Fold.foldl', but returns a 'List1' of successive reduced values from the left.
scanl :: (y -> x -> y) -> y -> [x] -> List1 y
scanl :: forall y x. (y -> x -> y) -> y -> [x] -> List1 y
scanl y -> x -> y
(+) = ((y -> [x] -> List1 y) -> y -> [x] -> List1 y)
-> y -> [x] -> List1 y
forall a. (a -> a) -> a
fix \y -> [x] -> List1 y
rec y
y [x]
zs ->
  y
y y -> Maybe (List1 y) -> List1 y
forall x. x -> Maybe (List1 x) -> List1 x
:? [x] -> (List1 x -> List1 y) -> Maybe (List1 y)
forall (m :: * -> *) x y.
Alternative m =>
[x] -> (List1 x -> y) -> m y
ifList1 [x]
zs \(x
x :| [x]
xs) -> y -> [x] -> List1 y
rec (y
y y -> x -> y
+ x
x) [x]
xs

-- | Strict version of 'scanl'.
scanl' :: (y -> x -> y) -> y -> [x] -> List1 y
scanl' :: forall y x. (y -> x -> y) -> y -> [x] -> List1 y
scanl' y -> x -> y
(+) = ((y -> [x] -> List1 y) -> y -> [x] -> List1 y)
-> y -> [x] -> List1 y
forall a. (a -> a) -> a
fix \y -> [x] -> List1 y
rec !y
y [x]
zs ->
  y
y y -> Maybe (List1 y) -> List1 y
forall x. x -> Maybe (List1 x) -> List1 x
:? [x] -> (List1 x -> List1 y) -> Maybe (List1 y)
forall (m :: * -> *) x y.
Alternative m =>
[x] -> (List1 x -> y) -> m y
ifList1 [x]
zs \(x
x :| [x]
xs) -> y -> [x] -> List1 y
rec (y
y y -> x -> y
+ x
x) [x]
xs

-- | A variant of 'scanl' that has no starting value argument and works on a 'List1'.
scanl1 :: (x -> x -> x) -> List1 x -> List1 x
scanl1 :: forall x. (x -> x -> x) -> List1 x -> List1 x
scanl1 x -> x -> x
f (x
x :| [x]
xs) = (x -> x -> x) -> x -> [x] -> NonEmpty x
forall y x. (y -> x -> y) -> y -> [x] -> List1 y
scanl x -> x -> x
f x
x [x]
xs

-- | Strict version of 'scanl1'.
scanl1' :: (x -> x -> x) -> List1 x -> List1 x
scanl1' :: forall x. (x -> x -> x) -> List1 x -> List1 x
scanl1' x -> x -> x
f (x
x :| [x]
xs) = (x -> x -> x) -> x -> [x] -> NonEmpty x
forall y x. (y -> x -> y) -> y -> [x] -> List1 y
scanl' x -> x -> x
f x
x [x]
xs

-- | 'scanr' is the right-to-left dual of 'scanl'. Note that the parameters of the accumulating function are also reversed.
scanr :: (x -> y -> y) -> y -> [x] -> List1 y
scanr :: forall x y. (x -> y -> y) -> y -> [x] -> List1 y
scanr x -> y -> y
(+) = ((y -> [x] -> List1 y) -> y -> [x] -> List1 y)
-> y -> [x] -> List1 y
forall a. (a -> a) -> a
fix \y -> [x] -> List1 y
rec y
y [x]
zs ->
  y
y y -> Maybe (List1 y) -> List1 y
forall x. x -> Maybe (List1 x) -> List1 x
:? [x] -> (List1 x -> List1 y) -> Maybe (List1 y)
forall (m :: * -> *) x y.
Alternative m =>
[x] -> (List1 x -> y) -> m y
ifList1 [x]
zs \(x
x :| [x]
xs) -> y -> [x] -> List1 y
rec (x
x x -> y -> y
+ y
y) [x]
xs

-- | A variant of 'scanr' with no starting value argument and works on a 'List1'.
scanr1 :: (x -> x -> x) -> List1 x -> List1 x
scanr1 :: forall x. (x -> x -> x) -> List1 x -> List1 x
scanr1 x -> x -> x
f (x
x :| [x]
xs) = (x -> x -> x) -> x -> [x] -> NonEmpty x
forall x y. (x -> y -> y) -> y -> [x] -> List1 y
scanr x -> x -> x
f x
x [x]
xs

-- | Build a 'List1' from a generating function and seed value.
unfoldr :: (x -> (y, Maybe x)) -> x -> List1 y
unfoldr :: forall x y. (x -> (y, Maybe x)) -> x -> List1 y
unfoldr x -> (y, Maybe x)
f x
x = case x -> (y, Maybe x)
f x
x of (y
y, Maybe x
mx) -> y
y y -> Maybe (List1 y) -> List1 y
forall x. x -> Maybe (List1 x) -> List1 x
:? (x -> List1 y) -> Maybe x -> Maybe (List1 y)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((x -> (y, Maybe x)) -> x -> List1 y
forall x y. (x -> (y, Maybe x)) -> x -> List1 y
unfoldr x -> (y, Maybe x)
f) Maybe x
mx

-- | Apply a function to every element of a 'List1'.
map :: (x -> y) -> List1 x -> List1 y
map :: forall x y. (x -> y) -> List1 x -> List1 y
map x -> y
f = \case
  Sole x
x -> y -> List1 y
forall x. x -> List1 x
Sole (x -> y
f x
x)
  x
x :|| List1 x
xs -> x -> y
f x
x y -> List1 y -> List1 y
forall x. x -> List1 x -> List1 x
:|| (x -> y) -> List1 x -> List1 y
forall x y. (x -> y) -> List1 x -> List1 y
map x -> y
f List1 x
xs

-- | A version of 'map' that can eliminate (possibly all) values from a 'List1'.
mapMaybe :: (x -> Maybe y) -> List1 x -> Maybe (List1 y)
mapMaybe :: forall x y. (x -> Maybe y) -> List1 x -> Maybe (List1 y)
mapMaybe x -> Maybe y
f = ((List1 x -> Maybe (List1 y)) -> List1 x -> Maybe (List1 y))
-> List1 x -> Maybe (List1 y)
forall a. (a -> a) -> a
fix \List1 x -> Maybe (List1 y)
rec (x
x :? Maybe (List1 x)
xs) -> (Maybe (List1 y) -> Maybe (List1 y))
-> (y -> Maybe (List1 y) -> Maybe (List1 y))
-> Maybe y
-> Maybe (List1 y)
-> Maybe (List1 y)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe (List1 y) -> Maybe (List1 y)
forall a. a -> a
id (\y
fx -> List1 y -> Maybe (List1 y)
forall a. a -> Maybe a
Just (List1 y -> Maybe (List1 y))
-> (Maybe (List1 y) -> List1 y)
-> Maybe (List1 y)
-> Maybe (List1 y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (y
fx :?)) (x -> Maybe y
f x
x) (List1 x -> Maybe (List1 y)
rec (List1 x -> Maybe (List1 y)) -> Maybe (List1 x) -> Maybe (List1 y)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (List1 x)
xs)

-- | Returns a list of all (possibly no) 'Just' values in a 'List1'.
catMaybes :: List1 (Maybe x) -> Maybe (List1 x)
catMaybes :: forall x. List1 (Maybe x) -> Maybe (List1 x)
catMaybes = (Maybe x -> Maybe x) -> List1 (Maybe x) -> Maybe (List1 x)
forall x y. (x -> Maybe y) -> List1 x -> Maybe (List1 y)
mapMaybe Maybe x -> Maybe x
forall a. a -> a
id

-- | Take the first (possibly no) elements of a 'List1'.
take :: Int -> List1 x -> Maybe (List1 x)
take :: forall x. Int -> List1 x -> Maybe (List1 x)
take = ((Int -> List1 x -> Maybe (List1 x))
 -> Int -> List1 x -> Maybe (List1 x))
-> Int -> List1 x -> Maybe (List1 x)
forall a. (a -> a) -> a
fix \Int -> List1 x -> Maybe (List1 x)
rec Int
n (x
x :? Maybe (List1 x)
xs) -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) Maybe () -> List1 x -> Maybe (List1 x)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (x
x x -> Maybe (List1 x) -> List1 x
forall x. x -> Maybe (List1 x) -> List1 x
:? (Int -> List1 x -> Maybe (List1 x)
rec (Int -> Int
forall a. Enum a => a -> a
pred Int
n) (List1 x -> Maybe (List1 x)) -> Maybe (List1 x) -> Maybe (List1 x)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (List1 x)
xs))

-- | Get rid of the first (possibly all) elements of a 'List1'.
drop :: Int -> List1 x -> Maybe (List1 x)
drop :: forall x. Int -> List1 x -> Maybe (List1 x)
drop = ((Int -> List1 x -> Maybe (List1 x))
 -> Int -> List1 x -> Maybe (List1 x))
-> Int -> List1 x -> Maybe (List1 x)
forall a. (a -> a) -> a
fix \Int -> List1 x -> Maybe (List1 x)
rec Int
n (x
x :? Maybe (List1 x)
xs) -> if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then List1 x -> Maybe (List1 x)
forall a. a -> Maybe a
Just (x
x x -> Maybe (List1 x) -> List1 x
forall x. x -> Maybe (List1 x) -> List1 x
:? Maybe (List1 x)
xs) else Int -> List1 x -> Maybe (List1 x)
rec (Int -> Int
forall a. Enum a => a -> a
pred Int
n) (List1 x -> Maybe (List1 x)) -> Maybe (List1 x) -> Maybe (List1 x)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (List1 x)
xs

-- | Keep the longest prefix of elements of a 'List1' that satisfy a predicate.
takeWhile :: (x -> Bool) -> List1 x -> Maybe (List1 x)
takeWhile :: forall x. (x -> Bool) -> List1 x -> Maybe (List1 x)
takeWhile x -> Bool
p = ((List1 x -> Maybe (List1 x)) -> List1 x -> Maybe (List1 x))
-> List1 x -> Maybe (List1 x)
forall a. (a -> a) -> a
fix \List1 x -> Maybe (List1 x)
rec (x
x :? Maybe (List1 x)
xs) -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (x -> Bool
p x
x) Maybe () -> List1 x -> Maybe (List1 x)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> x
x x -> Maybe (List1 x) -> List1 x
forall x. x -> Maybe (List1 x) -> List1 x
:? (List1 x -> Maybe (List1 x)
rec (List1 x -> Maybe (List1 x)) -> Maybe (List1 x) -> Maybe (List1 x)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (List1 x)
xs)

-- | Drop the longest prefix of elements of a 'List1' that satisfy a predicate.
dropWhile :: (x -> Bool) -> List1 x -> Maybe (List1 x)
dropWhile :: forall x. (x -> Bool) -> List1 x -> Maybe (List1 x)
dropWhile x -> Bool
p = ((List1 x -> Maybe (List1 x)) -> List1 x -> Maybe (List1 x))
-> List1 x -> Maybe (List1 x)
forall a. (a -> a) -> a
fix \List1 x -> Maybe (List1 x)
rec (x
x :? Maybe (List1 x)
xs) -> if x -> Bool
p x
x then List1 x -> Maybe (List1 x)
rec (List1 x -> Maybe (List1 x)) -> Maybe (List1 x) -> Maybe (List1 x)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (List1 x)
xs else List1 x -> Maybe (List1 x)
forall a. a -> Maybe a
Just (x
x x -> Maybe (List1 x) -> List1 x
forall x. x -> Maybe (List1 x) -> List1 x
:? Maybe (List1 x)
xs)

-- | Remove the first occurrence of the given element from a 'List1'.
delete :: (Eq x) => x -> List1 x -> Maybe (List1 x)
delete :: forall x. Eq x => x -> List1 x -> Maybe (List1 x)
delete = (x -> x -> Bool) -> x -> List1 x -> Maybe (List1 x)
forall x. (x -> x -> Bool) -> x -> List1 x -> Maybe (List1 x)
deleteBy x -> x -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | Remove an element from a 'List1' according to a supplied equality test.
deleteBy :: (x -> x -> Bool) -> x -> List1 x -> Maybe (List1 x)
deleteBy :: forall x. (x -> x -> Bool) -> x -> List1 x -> Maybe (List1 x)
deleteBy x -> x -> Bool
eq x
y = ((List1 x -> Maybe (List1 x)) -> List1 x -> Maybe (List1 x))
-> List1 x -> Maybe (List1 x)
forall a. (a -> a) -> a
fix \List1 x -> Maybe (List1 x)
rec (x
x :? Maybe (List1 x)
xs) -> if x -> x -> Bool
eq x
x x
y then Maybe (List1 x)
xs else List1 x -> Maybe (List1 x)
forall a. a -> Maybe a
Just (x
x x -> Maybe (List1 x) -> List1 x
forall x. x -> Maybe (List1 x) -> List1 x
:? (List1 x -> Maybe (List1 x)
rec (List1 x -> Maybe (List1 x)) -> Maybe (List1 x) -> Maybe (List1 x)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (List1 x)
xs))

-- | Remove all of the elements of the second argument from the first argument.
(\\) :: (Eq x) => List1 x -> List1 x -> Maybe (List1 x)
List1 x
xs \\ :: forall x. Eq x => List1 x -> List1 x -> Maybe (List1 x)
\\ List1 x
os = (x -> Bool) -> List1 x -> Maybe (List1 x)
forall x. (x -> Bool) -> List1 x -> Maybe (List1 x)
filter (Bool -> Bool
not (Bool -> Bool) -> (x -> Bool) -> x -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> List1 x -> Bool
forall x. Eq x => x -> List1 x -> Bool
`elem` List1 x
os)) List1 x
xs

-- | Keep only (possibly no) elements satisfying a predicate.
filter :: (x -> Bool) -> List1 x -> Maybe (List1 x)
filter :: forall x. (x -> Bool) -> List1 x -> Maybe (List1 x)
filter x -> Bool
p = ((List1 x -> Maybe (List1 x)) -> List1 x -> Maybe (List1 x))
-> List1 x -> Maybe (List1 x)
forall a. (a -> a) -> a
fix \List1 x -> Maybe (List1 x)
rec (x
x :? Maybe (List1 x)
xs) -> (if x -> Bool
p x
x then List1 x -> Maybe (List1 x)
forall a. a -> Maybe a
Just (List1 x -> Maybe (List1 x))
-> (Maybe (List1 x) -> List1 x)
-> Maybe (List1 x)
-> Maybe (List1 x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x
x :?) else Maybe (List1 x) -> Maybe (List1 x)
forall a. a -> a
id) (List1 x -> Maybe (List1 x)
rec (List1 x -> Maybe (List1 x)) -> Maybe (List1 x) -> Maybe (List1 x)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (List1 x)
xs)

-- | The prefix and suffix of a 'List1' where the elements of the prefix satisfy the predicate.
span :: (x -> Bool) -> List1 x -> ([x], [x])
span :: forall x. (x -> Bool) -> List1 x -> ([x], [x])
span x -> Bool
p = (x -> Bool) -> [x] -> ([x], [x])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.span x -> Bool
p ([x] -> ([x], [x])) -> (List1 x -> [x]) -> List1 x -> ([x], [x])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List1 x -> [x]
forall x. List1 x -> [x]
toList

-- | The prefix and suffix of a 'List1' where the elements of the prefix /do not/ satisfy the predicate.
break :: (x -> Bool) -> List1 x -> ([x], [x])
break :: forall x. (x -> Bool) -> List1 x -> ([x], [x])
break x -> Bool
p = (x -> Bool) -> [x] -> ([x], [x])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.break x -> Bool
p ([x] -> ([x], [x])) -> (List1 x -> [x]) -> List1 x -> ([x], [x])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List1 x -> [x]
forall x. List1 x -> [x]
toList

-- | The elements of a 'List1' that do and do not satisfy the predicate, in order.
partition :: (x -> Bool) -> List1 x -> ([x], [x])
partition :: forall x. (x -> Bool) -> List1 x -> ([x], [x])
partition x -> Bool
p = (x -> Bool) -> [x] -> ([x], [x])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition x -> Bool
p ([x] -> ([x], [x])) -> (List1 x -> [x]) -> List1 x -> ([x], [x])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List1 x -> [x]
forall x. List1 x -> [x]
toList

-- | Split a 'List1' at the given index.
splitAt :: Int -> List1 x -> ([x], [x])
splitAt :: forall x. Int -> List1 x -> ([x], [x])
splitAt Int
n List1 x
xs = (Maybe (List1 x) -> [x]
forall x. Maybe (List1 x) -> [x]
unList1 (Int -> List1 x -> Maybe (List1 x)
forall x. Int -> List1 x -> Maybe (List1 x)
take Int
n List1 x
xs), Maybe (List1 x) -> [x]
forall x. Maybe (List1 x) -> [x]
unList1 (Int -> List1 x -> Maybe (List1 x)
forall x. Int -> List1 x -> Maybe (List1 x)
drop Int
n List1 x
xs))

-- | Attach the index to each element of a 'List1'.
index :: (Integral n) => List1 x -> List1 (n, x)
index :: forall n x. Integral n => List1 x -> List1 (n, x)
index = List1 n -> List1 x -> List1 (n, x)
forall x y. List1 x -> List1 y -> List1 (x, y)
zip ((n -> n) -> n -> List1 n
forall x. (x -> x) -> x -> List1 x
iterated n -> n
forall a. Enum a => a -> a
succ n
0)

-- | Whether the given element is not in the 'List1'.
notElem :: (Eq x) => x -> List1 x -> Bool
notElem :: forall x. Eq x => x -> List1 x -> Bool
notElem = (Bool -> Bool
not .) ((List1 x -> Bool) -> List1 x -> Bool)
-> (x -> List1 x -> Bool) -> x -> List1 x -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> List1 x -> Bool
forall x. Eq x => x -> List1 x -> Bool
elem

-- | Whether the given element is found in the 'List1'.
elem :: (Eq x) => x -> List1 x -> Bool
elem :: forall x. Eq x => x -> List1 x -> Bool
elem = (Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust .) ((List1 x -> Maybe Int) -> List1 x -> Bool)
-> (x -> List1 x -> Maybe Int) -> x -> List1 x -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> List1 x -> Maybe Int
forall x. Eq x => x -> List1 x -> Maybe Int
elemIndex

-- | The first index of the element, if it is found, within the 'List1'.
elemIndex :: (Eq x) => x -> List1 x -> Maybe Int
elemIndex :: forall x. Eq x => x -> List1 x -> Maybe Int
elemIndex = (x -> Bool) -> List1 x -> Maybe Int
forall x. (x -> Bool) -> List1 x -> Maybe Int
findIndex ((x -> Bool) -> List1 x -> Maybe Int)
-> (x -> x -> Bool) -> x -> List1 x -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> x -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | All the indices of the element, if it is found, within the 'List1'.
elemIndices :: (Eq x) => x -> List1 x -> Maybe (List1 Int)
elemIndices :: forall x. Eq x => x -> List1 x -> Maybe (List1 Int)
elemIndices = (x -> Bool) -> List1 x -> Maybe (List1 Int)
forall x. (x -> Bool) -> List1 x -> Maybe (List1 Int)
findIndices ((x -> Bool) -> List1 x -> Maybe (List1 Int))
-> (x -> x -> Bool) -> x -> List1 x -> Maybe (List1 Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> x -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | The first element, if any, to satisfy a predicate.
find :: (x -> Bool) -> List1 x -> Maybe x
find :: forall x. (x -> Bool) -> List1 x -> Maybe x
find x -> Bool
p = (List1 x -> x) -> Maybe (List1 x) -> Maybe x
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap List1 x -> x
forall x. List1 x -> x
head (Maybe (List1 x) -> Maybe x)
-> (List1 x -> Maybe (List1 x)) -> List1 x -> Maybe x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> Bool) -> List1 x -> Maybe (List1 x)
forall x. (x -> Bool) -> List1 x -> Maybe (List1 x)
filter x -> Bool
p

-- | The index of the first element, if any, to satisfy a predicate.
findIndex :: (x -> Bool) -> List1 x -> Maybe Int
findIndex :: forall x. (x -> Bool) -> List1 x -> Maybe Int
findIndex x -> Bool
p = (List1 Int -> Int) -> Maybe (List1 Int) -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap List1 Int -> Int
forall x. List1 x -> x
head (Maybe (List1 Int) -> Maybe Int)
-> (List1 x -> Maybe (List1 Int)) -> List1 x -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> Bool) -> List1 x -> Maybe (List1 Int)
forall x. (x -> Bool) -> List1 x -> Maybe (List1 Int)
findIndices x -> Bool
p

-- | All of the positions of the elements satisfying a predicate.
findIndices :: (x -> Bool) -> List1 x -> Maybe (List1 Int)
findIndices :: forall x. (x -> Bool) -> List1 x -> Maybe (List1 Int)
findIndices x -> Bool
p List1 x
xs = (((Int, x) -> Maybe Int) -> List1 (Int, x) -> Maybe (List1 Int))
-> List1 (Int, x) -> ((Int, x) -> Maybe Int) -> Maybe (List1 Int)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Int, x) -> Maybe Int) -> List1 (Int, x) -> Maybe (List1 Int)
forall x y. (x -> Maybe y) -> List1 x -> Maybe (List1 y)
mapMaybe (List1 x -> List1 (Int, x)
forall n x. Integral n => List1 x -> List1 (n, x)
index List1 x
xs) \(Int
i, x
x) -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (x -> Bool
p x
x) Maybe () -> Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
i

-- | The element at a given index.
(!?) :: List1 x -> Int -> Maybe x
(x
x :? Maybe (List1 x)
xs) !? :: forall x. List1 x -> Int -> Maybe x
!? Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe x
forall a. Maybe a
Nothing
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = x -> Maybe x
forall a. a -> Maybe a
Just x
x
  | Bool
otherwise = Maybe (List1 x)
xs Maybe (List1 x) -> (List1 x -> Maybe x) -> Maybe x
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (List1 x -> Int -> Maybe x
forall x. List1 x -> Int -> Maybe x
!? Int -> Int
forall a. Enum a => a -> a
pred Int
n)

-- | Given a 'List1' of pairs, find the second coordinate of the first element matching in the first coordinate.
lookup :: (Eq x) => x -> List1 (x, y) -> Maybe y
lookup :: forall x y. Eq x => x -> List1 (x, y) -> Maybe y
lookup x
x = ((x, y) -> y) -> Maybe (x, y) -> Maybe y
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (x, y) -> y
forall a b. (a, b) -> b
snd (Maybe (x, y) -> Maybe y)
-> (List1 (x, y) -> Maybe (x, y)) -> List1 (x, y) -> Maybe y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((x, y) -> Bool) -> List1 (x, y) -> Maybe (x, y)
forall x. (x -> Bool) -> List1 x -> Maybe x
find ((x
x ==) (x -> Bool) -> ((x, y) -> x) -> (x, y) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x, y) -> x
forall a b. (a, b) -> a
fst)

-- | Sort a 'List1'.
sort :: (Ord x) => List1 x -> List1 x
sort :: forall x. Ord x => List1 x -> List1 x
sort = ([x] -> [x]) -> List1 x -> List1 x
forall x. HasCallStack => ([x] -> [x]) -> List1 x -> List1 x
asList [x] -> [x]
forall a. Ord a => [a] -> [a]
List.sort

-- | Sort a 'List1' using the projection.
sortOn :: (Ord y) => (x -> y) -> List1 x -> List1 x
sortOn :: forall y x. Ord y => (x -> y) -> List1 x -> List1 x
sortOn = ([x] -> [x]) -> List1 x -> List1 x
forall x. HasCallStack => ([x] -> [x]) -> List1 x -> List1 x
asList (([x] -> [x]) -> List1 x -> List1 x)
-> ((x -> y) -> [x] -> [x]) -> (x -> y) -> List1 x -> List1 x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> y) -> [x] -> [x]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn

-- | Sort a 'List1' using an explicit comparison.
sortBy :: (x -> x -> Ordering) -> List1 x -> List1 x
sortBy :: forall x. (x -> x -> Ordering) -> List1 x -> List1 x
sortBy = ([x] -> [x]) -> List1 x -> List1 x
forall x. HasCallStack => ([x] -> [x]) -> List1 x -> List1 x
asList (([x] -> [x]) -> List1 x -> List1 x)
-> ((x -> x -> Ordering) -> [x] -> [x])
-> (x -> x -> Ordering)
-> List1 x
-> List1 x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> x -> Ordering) -> [x] -> [x]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy

-- | Group the elements of a 'List1' by equality.
group :: (Eq x) => List1 x -> List1 (List1 x)
group :: forall x. Eq x => List1 x -> List1 (List1 x)
group = (x -> x -> Bool) -> List1 x -> List1 (List1 x)
forall x. (x -> x -> Bool) -> List1 x -> List1 (List1 x)
groupBy x -> x -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | Group the elements of a 'List1' by equality on a projection.
groupOn :: (Eq y) => (x -> y) -> List1 x -> List1 (List1 x)
groupOn :: forall y x. Eq y => (x -> y) -> List1 x -> List1 (List1 x)
groupOn x -> y
f = (x -> x -> Bool) -> List1 x -> List1 (List1 x)
forall x. (x -> x -> Bool) -> List1 x -> List1 (List1 x)
groupBy ((y -> y -> Bool) -> (x -> y) -> x -> x -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on y -> y -> Bool
forall a. Eq a => a -> a -> Bool
(==) x -> y
f)

-- | Group the elements of a 'List1' with an explicit equality test.
groupBy :: (x -> x -> Bool) -> List1 x -> List1 (List1 x)
groupBy :: forall x. (x -> x -> Bool) -> List1 x -> List1 (List1 x)
groupBy x -> x -> Bool
eq = ((List1 x -> List1 (List1 x)) -> List1 x -> List1 (List1 x))
-> List1 x -> List1 (List1 x)
forall a. (a -> a) -> a
fix \List1 x -> List1 (List1 x)
rec (x
x :| [x]
lx) -> case (x -> Bool) -> [x] -> ([x], [x])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.span (x -> x -> Bool
eq x
x) [x]
lx of
  ([x]
xs, [x]
ys) -> (x
x x -> [x] -> List1 x
forall a. a -> [a] -> NonEmpty a
:| [x]
xs) List1 x -> Maybe (List1 (List1 x)) -> List1 (List1 x)
forall x. x -> Maybe (List1 x) -> List1 x
:? [x] -> (List1 x -> List1 (List1 x)) -> Maybe (List1 (List1 x))
forall (m :: * -> *) x y.
Alternative m =>
[x] -> (List1 x -> y) -> m y
ifList1 [x]
ys List1 x -> List1 (List1 x)
rec

-- | Find the (possibly no) elements that are in both 'List1's.
intersect :: (Eq x) => List1 x -> List1 x -> Maybe (List1 x)
intersect :: forall x. Eq x => List1 x -> List1 x -> Maybe (List1 x)
intersect = (x -> x -> Bool) -> List1 x -> List1 x -> Maybe (List1 x)
forall x y.
(x -> y -> Bool) -> List1 x -> List1 y -> Maybe (List1 x)
intersectBy x -> x -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | Find the (possibly no) elements that are found in both 'List1's using a projection.
intersectOn :: (Eq y) => (x -> y) -> List1 x -> List1 x -> Maybe (List1 x)
intersectOn :: forall y x.
Eq y =>
(x -> y) -> List1 x -> List1 x -> Maybe (List1 x)
intersectOn x -> y
f = (x -> x -> Bool) -> List1 x -> List1 x -> Maybe (List1 x)
forall x y.
(x -> y -> Bool) -> List1 x -> List1 y -> Maybe (List1 x)
intersectBy ((y -> y -> Bool) -> (x -> y) -> x -> x -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on y -> y -> Bool
forall a. Eq a => a -> a -> Bool
(==) x -> y
f)

-- | Find the (possibly no) elements in the first 'List1' that match any element of the second 'List1' using an explicit equality test.
intersectBy :: (x -> y -> Bool) -> List1 x -> List1 y -> Maybe (List1 x)
intersectBy :: forall x y.
(x -> y -> Bool) -> List1 x -> List1 y -> Maybe (List1 x)
intersectBy x -> y -> Bool
eq List1 x
xs List1 y
ys = ((x -> Maybe x) -> List1 x -> Maybe (List1 x))
-> List1 x -> (x -> Maybe x) -> Maybe (List1 x)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (x -> Maybe x) -> List1 x -> Maybe (List1 x)
forall x y. (x -> Maybe y) -> List1 x -> Maybe (List1 y)
mapMaybe List1 x
xs \x
x -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((y -> Bool) -> List1 y -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Fold.any (x -> y -> Bool
eq x
x) List1 y
ys) Maybe () -> x -> Maybe x
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> x
x

-- | Combine two 'List1's, keeping only those elements from the second 'List1' that are not already in the first.
union :: (Eq x) => List1 x -> List1 x -> List1 x
union :: forall x. Eq x => List1 x -> List1 x -> List1 x
union = (x -> x -> Bool) -> List1 x -> List1 x -> List1 x
forall x. (x -> x -> Bool) -> List1 x -> List1 x -> List1 x
unionBy x -> x -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | Similar to 'union' but using equality on a projection.
unionOn :: (Eq y) => (x -> y) -> List1 x -> List1 x -> List1 x
unionOn :: forall y x. Eq y => (x -> y) -> List1 x -> List1 x -> List1 x
unionOn x -> y
f = (x -> x -> Bool) -> List1 x -> List1 x -> List1 x
forall x. (x -> x -> Bool) -> List1 x -> List1 x -> List1 x
unionBy ((y -> y -> Bool) -> (x -> y) -> x -> x -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on y -> y -> Bool
forall a. Eq a => a -> a -> Bool
(==) x -> y
f)

-- | Similar to 'union' but with an explicit equality test.
unionBy :: (x -> x -> Bool) -> List1 x -> List1 x -> List1 x
unionBy :: forall x. (x -> x -> Bool) -> List1 x -> List1 x -> List1 x
unionBy x -> x -> Bool
eq List1 x
xs List1 x
ys =
  List1 x
xs List1 x -> List1 x -> List1 x
forall a. Semigroup a => a -> a -> a
<> (x -> List1 x -> List1 x) -> List1 x -> [x] -> List1 x
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Fold.foldr ((Maybe (List1 x) -> List1 x
forall a. HasCallStack => Maybe a -> a
fromJust .) ((List1 x -> Maybe (List1 x)) -> List1 x -> List1 x)
-> (x -> List1 x -> Maybe (List1 x)) -> x -> List1 x -> List1 x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> x -> Bool) -> x -> List1 x -> Maybe (List1 x)
forall x. (x -> x -> Bool) -> x -> List1 x -> Maybe (List1 x)
deleteBy x -> x -> Bool
eq) ((x -> x -> Bool) -> List1 x -> List1 x
forall x. (x -> x -> Bool) -> List1 x -> List1 x
nubBy x -> x -> Bool
eq List1 x
ys) (List1 x -> [x]
forall x. List1 x -> [x]
toList List1 x
xs)

-- | Keep only one copy of each element.
nub :: (Eq x) => List1 x -> List1 x
nub :: forall x. Eq x => List1 x -> List1 x
nub = (x -> x -> Bool) -> List1 x -> List1 x
forall x. (x -> x -> Bool) -> List1 x -> List1 x
nubBy x -> x -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | Keep only one copy of each element whose projections match.
nubOn :: (Eq y) => (x -> y) -> List1 x -> List1 x
nubOn :: forall y x. Eq y => (x -> y) -> List1 x -> List1 x
nubOn x -> y
f = (x -> x -> Bool) -> List1 x -> List1 x
forall x. (x -> x -> Bool) -> List1 x -> List1 x
nubBy ((y -> y -> Bool) -> (x -> y) -> x -> x -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on y -> y -> Bool
forall a. Eq a => a -> a -> Bool
(==) x -> y
f)

-- | Keep only one copy of each element whose projections match the explicit equality test.
nubBy :: (x -> x -> Bool) -> List1 x -> List1 x
nubBy :: forall x. (x -> x -> Bool) -> List1 x -> List1 x
nubBy x -> x -> Bool
eq (x
x :| [x]
xs) = x
x x -> [x] -> NonEmpty x
forall a. a -> [a] -> NonEmpty a
:| (x -> x -> Bool) -> [x] -> [x]
forall a. (a -> a -> Bool) -> [a] -> [a]
List.nubBy x -> x -> Bool
eq ((x -> Bool) -> [x] -> [x]
forall a. (a -> Bool) -> [a] -> [a]
List.filter (Bool -> Bool
not (Bool -> Bool) -> (x -> Bool) -> x -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> x -> Bool
eq x
x) [x]
xs)

-- | Find the maximum of a 'List1'.
maximum :: (Ord x) => List1 x -> x
maximum :: forall x. Ord x => List1 x -> x
maximum = NonEmpty x -> x
forall x. Ord x => List1 x -> x
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Fold.maximum

-- | Find the maximum of a projection function.
maximumOf :: (Ord y) => (x -> y) -> List1 x -> y
maximumOf :: forall y x. Ord y => (x -> y) -> List1 x -> y
maximumOf x -> y
f = List1 y -> y
forall x. Ord x => List1 x -> x
maximum (List1 y -> y) -> (List1 x -> List1 y) -> List1 x -> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> y) -> List1 x -> List1 y
forall x y. (x -> y) -> List1 x -> List1 y
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> y
f

-- | Find the element with maximal projection.
maximumOn :: (Ord y) => (x -> y) -> List1 x -> x
maximumOn :: forall y x. Ord y => (x -> y) -> List1 x -> x
maximumOn x -> y
f = (x -> x -> Ordering) -> List1 x -> x
forall x. (x -> x -> Ordering) -> List1 x -> x
maximumBy ((x -> y) -> x -> x -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing x -> y
f)

-- | Find the maximum using an explicit comparison function.
maximumBy :: (x -> x -> Ordering) -> List1 x -> x
maximumBy :: forall x. (x -> x -> Ordering) -> List1 x -> x
maximumBy = (x -> x -> Ordering) -> NonEmpty x -> x
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
Fold.maximumBy

-- | Find the minimum of a 'List1'.
minimum :: (Ord x) => List1 x -> x
minimum :: forall x. Ord x => List1 x -> x
minimum = NonEmpty x -> x
forall x. Ord x => List1 x -> x
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Fold.minimum

-- | Find the minimum of a projection function.
minimumOf :: (Ord y) => (x -> y) -> List1 x -> y
minimumOf :: forall y x. Ord y => (x -> y) -> List1 x -> y
minimumOf x -> y
f = List1 y -> y
forall x. Ord x => List1 x -> x
minimum (List1 y -> y) -> (List1 x -> List1 y) -> List1 x -> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> y) -> List1 x -> List1 y
forall x y. (x -> y) -> List1 x -> List1 y
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> y
f

-- | Find the element with minimal projection.
minimumOn :: (Ord y) => (x -> y) -> List1 x -> x
minimumOn :: forall y x. Ord y => (x -> y) -> List1 x -> x
minimumOn x -> y
f = (x -> x -> Ordering) -> List1 x -> x
forall x. (x -> x -> Ordering) -> List1 x -> x
minimumBy ((x -> y) -> x -> x -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing x -> y
f)

-- | Find the minimum using an explicit comparison function.
minimumBy :: (x -> x -> Ordering) -> List1 x -> x
minimumBy :: forall x. (x -> x -> Ordering) -> List1 x -> x
minimumBy = (x -> x -> Ordering) -> NonEmpty x -> x
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
Fold.minimumBy

-- | Apply a function repeatedly to a starting value. The first element is the starting value.
iterate :: (x -> x) -> x -> List1 x
iterate :: forall x. (x -> x) -> x -> List1 x
iterate x -> x
f = ((x -> List1 x) -> x -> List1 x) -> x -> List1 x
forall a. (a -> a) -> a
fix \x -> List1 x
rec x
x -> x
x x -> List1 x -> List1 x
forall x. x -> List1 x -> List1 x
:|| x -> List1 x
rec (x -> x
f x
x)

-- | Apply a function strictly to a starting value. The first element is the starting value.
iterated :: (x -> x) -> x -> List1 x
iterated :: forall x. (x -> x) -> x -> List1 x
iterated x -> x
f = ((x -> List1 x) -> x -> List1 x) -> x -> List1 x
forall a. (a -> a) -> a
fix \x -> List1 x
rec !x
x -> x
x x -> List1 x -> List1 x
forall x. x -> List1 x -> List1 x
:|| x -> List1 x
rec (x -> x
f x
x)

-- | The infinite 'List1' consisting of a single value.
repeat :: x -> List1 x
repeat :: forall x. x -> List1 x
repeat = ((x -> List1 x) -> x -> List1 x) -> x -> List1 x
forall a. (a -> a) -> a
fix ((x -> List1 x -> List1 x) -> (x -> List1 x) -> x -> List1 x
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap x -> List1 x -> List1 x
forall x. x -> List1 x -> List1 x
(:||))

-- | The 'List1' of given length consisting only of the given value.
replicate :: Int -> x -> List1 x
replicate :: forall x. Int -> x -> List1 x
replicate Int
n x
x = case Int
n of
  Int
_ | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> [Char] -> List1 x
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.List1.replicate: argument must be positive"
  Int
1 -> x -> List1 x
forall x. x -> List1 x
Sole x
x
  Int
_ -> x
x x -> List1 x -> List1 x
forall x. x -> List1 x -> List1 x
:|| Int -> x -> List1 x
forall x. Int -> x -> List1 x
replicate (Int -> Int
forall a. Enum a => a -> a
pred Int
n) x
x

-- | The infinite 'List1' created by repeating the elements of the given 'List1'.
cycle :: List1 x -> List1 x
cycle :: forall x. List1 x -> List1 x
cycle = ((List1 x -> List1 x) -> List1 x -> List1 x) -> List1 x -> List1 x
forall a. (a -> a) -> a
fix ((List1 x -> List1 x -> List1 x)
-> (List1 x -> List1 x) -> List1 x -> List1 x
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap List1 x -> List1 x -> List1 x
forall a. Semigroup a => a -> a -> a
(<>))

-- | Place an element between all other elements in a 'List1'.
--
-- > intersperse 'y' ('a' :|| 'b' :|| Sole 'c') == ('a' :|| 'y' :|| 'b' :|| 'y' :|| Sole 'c')
intersperse :: x -> List1 x -> List1 x
intersperse :: forall x. x -> List1 x -> List1 x
intersperse x
y = ((List1 x -> List1 x) -> List1 x -> List1 x) -> List1 x -> List1 x
forall a. (a -> a) -> a
fix \List1 x -> List1 x
rec (x
x :? Maybe (List1 x)
xs) -> x
x x -> Maybe (List1 x) -> List1 x
forall x. x -> Maybe (List1 x) -> List1 x
:? (List1 x -> List1 x) -> Maybe (List1 x) -> Maybe (List1 x)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((x
y :||) (List1 x -> List1 x) -> (List1 x -> List1 x) -> List1 x -> List1 x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List1 x -> List1 x
rec) Maybe (List1 x)
xs

-- | Squash a 'List1' of 'List1's together with the given argument in between each 'List1'.
--
-- > intercalate (1 :|| Sole 1) (Sole 2 :|| Sole 3 :|| Sole (Sole 4)) == (2 :|| 1 :|| 1 :|| 3 :|| 1 :|| 1 :|| Sole 4)
intercalate :: List1 x -> List1 (List1 x) -> List1 x
intercalate :: forall x. List1 x -> List1 (List1 x) -> List1 x
intercalate = (NonEmpty (NonEmpty x) -> NonEmpty x
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join .) ((NonEmpty (NonEmpty x) -> NonEmpty (NonEmpty x))
 -> NonEmpty (NonEmpty x) -> NonEmpty x)
-> (NonEmpty x -> NonEmpty (NonEmpty x) -> NonEmpty (NonEmpty x))
-> NonEmpty x
-> NonEmpty (NonEmpty x)
-> NonEmpty x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty x -> NonEmpty (NonEmpty x) -> NonEmpty (NonEmpty x)
forall x. x -> List1 x -> List1 x
intersperse

transpose :: List1 (List1 x) -> List1 (List1 x)
transpose :: forall x. List1 (List1 x) -> List1 (List1 x)
transpose = ((List1 (List1 x) -> List1 (List1 x))
 -> List1 (List1 x) -> List1 (List1 x))
-> List1 (List1 x) -> List1 (List1 x)
forall a. (a -> a) -> a
fix \List1 (List1 x) -> List1 (List1 x)
rec ((x
x :| [x]
xs) :| [List1 x]
xss) -> case [(x, [x])] -> ([x], [[x]])
forall a b. [(a, b)] -> ([a], [b])
List.unzip ((List1 x -> (x, [x])) -> [List1 x] -> [(x, [x])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap List1 x -> (x, [x])
forall x. List1 x -> (x, [x])
uncons [List1 x]
xss) of
  ([x]
hs, [[x]]
ts) -> case ([x] -> Maybe (List1 x)) -> List1 [x] -> Maybe (List1 (List1 x))
forall x y. (x -> Maybe y) -> List1 x -> Maybe (List1 y)
mapMaybe [x] -> Maybe (List1 x)
forall x. [x] -> Maybe (List1 x)
list1 ([x]
xs [x] -> [[x]] -> List1 [x]
forall a. a -> [a] -> NonEmpty a
:| [[x]]
ts) of
    Maybe (List1 (List1 x))
Nothing -> List1 x -> List1 (List1 x)
forall x. x -> List1 x
Sole (x
x x -> [x] -> List1 x
forall a. a -> [a] -> NonEmpty a
:| [x]
hs)
    Just List1 (List1 x)
ys -> (x
x x -> [x] -> List1 x
forall a. a -> [a] -> NonEmpty a
:| [x]
hs) List1 x -> List1 (List1 x) -> List1 (List1 x)
forall x. x -> List1 x -> List1 x
:|| List1 (List1 x) -> List1 (List1 x)
rec List1 (List1 x)
ys

-- | All of the non-empty sublists of a 'List1', including those that skip elements.
subsequences :: List1 x -> List1 (List1 x)
subsequences :: forall x. List1 x -> List1 (List1 x)
subsequences = ((List1 x -> List1 (List1 x)) -> List1 x -> List1 (List1 x))
-> List1 x -> List1 (List1 x)
forall a. (a -> a) -> a
fix \List1 x -> List1 (List1 x)
rec (x
x :? Maybe (List1 x)
xs) ->
  x -> List1 x
forall x. x -> List1 x
Sole x
x List1 x -> Maybe (List1 (List1 x)) -> List1 (List1 x)
forall x. x -> Maybe (List1 x) -> List1 x
:? (List1 x -> List1 (List1 x))
-> Maybe (List1 x) -> Maybe (List1 (List1 x))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((List1 x -> List1 (List1 x) -> List1 (List1 x))
-> (List1 x -> List1 (List1 x)) -> List1 x -> List1 (List1 x)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap List1 x -> List1 (List1 x) -> List1 (List1 x)
forall x. x -> List1 x -> List1 x
(:||) (List1 x -> List1 (List1 x)
forall x. x -> List1 x
Sole (List1 x -> List1 (List1 x))
-> (List1 x -> List1 x) -> List1 x -> List1 (List1 x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x
x :||)) (List1 x -> List1 (List1 x))
-> (List1 x -> List1 (List1 x)) -> List1 x -> List1 (List1 x)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< List1 x -> List1 (List1 x)
rec) Maybe (List1 x)
xs

-- | @windows n@ lists the consecutive 'subsequences' of length @n@ of a 'List1': the subsequences of length @n@ that do not skip any elements.
windows :: Int -> List1 x -> Maybe (List1 (List1 x))
windows :: forall x. Int -> List1 x -> Maybe (List1 (List1 x))
windows Int
n List1 x
xs = Int -> List1 (List1 x) -> Maybe (List1 (List1 x))
forall x. Int -> List1 x -> Maybe (List1 x)
take (List1 x -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Fold.length List1 x
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
Num.- Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
Num.+ Int
1) (List1 (List1 x) -> Maybe (List1 (List1 x)))
-> Maybe (List1 (List1 x)) -> Maybe (List1 (List1 x))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (List1 x -> Maybe (List1 x))
-> List1 (List1 x) -> Maybe (List1 (List1 x))
forall x y. (x -> Maybe y) -> List1 x -> Maybe (List1 y)
mapMaybe (Int -> List1 x -> Maybe (List1 x)
forall x. Int -> List1 x -> Maybe (List1 x)
take Int
n) (List1 x -> List1 (List1 x)
forall x. List1 x -> List1 (List1 x)
tails List1 x
xs)

-- | All of the consecutive subsequences of a 'List1': the 'subsequences' that do not skip any elements.
consecutiveSubsequences :: List1 x -> List1 (List1 x)
consecutiveSubsequences :: forall x. List1 x -> List1 (List1 x)
consecutiveSubsequences List1 x
xs = List1 (List1 x) -> Maybe (List1 (List1 x)) -> List1 (List1 x)
forall a. a -> Maybe a -> a
fromMaybe (List1 x -> List1 (List1 x)
forall x. x -> List1 x
Sole List1 x
xs) (Maybe (List1 (List1 x)) -> List1 (List1 x))
-> Maybe (List1 (List1 x)) -> List1 (List1 x)
forall a b. (a -> b) -> a -> b
$ (Int -> Maybe (List1 (List1 x)))
-> [Int] -> Maybe (List1 (List1 x))
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Fold.foldMap (Int -> List1 x -> Maybe (List1 (List1 x))
forall x. Int -> List1 x -> Maybe (List1 (List1 x))
`windows` List1 x
xs) [Int
1 .. List1 x -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Fold.length List1 x
xs]

-- | The 'List1' of all rearrangements of a 'List1'.
permutations :: List1 x -> List1 (List1 x)
permutations :: forall x. List1 x -> List1 (List1 x)
permutations = ((List1 x -> List1 (List1 x)) -> List1 x -> List1 (List1 x))
-> List1 x -> List1 (List1 x)
forall a. (a -> a) -> a
fix \List1 x -> List1 (List1 x)
rec List1 x
xs ->
  (List1 x
xs :?) (Maybe (List1 (List1 x)) -> List1 (List1 x))
-> (Maybe (NonEmpty (List1 (List1 x))) -> Maybe (List1 (List1 x)))
-> Maybe (NonEmpty (List1 (List1 x)))
-> List1 (List1 x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty (List1 (List1 x)) -> List1 (List1 x))
-> Maybe (NonEmpty (List1 (List1 x))) -> Maybe (List1 (List1 x))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty (List1 (List1 x)) -> List1 (List1 x)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (NonEmpty (List1 (List1 x))) -> List1 (List1 x))
-> Maybe (NonEmpty (List1 (List1 x))) -> List1 (List1 x)
forall a b. (a -> b) -> a -> b
$ ((List1 x -> List1 x -> List1 (List1 x))
 -> List1 x -> Maybe (NonEmpty (List1 (List1 x))))
-> List1 x
-> (List1 x -> List1 x -> List1 (List1 x))
-> Maybe (NonEmpty (List1 (List1 x)))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (List1 x -> List1 x -> List1 (List1 x))
-> List1 x -> Maybe (NonEmpty (List1 (List1 x)))
forall x y. (List1 x -> List1 x -> y) -> List1 x -> Maybe (List1 y)
diagonally List1 x
xs \List1 x
hs (x
t :| [x]
ts) ->
    (List1 x -> List1 x) -> List1 (List1 x) -> List1 (List1 x)
forall x y. (x -> y) -> List1 x -> List1 y
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (List1 x -> [x] -> List1 x
forall x. List1 x -> [x] -> List1 x
<| [x]
ts) (List1 (List1 x) -> List1 (List1 x))
-> (List1 x -> List1 (List1 x)) -> List1 x -> List1 (List1 x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> List1 x -> List1 (List1 x)
forall x. x -> List1 x -> List1 (List1 x)
insertions x
t (List1 x -> List1 (List1 x)) -> List1 (List1 x) -> List1 (List1 x)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< List1 x -> List1 (List1 x)
rec List1 x
hs

-- | Apply a function on the prefix and suffix of a 'List1' at every index.
diagonally :: (List1 x -> List1 x -> y) -> List1 x -> Maybe (List1 y)
diagonally :: forall x y. (List1 x -> List1 x -> y) -> List1 x -> Maybe (List1 y)
diagonally List1 x -> List1 x -> y
f List1 x
xs =
  List1 (Maybe y) -> Maybe (List1 y)
forall x. List1 (Maybe x) -> Maybe (List1 x)
catMaybes (List1 (Maybe y) -> Maybe (List1 y))
-> List1 (Maybe y) -> Maybe (List1 y)
forall a b. (a -> b) -> a -> b
$
    (Maybe (List1 x) -> Maybe (List1 x) -> Maybe y)
-> List1 (Maybe (List1 x))
-> List1 (Maybe (List1 x))
-> List1 (Maybe y)
forall x y z. (x -> y -> z) -> List1 x -> List1 y -> List1 z
zipWith
      ((List1 x -> List1 x -> y)
-> Maybe (List1 x) -> Maybe (List1 x) -> Maybe y
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 List1 x -> List1 x -> y
f)
      (Maybe (List1 x)
forall a. Maybe a
Nothing Maybe (List1 x)
-> List1 (Maybe (List1 x)) -> List1 (Maybe (List1 x))
forall x. x -> List1 x -> List1 x
:|| (List1 x -> Maybe (List1 x)
forall a. a -> Maybe a
Just (List1 x -> Maybe (List1 x))
-> NonEmpty (List1 x) -> List1 (Maybe (List1 x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> List1 x -> NonEmpty (List1 x)
forall x. List1 x -> List1 (List1 x)
inits List1 x
xs))
      ((List1 x -> Maybe (List1 x)
forall a. a -> Maybe a
Just (List1 x -> Maybe (List1 x))
-> NonEmpty (List1 x) -> List1 (Maybe (List1 x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> List1 x -> NonEmpty (List1 x)
forall x. List1 x -> List1 (List1 x)
tails List1 x
xs) List1 (Maybe (List1 x))
-> Maybe (List1 x) -> List1 (Maybe (List1 x))
forall x. List1 x -> x -> List1 x
||: Maybe (List1 x)
forall a. Maybe a
Nothing)

-- | The 'init' and 'tail' of the 'List1' at each positive index.
--
-- >>> diagonals (1 :| [2, 3, 4])
-- [(1 :| [],2 :| [3,4]),(1 :| [2],3 :| [4]),(1 :| [2,3],4 :| [])]
diagonals :: List1 x -> [(List1 x, List1 x)]
diagonals :: forall x. List1 x -> [(List1 x, List1 x)]
diagonals = Maybe (List1 (List1 x, List1 x)) -> [(List1 x, List1 x)]
forall x. Maybe (List1 x) -> [x]
unList1 (Maybe (List1 (List1 x, List1 x)) -> [(List1 x, List1 x)])
-> (List1 x -> Maybe (List1 (List1 x, List1 x)))
-> List1 x
-> [(List1 x, List1 x)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List1 x -> List1 x -> (List1 x, List1 x))
-> List1 x -> Maybe (List1 (List1 x, List1 x))
forall x y. (List1 x -> List1 x -> y) -> List1 x -> Maybe (List1 y)
diagonally (,)

-- | Insert an element before each member of a 'List1'.
--
-- > insertions x (a :|| b :|| c :|| ...)
-- >     == (x :|| a :|| b :|| c :|| ...)
-- >    :|| (a :|| x :|| b :|| c :|| ...)
-- >    :|| (a :|| b :|| x :|| c :|| ...) ...
insertions :: x -> List1 x -> List1 (List1 x)
insertions :: forall x. x -> List1 x -> List1 (List1 x)
insertions x
x = ((List1 x -> List1 (List1 x)) -> List1 x -> List1 (List1 x))
-> List1 x -> List1 (List1 x)
forall a. (a -> a) -> a
fix \List1 x -> List1 (List1 x)
rec ly :: List1 x
ly@(x
y :? Maybe (List1 x)
ys) ->
  (x
x x -> List1 x -> List1 x
forall x. x -> List1 x -> List1 x
:|| List1 x
ly) List1 x -> Maybe (List1 (List1 x)) -> List1 (List1 x)
forall x. x -> Maybe (List1 x) -> List1 x
:? ((List1 x -> List1 x) -> List1 (List1 x) -> List1 (List1 x)
forall x y. (x -> y) -> List1 x -> List1 y
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (x
y :||) (List1 (List1 x) -> List1 (List1 x))
-> (List1 x -> List1 (List1 x)) -> List1 x -> List1 (List1 x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List1 x -> List1 (List1 x)
rec (List1 x -> List1 (List1 x))
-> Maybe (List1 x) -> Maybe (List1 (List1 x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (List1 x)
ys)

data Wedge x y = Nowhere | Here x | There y deriving ((forall a b. (a -> b) -> Wedge x a -> Wedge x b)
-> (forall a b. a -> Wedge x b -> Wedge x a) -> Functor (Wedge x)
forall a b. a -> Wedge x b -> Wedge x a
forall a b. (a -> b) -> Wedge x a -> Wedge x b
forall x a b. a -> Wedge x b -> Wedge x a
forall x a b. (a -> b) -> Wedge x a -> Wedge x b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall x a b. (a -> b) -> Wedge x a -> Wedge x b
fmap :: forall a b. (a -> b) -> Wedge x a -> Wedge x b
$c<$ :: forall x a b. a -> Wedge x b -> Wedge x a
<$ :: forall a b. a -> Wedge x b -> Wedge x a
Functor)

instance Bifunctor Wedge where
  bimap :: (x -> x') -> (y -> y') -> Wedge x y -> Wedge x' y'
  bimap :: forall a b c d. (a -> b) -> (c -> d) -> Wedge a c -> Wedge b d
bimap x -> x'
f y -> y'
g = \case
    Wedge x y
Nowhere -> Wedge x' y'
forall x y. Wedge x y
Nowhere
    Here x
x -> x' -> Wedge x' y'
forall x y. x -> Wedge x y
Here (x -> x'
f x
x)
    There y
y -> y' -> Wedge x' y'
forall x y. y -> Wedge x y
There (y -> y'
g y
y)

-- -- | Zip two lists with the provided function without deleting the tail of the longer list.
-- --
-- -- >>> zipWithTruncate (,) [1, 2, 3] [10, 20, 30, 40, 50]
-- -- ([(1,10),(2,20),(3,30)],There [40,50])
-- zipWithTruncate :: (a -> b -> c) -> [a] -> [b] -> ([c], Wedge [a] [b])
-- zipWithTruncate f as bs =
--   bimap
--     (maybe [] toList)
--     (bimap toList toList)
--     (zipWithTruncate' f (list1 as) (list1 bs))

-- | The workhorse of 'zipWithTruncate' and 'zipWithTruncate1'.
zipWithTruncate' ::
  (a -> b -> c) ->
  Maybe (List1 a) ->
  Maybe (List1 b) ->
  (Maybe (List1 c), Wedge (List1 a) (List1 b))
zipWithTruncate' :: forall a b c.
(a -> b -> c)
-> Maybe (List1 a)
-> Maybe (List1 b)
-> (Maybe (List1 c), Wedge (List1 a) (List1 b))
zipWithTruncate' a -> b -> c
f = ((Maybe (List1 a)
  -> Maybe (List1 b) -> (Maybe (List1 c), Wedge (List1 a) (List1 b)))
 -> Maybe (List1 a)
 -> Maybe (List1 b)
 -> (Maybe (List1 c), Wedge (List1 a) (List1 b)))
-> Maybe (List1 a)
-> Maybe (List1 b)
-> (Maybe (List1 c), Wedge (List1 a) (List1 b))
forall a. (a -> a) -> a
fix \Maybe (List1 a)
-> Maybe (List1 b) -> (Maybe (List1 c), Wedge (List1 a) (List1 b))
rec -> \cases
  Maybe (List1 a)
Nothing Maybe (List1 b)
Nothing -> (Maybe (List1 c)
forall a. Maybe a
Nothing, Wedge (List1 a) (List1 b)
forall x y. Wedge x y
Nowhere)
  Maybe (List1 a)
Nothing (Just List1 b
tb) -> (Maybe (List1 c)
forall a. Maybe a
Nothing, List1 b -> Wedge (List1 a) (List1 b)
forall x y. y -> Wedge x y
There List1 b
tb)
  (Just List1 a
ta) Maybe (List1 b)
Nothing -> (Maybe (List1 c)
forall a. Maybe a
Nothing, List1 a -> Wedge (List1 a) (List1 b)
forall x y. x -> Wedge x y
Here List1 a
ta)
  (Just (a
a :| [a]
as)) (Just (b
b :| [b]
bs)) ->
    let (Maybe (List1 c)
__, Wedge (List1 a) (List1 b)
w) = Maybe (List1 a)
-> Maybe (List1 b) -> (Maybe (List1 c), Wedge (List1 a) (List1 b))
rec ([a] -> Maybe (List1 a)
forall x. [x] -> Maybe (List1 x)
list1 [a]
as) ([b] -> Maybe (List1 b)
forall x. [x] -> Maybe (List1 x)
list1 [b]
bs)
     in (List1 c -> Maybe (List1 c)
forall a. a -> Maybe a
Just (a -> b -> c
f a
a b
b c -> Maybe (List1 c) -> List1 c
forall x. x -> Maybe (List1 x) -> List1 x
:? Maybe (List1 c)
__), Wedge (List1 a) (List1 b)
w)

-- | Zip two 'List1's with the provided function without deleting the tail of the longer 'List1'.
zipWithTruncate1 ::
  (a -> b -> c) ->
  List1 a ->
  List1 b ->
  (List1 c, Wedge (List1 a) (List1 b))
zipWithTruncate1 :: forall a b c.
(a -> b -> c)
-> List1 a -> List1 b -> (List1 c, Wedge (List1 a) (List1 b))
zipWithTruncate1 a -> b -> c
f (a
a :| [a]
as) (b
b :| [b]
bs) =
  let (Maybe (List1 c)
__, Wedge (NonEmpty a) (NonEmpty b)
w) = (a -> b -> c)
-> Maybe (NonEmpty a)
-> Maybe (NonEmpty b)
-> (Maybe (List1 c), Wedge (NonEmpty a) (NonEmpty b))
forall a b c.
(a -> b -> c)
-> Maybe (List1 a)
-> Maybe (List1 b)
-> (Maybe (List1 c), Wedge (List1 a) (List1 b))
zipWithTruncate' a -> b -> c
f ([a] -> Maybe (NonEmpty a)
forall x. [x] -> Maybe (List1 x)
list1 [a]
as) ([b] -> Maybe (NonEmpty b)
forall x. [x] -> Maybe (List1 x)
list1 [b]
bs)
   in (a -> b -> c
f a
a b
b c -> Maybe (List1 c) -> List1 c
forall x. x -> Maybe (List1 x) -> List1 x
:? Maybe (List1 c)
__, Wedge (NonEmpty a) (NonEmpty b)
w)