{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Redundant lambda" #-}

-- |
-- Copyright:   (c) 2022 Bodigrim
-- License:     BSD3
--
-- Modern lightweight library for infinite lists with fusion:
--
-- * API similar to "Data.List".
-- * No non-boot dependencies.
-- * Top performance, driven by fusion.
-- * Avoid dangerous instances like `Data.Foldable.Foldable`.
-- * Use `NonEmpty` where applicable.
-- * Use `Word` for indices.
-- * Be lazy, but not too lazy.
--
-- @
-- {\-# LANGUAGE PostfixOperators #-\}
-- import Data.List.Infinite (Infinite(..), (...), (....))
-- import qualified Data.List.Infinite as Inf
-- @
module Data.List.Infinite (
  -- * Construction
  Infinite (..),

  -- * Elimination
  head,
  tail,
  uncons,
  toList,
  foldr,

  -- * Traversals
  map,
  scanl,
  scanl',
  scanl1,
  mapAccumL,

  -- * Transformations
  concat,
  concatMap,
  intersperse,
  intercalate,
  interleave,
  transpose,
  subsequences,
  subsequences1,
  permutations,

  -- * Building
  (...),
  (....),
  iterate,
  iterate',
  unfoldr,
  tabulate,
  repeat,
  cycle,

  -- * Sublists
  prependList,
  take,
  drop,
  splitAt,
  takeWhile,
  dropWhile,
  span,
  break,
  group,
  inits,
  inits1,
  tails,
  isPrefixOf,
  stripPrefix,

  -- * Searching
  filter,
  lookup,
  find,
  mapMaybe,
  catMaybes,
  partition,
  mapEither,
  partitionEithers,

  -- * Indexing
  (!!),
  elemIndex,
  elemIndices,
  findIndex,
  findIndices,

  -- * Zipping
  zip,
  zipWith,
  zip3,
  zipWith3,
  zip4,
  zipWith4,
  zip5,
  zipWith5,
  zip6,
  zipWith6,
  zip7,
  zipWith7,
  unzip,
  unzip3,
  unzip4,
  unzip5,
  unzip6,
  unzip7,

  -- * Functions on strings
  lines,
  words,
  unlines,
  unwords,

  -- * Set operations
  nub,
  delete,
  (\\),
  union,
  intersect,

  -- * Ordered lists
  insert,

  -- * Generalized functions
  nubBy,
  deleteBy,
  deleteFirstsBy,
  unionBy,
  intersectBy,
  groupBy,
  insertBy,
  genericTake,
  genericDrop,
  genericSplitAt,
) where

import Control.Applicative (Applicative (..))
import Control.Arrow (first, second)
import Control.Monad (Monad (..))
import Data.Bits ((.&.))
import Data.Char (Char, isSpace)
import Data.Coerce (coerce)
import Data.Either (Either, either)
import Data.Eq (Eq, (/=), (==))
import qualified Data.Foldable as F
import Data.Functor (Functor (..))
import qualified Data.List as List
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe (maybe)
import Data.Ord (Ord, Ordering (..), compare, (<), (<=), (>), (>=))
import qualified GHC.Exts
import Numeric.Natural (Natural)
import Prelude (Bool (..), Enum, Int, Integer, Integral, Maybe (..), Word, const, enumFrom, enumFromThen, flip, id, maxBound, minBound, not, otherwise, snd, uncurry, (&&), (+), (-), (.), (||))

#if MIN_VERSION_base(4,10,0)
import GHC.Exts (oneShot)
#else
import GHC.Magic (oneShot)
#endif

import Data.List.Infinite.Internal
import Data.List.Infinite.Zip

-- | Right-associative fold of an infinite list, necessarily lazy in the accumulator.
-- Any unconditional attempt to force the accumulator even
-- to the weak head normal form (WHNF)
-- will hang the computation. E. g., the following definition isn't productive:
--
-- > import Data.List.NonEmpty (NonEmpty(..))
-- > toNonEmpty = foldr (\a (x :| xs) -> a :| x : xs) :: Infinite a -> NonEmpty a
--
-- One should use lazy patterns, e. g.,
--
-- > toNonEmpty = foldr (\a ~(x :| xs) -> a :| x : xs)
--
-- This is a catamorphism on infinite lists.
foldr :: (a -> b -> b) -> Infinite a -> b
foldr :: forall a b. (a -> b -> b) -> Infinite a -> b
foldr a -> b -> b
f = Infinite a -> b
go
  where
    go :: Infinite a -> b
go (a
x :< Infinite a
xs) = a -> b -> b
f a
x (Infinite a -> b
go Infinite a
xs)
{-# INLINE [0] foldr #-}

{-# RULES
"foldr/build" forall cons (g :: forall b. (a -> b -> b) -> b).
  foldr cons (build g) =
    g cons
"foldr/cons/build" forall cons x (g :: forall b. (a -> b -> b) -> b).
  foldr cons (x :< build g) =
    cons x (g cons)
  #-}

-- | Paramorphism on infinite lists.
para :: forall a b. (a -> Infinite a -> b -> b) -> Infinite a -> b
para :: forall a b. (a -> Infinite a -> b -> b) -> Infinite a -> b
para a -> Infinite a -> b -> b
f = Infinite a -> b
go
  where
    go :: Infinite a -> b
    go :: Infinite a -> b
go (a
x :< Infinite a
xs) = a -> Infinite a -> b -> b
f a
x Infinite a
xs (Infinite a -> b
go Infinite a
xs)

-- | Convert to a list. Use 'cycle' to go in the opposite direction.
toList :: Infinite a -> [a]
toList :: forall a. Infinite a -> [a]
toList = forall a b. (a -> b -> b) -> Infinite a -> b
foldr (:)
{-# NOINLINE [0] toList #-}

{-# RULES
"toList" [~1] forall xs.
  toList xs =
    GHC.Exts.build (\cons -> const (foldr cons xs))
  #-}

-- | Generate an infinite progression, starting from a given element,
-- similar to @[x..]@.
-- For better user experience consider enabling @{\-# LANGUAGE PostfixOperators #-\}@:
--
-- >>> :set -XPostfixOperators
-- >>> Data.List.Infinite.take 10 (0...)
-- [0,1,2,3,4,5,6,7,8,9]
--
-- Beware that for finite types '(...)' applies 'cycle' atop of @[x..]@:
--
-- >>> :set -XPostfixOperators
-- >>> Data.List.Infinite.take 10 (EQ...)
-- [EQ,GT,EQ,GT,EQ,GT,EQ,GT,EQ,GT]
--
-- Remember that 'Int' is a finite type as well. One is unlikely to hit this
-- on a 64-bit architecture, but on a 32-bit machine it's fairly possible to traverse
-- @((0 :: 'Int') ...)@ far enough to encounter @0@ again.
(...) :: Enum a => a -> Infinite a
... :: forall a. Enum a => a -> Infinite a
(...) = forall a. [a] -> Infinite a
unsafeCycle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> [a]
enumFrom
{-# INLINE [0] (...) #-}

infix 0 ...

{-# RULES
"ellipsis3Int" (...) = ellipsis3Int
"ellipsis3Word" (...) = ellipsis3Word
"ellipsis3Integer" (...) = ellipsis3Integer
"ellipsis3Natural" (...) = ellipsis3Natural
  #-}

ellipsis3Int :: Int -> Infinite Int
ellipsis3Int :: Int -> Infinite Int
ellipsis3Int Int
from = forall a. (a -> a) -> a -> Infinite a
iterate' (\Int
n -> if Int
n forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
maxBound then Int
from else Int
n forall a. Num a => a -> a -> a
+ Int
1) Int
from
{-# INLINE ellipsis3Int #-}

ellipsis3Word :: Word -> Infinite Word
ellipsis3Word :: Word -> Infinite Word
ellipsis3Word Word
from = forall a. (a -> a) -> a -> Infinite a
iterate' (\Word
n -> if Word
n forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
maxBound then Word
from else Word
n forall a. Num a => a -> a -> a
+ Word
1) Word
from
{-# INLINE ellipsis3Word #-}

ellipsis3Integer :: Integer -> Infinite Integer
ellipsis3Integer :: Integer -> Infinite Integer
ellipsis3Integer = forall a. (a -> a) -> a -> Infinite a
iterate' (forall a. Num a => a -> a -> a
+ Integer
1)
{-# INLINE ellipsis3Integer #-}

ellipsis3Natural :: Natural -> Infinite Natural
ellipsis3Natural :: Natural -> Infinite Natural
ellipsis3Natural = forall a. (a -> a) -> a -> Infinite a
iterate' (forall a. Num a => a -> a -> a
+ Natural
1)
{-# INLINE ellipsis3Natural #-}

-- | Generate an infinite arithmetic progression, starting from given elements,
-- similar to @[x,y..]@.
-- For better user experience consider enabling @{\-# LANGUAGE PostfixOperators #-\}@:
--
-- >>> :set -XPostfixOperators
-- >>> Data.List.Infinite.take 10 ((1,3)....)
-- [1,3,5,7,9,11,13,15,17,19]
--
-- Beware that for finite types '(....)' applies 'cycle' atop of @[x,y..]@:
--
-- >>> :set -XPostfixOperators
-- >>> Data.List.Infinite.take 10 ((EQ,GT)....)
-- [EQ,GT,EQ,GT,EQ,GT,EQ,GT,EQ,GT]
--
-- Remember that 'Int' is a finite type as well: for a sufficiently large
-- step of progression @y - x@ one may observe @((x :: Int, y)....)@ cycling back
-- to emit @x@ fairly soon.
(....) :: Enum a => (a, a) -> Infinite a
.... :: forall a. Enum a => (a, a) -> Infinite a
(....) = forall a. [a] -> Infinite a
unsafeCycle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Enum a => a -> a -> [a]
enumFromThen
{-# INLINE [0] (....) #-}

infix 0 ....

{-# RULES
"ellipsis4Int" (....) = ellipsis4Int
"ellipsis4Word" (....) = ellipsis4Word
"ellipsis4Integer" (....) = ellipsis4Integer
"ellipsis4Natural" (....) = ellipsis4Natural
  #-}

ellipsis4Int :: (Int, Int) -> Infinite Int
ellipsis4Int :: (Int, Int) -> Infinite Int
ellipsis4Int (Int
from, Int
thn)
  | Int
from forall a. Ord a => a -> a -> Bool
<= Int
thn =
      let d :: Int
d = Int
thn forall a. Num a => a -> a -> a
- Int
from
       in forall a. (a -> a) -> a -> Infinite a
iterate' (\Int
n -> if Int
n forall a. Ord a => a -> a -> Bool
> forall a. Bounded a => a
maxBound forall a. Num a => a -> a -> a
- Int
d then Int
from else Int
n forall a. Num a => a -> a -> a
+ Int
d) Int
from
  | Bool
otherwise =
      let d :: Int
d = Int
from forall a. Num a => a -> a -> a
- Int
thn
       in forall a. (a -> a) -> a -> Infinite a
iterate' (\Int
n -> if Int
n forall a. Ord a => a -> a -> Bool
< forall a. Bounded a => a
minBound forall a. Num a => a -> a -> a
+ Int
d then Int
from else Int
n forall a. Num a => a -> a -> a
- Int
d) Int
from
{-# INLINE ellipsis4Int #-}

ellipsis4Word :: (Word, Word) -> Infinite Word
ellipsis4Word :: (Word, Word) -> Infinite Word
ellipsis4Word (Word
from, Word
thn)
  | Word
from forall a. Ord a => a -> a -> Bool
<= Word
thn =
      let d :: Word
d = Word
thn forall a. Num a => a -> a -> a
- Word
from
       in forall a. (a -> a) -> a -> Infinite a
iterate' (\Word
n -> if Word
n forall a. Ord a => a -> a -> Bool
> forall a. Bounded a => a
maxBound forall a. Num a => a -> a -> a
- Word
d then Word
from else Word
n forall a. Num a => a -> a -> a
+ Word
d) Word
from
  | Bool
otherwise =
      let d :: Word
d = Word
from forall a. Num a => a -> a -> a
- Word
thn
       in forall a. (a -> a) -> a -> Infinite a
iterate' (\Word
n -> if Word
n forall a. Ord a => a -> a -> Bool
< Word
d then Word
from else Word
n forall a. Num a => a -> a -> a
- Word
d) Word
from
{-# INLINE ellipsis4Word #-}

ellipsis4Integer :: (Integer, Integer) -> Infinite Integer
ellipsis4Integer :: (Integer, Integer) -> Infinite Integer
ellipsis4Integer (Integer
from, Integer
thn) = forall a. (a -> a) -> a -> Infinite a
iterate' (forall a. Num a => a -> a -> a
+ (Integer
thn forall a. Num a => a -> a -> a
- Integer
from)) Integer
from
{-# INLINE ellipsis4Integer #-}

ellipsis4Natural :: (Natural, Natural) -> Infinite Natural
ellipsis4Natural :: (Natural, Natural) -> Infinite Natural
ellipsis4Natural (Natural
from, Natural
thn)
  | Natural
from forall a. Ord a => a -> a -> Bool
<= Natural
thn =
      forall a. (a -> a) -> a -> Infinite a
iterate' (forall a. Num a => a -> a -> a
+ (Natural
thn forall a. Num a => a -> a -> a
- Natural
from)) Natural
from
  | Bool
otherwise =
      let d :: Natural
d = Natural
from forall a. Num a => a -> a -> a
- Natural
thn
       in forall a. (a -> a) -> a -> Infinite a
iterate' (\Natural
n -> if Natural
n forall a. Ord a => a -> a -> Bool
< Natural
d then Natural
from else Natural
n forall a. Num a => a -> a -> a
- Natural
d) Natural
from
{-# INLINE ellipsis4Natural #-}

-- | Just a pointwise 'map'.
instance Functor Infinite where
  fmap :: forall a b. (a -> b) -> Infinite a -> Infinite b
fmap = forall a b. (a -> b) -> Infinite a -> Infinite b
map
  <$ :: forall a b. a -> Infinite b -> Infinite a
(<$) = forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Infinite a
repeat

-- | This instance operates pointwise, similar to 'Control.Applicative.ZipList'.
instance Applicative Infinite where
  pure :: forall a. a -> Infinite a
pure = forall a. a -> Infinite a
repeat
  (a -> b
f :< Infinite (a -> b)
fs) <*> :: forall a b. Infinite (a -> b) -> Infinite a -> Infinite b
<*> (a
x :< Infinite a
xs) = a -> b
f a
x forall a. a -> Infinite a -> Infinite a
:< (Infinite (a -> b)
fs forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Infinite a
xs)
  <* :: forall a b. Infinite a -> Infinite b -> Infinite a
(<*) = forall a b. a -> b -> a
const
  *> :: forall a b. Infinite a -> Infinite b -> Infinite b
(*>) = forall a b. a -> b -> a
const forall a. a -> a
id
#if MIN_VERSION_base(4,10,0)
  liftA2 :: forall a b c.
(a -> b -> c) -> Infinite a -> Infinite b -> Infinite c
liftA2 = forall a b c.
(a -> b -> c) -> Infinite a -> Infinite b -> Infinite c
zipWith
#endif

-- | 'Control.Applicative.ZipList' cannot be made a lawful 'Monad',
-- but 'Infinite', being a
-- [@Representable@](https://hackage.haskell.org/package/adjunctions/docs/Data-Functor-Rep.html#t:Representable),
-- can. Namely, 'Control.Monad.join'
-- picks up a diagonal of an infinite matrix of 'Infinite' ('Infinite' @a@).
-- Bear in mind that this instance gets slow
-- very soon because of linear indexing, so it is not recommended to be used
-- in practice.
instance Monad Infinite where
  Infinite a
xs >>= :: forall a b. Infinite a -> (a -> Infinite b) -> Infinite b
>>= a -> Infinite b
f = Natural -> Infinite a -> Infinite b
go Natural
0 Infinite a
xs
    where
      go :: Natural -> Infinite a -> Infinite b
go !Natural
n (a
y :< Infinite a
ys) = (a -> Infinite b
f a
y forall a. Infinite a -> Natural -> a
`index` Natural
n) forall a. a -> Infinite a -> Infinite a
:< Natural -> Infinite a -> Infinite b
go (Natural
n forall a. Num a => a -> a -> a
+ Natural
1) Infinite a
ys
      index :: Infinite a -> Natural -> a
      index :: forall a. Infinite a -> Natural -> a
index Infinite a
ys Natural
n = forall a. Infinite a -> a
head (forall i a. Integral i => i -> Infinite a -> Infinite a
genericDrop Natural
n Infinite a
ys)
  {-# INLINE (>>=) #-}
  >> :: forall a b. Infinite a -> Infinite b -> Infinite b
(>>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)

-- | Get the first elements of an infinite list.
head :: Infinite a -> a
head :: forall a. Infinite a -> a
head (a
x :< Infinite a
_) = a
x
{-# NOINLINE [1] head #-}

{-# RULES
"head/build" forall (g :: forall b. (a -> b -> b) -> b).
  head (build g) =
    g const
  #-}

-- | Get the elements of an infinite list after the first one.
tail :: Infinite a -> Infinite a
tail :: forall a. Infinite a -> Infinite a
tail (a
_ :< Infinite a
xs) = Infinite a
xs

-- | Split an infinite list into its 'head' and 'tail'.
uncons :: Infinite a -> (a, Infinite a)
uncons :: forall a. Infinite a -> (a, Infinite a)
uncons (a
x :< Infinite a
xs) = (a
x, Infinite a
xs)

-- | Apply a function to every element of an infinite list.
map :: (a -> b) -> Infinite a -> Infinite b
map :: forall a b. (a -> b) -> Infinite a -> Infinite b
map = forall a b. (a -> b -> b) -> Infinite a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> Infinite a -> Infinite a
(:<) forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

mapFB :: (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst
mapFB :: forall elt lst a.
(elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst
mapFB = forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)

{-# NOINLINE [0] map #-}

{-# INLINE [0] mapFB #-}

{-# RULES
"map" [~1] forall f xs.
  map f xs =
    build (\cons -> foldr (mapFB cons f) xs)
"mapList" [1] forall f.
  foldr (mapFB (:<) f) =
    map f
"mapFB" forall cons f g.
  mapFB (mapFB cons f) g =
    mapFB cons (f . g)
"map/coerce" [1]
  map coerce =
    coerce
  #-}

-- | Flatten out an infinite list of non-empty lists.
--
-- The peculiar type with 'NonEmpty' is to guarantee that 'concat'
-- is productive and results in an infinite list. Otherwise the
-- concatenation of infinitely many @[a]@ could still be a finite list.
concat :: Infinite (NonEmpty a) -> Infinite a
concat :: forall a. Infinite (NonEmpty a) -> Infinite a
concat = forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\(a
x :| [a]
xs) Infinite a
acc -> a
x forall a. a -> Infinite a -> Infinite a
:< ([a]
xs forall a. [a] -> Infinite a -> Infinite a
`prependList` Infinite a
acc))
{-# NOINLINE [1] concat #-}

{-# RULES
"concat" forall xs.
  concat xs =
    build (\cons -> foldr (flip (F.foldr cons)) xs)
  #-}

-- | First 'map' every element, then 'concat'.
--
-- The peculiar type with 'NonEmpty' is to guarantee that 'concatMap'
-- is productive and results in an infinite list. Otherwise the
-- concatenation of infinitely many @[b]@ could still be a finite list.
concatMap :: (a -> NonEmpty b) -> Infinite a -> Infinite b
concatMap :: forall a b. (a -> NonEmpty b) -> Infinite a -> Infinite b
concatMap a -> NonEmpty b
f = forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\a
a Infinite b
acc -> let (b
x :| [b]
xs) = a -> NonEmpty b
f a
a in b
x forall a. a -> Infinite a -> Infinite a
:< ([b]
xs forall a. [a] -> Infinite a -> Infinite a
`prependList` Infinite b
acc))
{-# NOINLINE [1] concatMap #-}

{-# RULES
"concatMap" forall f xs.
  concatMap f xs =
    build (\cons -> foldr (flip (F.foldr cons) . f) xs)
  #-}

-- | Interleave two infinite lists.
interleave :: Infinite a -> Infinite a -> Infinite a
interleave :: forall a. Infinite a -> Infinite a -> Infinite a
interleave (a
x :< Infinite a
xs) Infinite a
ys = a
x forall a. a -> Infinite a -> Infinite a
:< forall a. Infinite a -> Infinite a -> Infinite a
interleave Infinite a
ys Infinite a
xs

-- | Insert an element between adjacent elements of an infinite list.
intersperse :: a -> Infinite a -> Infinite a
intersperse :: forall a. a -> Infinite a -> Infinite a
intersperse a
a = forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\a
x -> (a
x forall a. a -> Infinite a -> Infinite a
:<) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
a forall a. a -> Infinite a -> Infinite a
:<))
{-# NOINLINE [1] intersperse #-}

{-# RULES
"intersperse" forall a xs.
  intersperse a xs =
    build (\cons -> foldr (\x -> cons x . cons a) xs)
  #-}

-- | Insert a non-empty list between adjacent elements of an infinite list,
-- and subsequently flatten it out.
--
-- The peculiar type with 'NonEmpty' is to guarantee that 'intercalate'
-- is productive and results in an infinite list. If separator is an empty list,
-- concatenation of infinitely many @[a]@ could still be a finite list.
intercalate :: NonEmpty a -> Infinite [a] -> Infinite a
intercalate :: forall a. NonEmpty a -> Infinite [a] -> Infinite a
intercalate ~(a
a :| [a]
as) = forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\[a]
xs -> forall a. [a] -> Infinite a -> Infinite a
prependList [a]
xs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
a forall a. a -> Infinite a -> Infinite a
:<) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Infinite a -> Infinite a
prependList [a]
as)
{-# NOINLINE [1] intercalate #-}

{-# RULES
"intercalate" forall as xss.
  intercalate as xss =
    build (\cons -> foldr (\xs acc -> F.foldr cons (F.foldr cons acc as) xs) xss)
  #-}

-- | Transpose rows and columns of an argument.
--
-- This is actually @distribute@ from
-- [@Distributive@](https://hackage.haskell.org/package/distributive/docs/Data-Distributive.html#t:Distributive)
-- type class in disguise.
transpose :: Functor f => f (Infinite a) -> Infinite (f a)
transpose :: forall (f :: * -> *) a.
Functor f =>
f (Infinite a) -> Infinite (f a)
transpose f (Infinite a)
xss = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Infinite a -> a
head f (Infinite a)
xss forall a. a -> Infinite a -> Infinite a
:< forall (f :: * -> *) a.
Functor f =>
f (Infinite a) -> Infinite (f a)
transpose (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Infinite a -> Infinite a
tail f (Infinite a)
xss)

-- | Generate an infinite list of all subsequences of the argument.
subsequences :: Infinite a -> Infinite [a]
subsequences :: forall a. Infinite a -> Infinite [a]
subsequences = ([] forall a. a -> Infinite a -> Infinite a
:<) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> Infinite a -> Infinite b
map forall a. NonEmpty a -> [a]
NE.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Infinite a -> Infinite (NonEmpty a)
subsequences1

-- | Generate an infinite list of all non-empty subsequences of the argument.
subsequences1 :: Infinite a -> Infinite (NonEmpty a)
subsequences1 :: forall a. Infinite a -> Infinite (NonEmpty a)
subsequences1 = forall a b. (a -> b -> b) -> Infinite a -> b
foldr forall a. a -> Infinite (NonEmpty a) -> Infinite (NonEmpty a)
go
  where
    go :: a -> Infinite (NonEmpty a) -> Infinite (NonEmpty a)
    go :: forall a. a -> Infinite (NonEmpty a) -> Infinite (NonEmpty a)
go a
x Infinite (NonEmpty a)
sxs = (a
x forall a. a -> [a] -> NonEmpty a
:| []) forall a. a -> Infinite a -> Infinite a
:< forall a b. (a -> b -> b) -> Infinite a -> b
foldr NonEmpty a -> Infinite (NonEmpty a) -> Infinite (NonEmpty a)
f Infinite (NonEmpty a)
sxs
      where
        f :: NonEmpty a -> Infinite (NonEmpty a) -> Infinite (NonEmpty a)
f NonEmpty a
ys Infinite (NonEmpty a)
r = NonEmpty a
ys forall a. a -> Infinite a -> Infinite a
:< (a
x forall a. a -> NonEmpty a -> NonEmpty a
`NE.cons` NonEmpty a
ys) forall a. a -> Infinite a -> Infinite a
:< Infinite (NonEmpty a)
r

-- | Generate an infinite list of all permutations of the argument.
permutations :: Infinite a -> Infinite (Infinite a)
permutations :: forall a. Infinite a -> Infinite (Infinite a)
permutations Infinite a
xs0 = Infinite a
xs0 forall a. a -> Infinite a -> Infinite a
:< forall a. Infinite a -> [a] -> Infinite (Infinite a)
perms Infinite a
xs0 []
  where
    perms :: forall a. Infinite a -> [a] -> Infinite (Infinite a)
    perms :: forall a. Infinite a -> [a] -> Infinite (Infinite a)
perms (a
t :< Infinite a
ts) [a]
is = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr [a] -> Infinite (Infinite a) -> Infinite (Infinite a)
interleaveList (forall a. Infinite a -> [a] -> Infinite (Infinite a)
perms Infinite a
ts (a
t forall a. a -> [a] -> [a]
: [a]
is)) (forall a. [a] -> [[a]]
List.permutations [a]
is)
      where
        interleaveList :: [a] -> Infinite (Infinite a) -> Infinite (Infinite a)
        interleaveList :: [a] -> Infinite (Infinite a) -> Infinite (Infinite a)
interleaveList = (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b.
(Infinite a -> b) -> [a] -> Infinite b -> (Infinite a, Infinite b)
interleaveList' forall a. a -> a
id

        interleaveList' :: (Infinite a -> b) -> [a] -> Infinite b -> (Infinite a, Infinite b)
        interleaveList' :: forall b.
(Infinite a -> b) -> [a] -> Infinite b -> (Infinite a, Infinite b)
interleaveList' Infinite a -> b
_ [] Infinite b
r = (Infinite a
ts, Infinite b
r)
        interleaveList' Infinite a -> b
f (a
y : [a]
ys) Infinite b
r = (a
y forall a. a -> Infinite a -> Infinite a
:< Infinite a
us, Infinite a -> b
f (a
t forall a. a -> Infinite a -> Infinite a
:< a
y forall a. a -> Infinite a -> Infinite a
:< Infinite a
us) forall a. a -> Infinite a -> Infinite a
:< Infinite b
zs)
          where
            (Infinite a
us, Infinite b
zs) = forall b.
(Infinite a -> b) -> [a] -> Infinite b -> (Infinite a, Infinite b)
interleaveList' (Infinite a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
y forall a. a -> Infinite a -> Infinite a
:<)) [a]
ys Infinite b
r

-- | Fold an infinite list from the left and return a list of successive reductions,
-- starting from the initial accumulator:
--
-- > scanl f acc (x1 :< x2 :< ...) = acc :< f acc x1 :< f (f acc x1) x2 :< ...
scanl :: (b -> a -> b) -> b -> Infinite a -> Infinite b
scanl :: forall b a. (b -> a -> b) -> b -> Infinite a -> Infinite b
scanl b -> a -> b
f b
z0 = (b
z0 forall a. a -> Infinite a -> Infinite a
:<) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\a
x b -> Infinite b
acc b
z -> let fzx :: b
fzx = b -> a -> b
f b
z a
x in b
fzx forall a. a -> Infinite a -> Infinite a
:< b -> Infinite b
acc b
fzx)) b
z0

scanlFB :: (elt' -> elt -> elt') -> (elt' -> lst -> lst) -> elt -> (elt' -> lst) -> elt' -> lst
scanlFB :: forall elt' elt lst.
(elt' -> elt -> elt')
-> (elt' -> lst -> lst) -> elt -> (elt' -> lst) -> elt' -> lst
scanlFB elt' -> elt -> elt'
f elt' -> lst -> lst
cons = \elt
elt elt' -> lst
g -> oneShot :: forall a b. (a -> b) -> a -> b
oneShot (\elt'
x -> let elt' :: elt'
elt' = elt' -> elt -> elt'
f elt'
x elt
elt in elt'
elt' elt' -> lst -> lst
`cons` elt' -> lst
g elt'
elt')

{-# NOINLINE [1] scanl #-}

{-# INLINE [0] scanlFB #-}

{-# RULES
"scanl" [~1] forall f a bs.
  scanl f a bs =
    build (\cons -> a `cons` foldr (scanlFB f cons) bs a)
"scanlList" [1] forall f (a :: a) bs.
  foldr (scanlFB f (:<)) bs a =
    tail (scanl f a bs)
  #-}

-- | Same as 'scanl', but strict in accumulator.
scanl' :: (b -> a -> b) -> b -> Infinite a -> Infinite b
scanl' :: forall b a. (b -> a -> b) -> b -> Infinite a -> Infinite b
scanl' b -> a -> b
f b
z0 = (b
z0 forall a. a -> Infinite a -> Infinite a
:<) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\a
x b -> Infinite b
acc b
z -> let !fzx :: b
fzx = b -> a -> b
f b
z a
x in b
fzx forall a. a -> Infinite a -> Infinite a
:< b -> Infinite b
acc b
fzx)) b
z0

scanlFB' :: (elt' -> elt -> elt') -> (elt' -> lst -> lst) -> elt -> (elt' -> lst) -> elt' -> lst
scanlFB' :: forall elt' elt lst.
(elt' -> elt -> elt')
-> (elt' -> lst -> lst) -> elt -> (elt' -> lst) -> elt' -> lst
scanlFB' elt' -> elt -> elt'
f elt' -> lst -> lst
cons = \elt
elt elt' -> lst
g -> oneShot :: forall a b. (a -> b) -> a -> b
oneShot (\elt'
x -> let !elt' :: elt'
elt' = elt' -> elt -> elt'
f elt'
x elt
elt in elt'
elt' elt' -> lst -> lst
`cons` elt' -> lst
g elt'
elt')

{-# NOINLINE [1] scanl' #-}

{-# INLINE [0] scanlFB' #-}

{-# RULES
"scanl'" [~1] forall f a bs.
  scanl' f a bs =
    build (\cons -> a `cons` foldr (scanlFB' f cons) bs a)
"scanlList'" [1] forall f (a :: a) bs.
  foldr (scanlFB' f (:<)) bs a =
    tail (scanl' f a bs)
  #-}

-- | Fold an infinite list from the left and return a list of successive reductions,
-- starting from the first element:
--
-- > scanl1 f (x0 :< x1 :< x2 :< ...) = x0 :< f x0 x1 :< f (f x0 x1) x2 :< ...
scanl1 :: (a -> a -> a) -> Infinite a -> Infinite a
scanl1 :: forall a. (a -> a -> a) -> Infinite a -> Infinite a
scanl1 a -> a -> a
f (a
x :< Infinite a
xs) = forall b a. (b -> a -> b) -> b -> Infinite a -> Infinite b
scanl a -> a -> a
f a
x Infinite a
xs

-- | Fold an infinite list from the left and return a list of successive reductions,
-- keeping accumulator in a state:
--
-- > mapAccumL f acc0 (x1 :< x2 :< ...) =
-- >   let (acc1, y1) = f acc0 x1 in
-- >     let (acc2, y2) = f acc1 x2 in
-- >       ...
-- >         y1 :< y2 :< ...
--
-- If you are looking how to traverse with a state, look no further.
mapAccumL :: (acc -> x -> (acc, y)) -> acc -> Infinite x -> Infinite y
mapAccumL :: forall acc x y.
(acc -> x -> (acc, y)) -> acc -> Infinite x -> Infinite y
mapAccumL acc -> x -> (acc, y)
f = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\x
x acc -> Infinite y
acc acc
s -> let (acc
s', y
y) = acc -> x -> (acc, y)
f acc
s x
x in y
y forall a. a -> Infinite a -> Infinite a
:< acc -> Infinite y
acc acc
s'))

mapAccumLFB :: (acc -> x -> (acc, y)) -> x -> (acc -> Infinite y) -> acc -> Infinite y
mapAccumLFB :: forall acc x y.
(acc -> x -> (acc, y))
-> x -> (acc -> Infinite y) -> acc -> Infinite y
mapAccumLFB acc -> x -> (acc, y)
f = \x
x acc -> Infinite y
r -> oneShot :: forall a b. (a -> b) -> a -> b
oneShot (\acc
s -> let (acc
s', y
y) = acc -> x -> (acc, y)
f acc
s x
x in y
y forall a. a -> Infinite a -> Infinite a
:< acc -> Infinite y
r acc
s')

{-# NOINLINE [1] mapAccumL #-}

{-# INLINE [0] mapAccumLFB #-}

{-# RULES
"mapAccumL" [~1] forall f s xs.
  mapAccumL f s xs =
    foldr (mapAccumLFB f) xs s
"mapAccumLList" [1] forall f s xs.
  foldr (mapAccumLFB f) xs s =
    mapAccumL f s xs
  #-}

-- | Generate an infinite list of repeated applications.
iterate :: (a -> a) -> a -> Infinite a
iterate :: forall a. (a -> a) -> a -> Infinite a
iterate a -> a
f = a -> Infinite a
go
  where
    go :: a -> Infinite a
go a
x = a
x forall a. a -> Infinite a -> Infinite a
:< a -> Infinite a
go (a -> a
f a
x)

iterateFB :: (elt -> lst -> lst) -> (elt -> elt) -> elt -> lst
iterateFB :: forall elt lst. (elt -> lst -> lst) -> (elt -> elt) -> elt -> lst
iterateFB elt -> lst -> lst
cons elt -> elt
f = elt -> lst
go
  where
    go :: elt -> lst
go elt
x = elt
x elt -> lst -> lst
`cons` elt -> lst
go (elt -> elt
f elt
x)

{-# NOINLINE [1] iterate #-}

{-# INLINE [0] iterateFB #-}

{-# RULES
"iterate" [~1] forall f x. iterate f x = build (\cons -> iterateFB cons f x)
"iterateFB" [1] iterateFB (:<) = iterate
  #-}

-- | Same as 'iterate', but strict in accumulator.
iterate' :: (a -> a) -> a -> Infinite a
iterate' :: forall a. (a -> a) -> a -> Infinite a
iterate' a -> a
f = a -> Infinite a
go
  where
    go :: a -> Infinite a
go !a
x = a
x forall a. a -> Infinite a -> Infinite a
:< a -> Infinite a
go (a -> a
f a
x)

iterateFB' :: (elt -> lst -> lst) -> (elt -> elt) -> elt -> lst
iterateFB' :: forall elt lst. (elt -> lst -> lst) -> (elt -> elt) -> elt -> lst
iterateFB' elt -> lst -> lst
cons elt -> elt
f = elt -> lst
go
  where
    go :: elt -> lst
go !elt
x = elt
x elt -> lst -> lst
`cons` elt -> lst
go (elt -> elt
f elt
x)

{-# NOINLINE [1] iterate' #-}

{-# INLINE [0] iterateFB' #-}

{-# RULES
"iterate'" [~1] forall f x. iterate' f x = build (\cons -> iterateFB' cons f x)
"iterateFB'" [1] iterateFB' (:<) = iterate'
  #-}

-- | Repeat the same element ad infinitum.
repeat :: a -> Infinite a
repeat :: forall a. a -> Infinite a
repeat a
x = Infinite a
go
  where
    go :: Infinite a
go = a
x forall a. a -> Infinite a -> Infinite a
:< Infinite a
go

repeatFB :: (elt -> lst -> lst) -> elt -> lst
repeatFB :: forall elt lst. (elt -> lst -> lst) -> elt -> lst
repeatFB elt -> lst -> lst
cons elt
x = lst
go
  where
    go :: lst
go = elt
x elt -> lst -> lst
`cons` lst
go

{-# NOINLINE [1] repeat #-}

{-# INLINE [0] repeatFB #-}

{-# RULES
"repeat" [~1] forall x. repeat x = build (`repeatFB` x)
"repeatFB" [1] repeatFB (:<) = repeat
  #-}

-- | Repeat a non-empty list ad infinitum.
-- If you were looking for something like @fromList :: [a] -> Infinite a@,
-- look no further.
--
-- It would be less annoying to take @[a]@ instead of 'NonEmpty' @a@,
-- but we strive to avoid partial functions.
cycle :: NonEmpty a -> Infinite a
cycle :: forall a. NonEmpty a -> Infinite a
cycle (a
x :| [a]
xs) = forall a. [a] -> Infinite a
unsafeCycle (a
x forall a. a -> [a] -> [a]
: [a]
xs)
{-# INLINE cycle #-}

unsafeCycle :: [a] -> Infinite a
unsafeCycle :: forall a. [a] -> Infinite a
unsafeCycle [a]
xs = Infinite a
go
  where
    go :: Infinite a
go = [a]
xs forall a. [a] -> Infinite a -> Infinite a
`prependList` Infinite a
go

unsafeCycleFB :: (elt -> lst -> lst) -> [elt] -> lst
unsafeCycleFB :: forall elt lst. (elt -> lst -> lst) -> [elt] -> lst
unsafeCycleFB elt -> lst -> lst
cons [elt]
xs = lst
go
  where
    go :: lst
go = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr elt -> lst -> lst
cons lst
go [elt]
xs

{-# NOINLINE [1] unsafeCycle #-}

{-# INLINE [0] unsafeCycleFB #-}

{-# RULES
"unsafeCycle" [~1] forall x. unsafeCycle x = build (`unsafeCycleFB` x)
"unsafeCycleFB" [1] unsafeCycleFB (:<) = unsafeCycle
  #-}

-- | Build an infinite list from a seed value.
--
-- This is an anamorphism on infinite lists.
unfoldr :: (b -> (a, b)) -> b -> Infinite a
unfoldr :: forall b a. (b -> (a, b)) -> b -> Infinite a
unfoldr b -> (a, b)
f = b -> Infinite a
go
  where
    go :: b -> Infinite a
go b
b = let (a
a, b
b') = b -> (a, b)
f b
b in a
a forall a. a -> Infinite a -> Infinite a
:< b -> Infinite a
go b
b'
{-# INLINE unfoldr #-}

-- | Generate an infinite list of @f@ 0, @f@ 1, @f@ 2...
--
-- 'tabulate' and '(!!)' witness that 'Infinite' is
-- [@Representable@](https://hackage.haskell.org/package/adjunctions/docs/Data-Functor-Rep.html#t:Representable).
tabulate :: (Word -> a) -> Infinite a
tabulate :: forall a. (Word -> a) -> Infinite a
tabulate Word -> a
f = forall b a. (b -> (a, b)) -> b -> Infinite a
unfoldr (\Word
n -> (Word -> a
f Word
n, Word
n forall a. Num a => a -> a -> a
+ Word
1)) Word
0
{-# INLINE tabulate #-}

-- | Take a prefix of given length.
take :: Int -> Infinite a -> [a]
take :: forall a. Int -> Infinite a -> [a]
take = forall a. a -> a
GHC.Exts.inline forall i a. Integral i => i -> Infinite a -> [a]
genericTake
{-# INLINE [1] take #-}

{-# INLINE [1] genericTake #-}

{-# INLINE [0] genericTakeFB #-}

{-# RULES
"take"
  take =
    genericTake
"genericTake" [~1] forall n xs.
  genericTake n xs =
    GHC.Exts.build
      ( \cons nil ->
          if n >= 1
            then foldr (genericTakeFB cons nil) xs n
            else nil
      )
"genericTakeList" [1] forall n xs.
  foldr (genericTakeFB (:) []) xs n =
    genericTake n xs
  #-}

-- | Take a prefix of given length.
genericTake :: Integral i => i -> Infinite a -> [a]
genericTake :: forall i a. Integral i => i -> Infinite a -> [a]
genericTake i
n
  | i
n forall a. Ord a => a -> a -> Bool
< i
1 = forall a b. a -> b -> a
const []
  | Bool
otherwise = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\a
hd i -> [a]
f i
m -> a
hd forall a. a -> [a] -> [a]
: (if i
m forall a. Ord a => a -> a -> Bool
<= i
1 then [] else i -> [a]
f (i
m forall a. Num a => a -> a -> a
- i
1)))) i
n

genericTakeFB :: Integral i => (elt -> lst -> lst) -> lst -> elt -> (i -> lst) -> i -> lst
genericTakeFB :: forall i elt lst.
Integral i =>
(elt -> lst -> lst) -> lst -> elt -> (i -> lst) -> i -> lst
genericTakeFB elt -> lst -> lst
cons lst
nil elt
x i -> lst
xs = \i
m -> if i
m forall a. Ord a => a -> a -> Bool
<= i
1 then elt
x elt -> lst -> lst
`cons` lst
nil else elt
x elt -> lst -> lst
`cons` i -> lst
xs (i
m forall a. Num a => a -> a -> a
- i
1)

-- | Drop a prefix of given length.
drop :: Int -> Infinite a -> Infinite a
drop :: forall a. Int -> Infinite a -> Infinite a
drop = forall a. a -> a
GHC.Exts.inline forall i a. Integral i => i -> Infinite a -> Infinite a
genericDrop

-- | Drop a prefix of given length.
genericDrop :: Integral i => i -> Infinite a -> Infinite a
genericDrop :: forall i a. Integral i => i -> Infinite a -> Infinite a
genericDrop = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b. (a -> Infinite a -> b -> b) -> Infinite a -> b
para (\a
hd Infinite a
tl i -> Infinite a
f i
m -> if i
m forall a. Ord a => a -> a -> Bool
< i
1 then a
hd forall a. a -> Infinite a -> Infinite a
:< Infinite a
tl else i -> Infinite a
f (i
m forall a. Num a => a -> a -> a
- i
1)))
{-# INLINEABLE genericDrop #-}

-- | Split an infinite list into a prefix of given length and the rest.
splitAt :: Int -> Infinite a -> ([a], Infinite a)
splitAt :: forall a. Int -> Infinite a -> ([a], Infinite a)
splitAt = forall a. a -> a
GHC.Exts.inline forall i a. Integral i => i -> Infinite a -> ([a], Infinite a)
genericSplitAt

-- | Split an infinite list into a prefix of given length and the rest.
genericSplitAt :: Integral i => i -> Infinite a -> ([a], Infinite a)
genericSplitAt :: forall i a. Integral i => i -> Infinite a -> ([a], Infinite a)
genericSplitAt i
n
  | i
n forall a. Ord a => a -> a -> Bool
< i
1 = ([],)
  | Bool
otherwise = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b. (a -> Infinite a -> b -> b) -> Infinite a -> b
para (\a
hd Infinite a
tl i -> ([a], Infinite a)
f i
m -> if i
m forall a. Ord a => a -> a -> Bool
<= i
1 then ([a
hd], Infinite a
tl) else forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (a
hd forall a. a -> [a] -> [a]
:) (i -> ([a], Infinite a)
f (i
m forall a. Num a => a -> a -> a
- i
1)))) i
n
{-# INLINEABLE genericSplitAt #-}

-- | Take the longest prefix satisfying a predicate.
takeWhile :: (a -> Bool) -> Infinite a -> [a]
takeWhile :: forall a. (a -> Bool) -> Infinite a -> [a]
takeWhile a -> Bool
p = forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\a
x [a]
xs -> if a -> Bool
p a
x then a
x forall a. a -> [a] -> [a]
: [a]
xs else [])

takeWhileFB :: (elt -> Bool) -> (elt -> lst -> lst) -> lst -> elt -> lst -> lst
takeWhileFB :: forall elt lst.
(elt -> Bool) -> (elt -> lst -> lst) -> lst -> elt -> lst -> lst
takeWhileFB elt -> Bool
p elt -> lst -> lst
cons lst
nil = \elt
x lst
r -> if elt -> Bool
p elt
x then elt
x elt -> lst -> lst
`cons` lst
r else lst
nil

{-# NOINLINE [1] takeWhile #-}

{-# INLINE [0] takeWhileFB #-}

{-# RULES
"takeWhile" [~1] forall p xs.
  takeWhile p xs =
    GHC.Exts.build (\cons nil -> foldr (takeWhileFB p cons nil) xs)
"takeWhileList" [1] forall p.
  foldr (takeWhileFB p (:) []) =
    takeWhile p
  #-}

-- | Drop the longest prefix satisfying a predicate.
--
-- This function isn't productive (e. g., 'head' . 'dropWhile' @f@ won't terminate),
-- if all elements of the input list satisfy the predicate.
dropWhile :: (a -> Bool) -> Infinite a -> Infinite a
dropWhile :: forall a. (a -> Bool) -> Infinite a -> Infinite a
dropWhile a -> Bool
p = forall a b. (a -> Infinite a -> b -> b) -> Infinite a -> b
para (\a
x Infinite a
xs -> if a -> Bool
p a
x then forall a. a -> a
id else forall a b. a -> b -> a
const (a
x forall a. a -> Infinite a -> Infinite a
:< Infinite a
xs))

-- | Split an infinite list into the longest prefix satisfying a predicate and the rest.
--
-- This function isn't productive in the second component of the tuple
-- (e. g., 'head' . 'snd' . 'span' @f@ won't terminate),
-- if all elements of the input list satisfy the predicate.
span :: (a -> Bool) -> Infinite a -> ([a], Infinite a)
span :: forall a. (a -> Bool) -> Infinite a -> ([a], Infinite a)
span a -> Bool
p = forall a b. (a -> Infinite a -> b -> b) -> Infinite a -> b
para (\a
x Infinite a
xs -> if a -> Bool
p a
x then forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (a
x forall a. a -> [a] -> [a]
:) else forall a b. a -> b -> a
const ([], a
x forall a. a -> Infinite a -> Infinite a
:< Infinite a
xs))

-- | Split an infinite list into the longest prefix /not/ satisfying a predicate and the rest.
--
-- This function isn't productive in the second component of the tuple
-- (e. g., 'head' . 'snd' . 'break' @f@ won't terminate),
-- if no elements of the input list satisfy the predicate.
break :: (a -> Bool) -> Infinite a -> ([a], Infinite a)
break :: forall a. (a -> Bool) -> Infinite a -> ([a], Infinite a)
break = forall a. (a -> Bool) -> Infinite a -> ([a], Infinite a)
span forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

-- | If a list is a prefix of an infinite list, strip it and return the rest.
-- Otherwise return 'Nothing'.
stripPrefix :: Eq a => [a] -> Infinite a -> Maybe (Infinite a)
stripPrefix :: forall a. Eq a => [a] -> Infinite a -> Maybe (Infinite a)
stripPrefix [] = forall a. a -> Maybe a
Just
stripPrefix (a
p : [a]
ps) = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b. (a -> Infinite a -> b -> b) -> Infinite a -> b
para forall {a} {a}.
Eq a =>
a -> a -> (NonEmpty a -> Maybe a) -> NonEmpty a -> Maybe a
alg) (a
p forall a. a -> [a] -> NonEmpty a
:| [a]
ps)
  where
    alg :: a -> a -> (NonEmpty a -> Maybe a) -> NonEmpty a -> Maybe a
alg a
x a
xs NonEmpty a -> Maybe a
acc (a
y :| [a]
ys)
      | a
x forall a. Eq a => a -> a -> Bool
== a
y = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. a -> Maybe a
Just a
xs) NonEmpty a -> Maybe a
acc (forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [a]
ys)
      | Bool
otherwise = forall a. Maybe a
Nothing

-- | Group consecutive equal elements.
group :: Eq a => Infinite a -> Infinite (NonEmpty a)
group :: forall a. Eq a => Infinite a -> Infinite (NonEmpty a)
group = forall a. (a -> a -> Bool) -> Infinite a -> Infinite (NonEmpty a)
groupBy forall a. Eq a => a -> a -> Bool
(==)

-- | Overloaded version of 'group'.
groupBy :: (a -> a -> Bool) -> Infinite a -> Infinite (NonEmpty a)
-- Quite surprisingly, 'groupBy' is not a simple catamorphism.
-- Since @f@ is not guaranteed to be transitive, it's a full-blown
-- histomorphism, at which point a manual recursion becomes much more readable.
groupBy :: forall a. (a -> a -> Bool) -> Infinite a -> Infinite (NonEmpty a)
groupBy a -> a -> Bool
f = Infinite a -> Infinite (NonEmpty a)
go
  where
    go :: Infinite a -> Infinite (NonEmpty a)
go (a
x :< Infinite a
xs) = (a
x forall a. a -> [a] -> NonEmpty a
:| [a]
ys) forall a. a -> Infinite a -> Infinite a
:< Infinite a -> Infinite (NonEmpty a)
go Infinite a
zs
      where
        ([a]
ys, Infinite a
zs) = forall a. (a -> Bool) -> Infinite a -> ([a], Infinite a)
span (a -> a -> Bool
f a
x) Infinite a
xs

-- | Generate all prefixes of an infinite list.
inits :: Infinite a -> Infinite [a]
inits :: forall a. Infinite a -> Infinite [a]
inits =
  forall a b. (a -> b) -> Infinite a -> Infinite b
map (\(SnocBuilder Word
_ [a]
front [a]
rear) -> [a]
front forall a. [a] -> [a] -> [a]
List.++ forall a. [a] -> [a]
List.reverse [a]
rear)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (b -> a -> b) -> b -> Infinite a -> Infinite b
scanl'
      (\(SnocBuilder Word
count [a]
front [a]
rear) a
x -> forall a. Word -> [a] -> [a] -> SnocBuilder a
snocBuilder (Word
count forall a. Num a => a -> a -> a
+ Word
1) [a]
front (a
x forall a. a -> [a] -> [a]
: [a]
rear))
      (forall a. Word -> [a] -> [a] -> SnocBuilder a
SnocBuilder Word
0 [] [])

data SnocBuilder a = SnocBuilder
  { forall a. SnocBuilder a -> Word
_count :: !Word
  , forall a. SnocBuilder a -> [a]
_front :: [a]
  , forall a. SnocBuilder a -> [a]
_rear :: [a]
  }

snocBuilder :: Word -> [a] -> [a] -> SnocBuilder a
snocBuilder :: forall a. Word -> [a] -> [a] -> SnocBuilder a
snocBuilder Word
count [a]
front [a]
rear
  | Word
count forall a. Ord a => a -> a -> Bool
< Word
8 Bool -> Bool -> Bool
|| (Word
count forall a. Bits a => a -> a -> a
.&. (Word
count forall a. Num a => a -> a -> a
+ Word
1)) forall a. Eq a => a -> a -> Bool
/= Word
0 =
      forall a. Word -> [a] -> [a] -> SnocBuilder a
SnocBuilder Word
count [a]
front [a]
rear
  | Bool
otherwise =
      forall a. Word -> [a] -> [a] -> SnocBuilder a
SnocBuilder Word
count ([a]
front forall a. [a] -> [a] -> [a]
List.++ forall a. [a] -> [a]
List.reverse [a]
rear) []
{-# INLINE snocBuilder #-}

-- | Generate all non-empty prefixes of an infinite list.
inits1 :: Infinite a -> Infinite (NonEmpty a)
inits1 :: forall a. Infinite a -> Infinite (NonEmpty a)
inits1 (a
x :< Infinite a
xs) = forall a b. (a -> b) -> Infinite a -> Infinite b
map (a
x forall a. a -> [a] -> NonEmpty a
:|) (forall a. Infinite a -> Infinite [a]
inits Infinite a
xs)

-- | Generate all suffixes of an infinite list.
tails :: Infinite a -> Infinite (Infinite a)
tails :: forall a. Infinite a -> Infinite (Infinite a)
tails = forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\a
x xss :: Infinite (Infinite a)
xss@(~(Infinite a
xs :< Infinite (Infinite a)
_)) -> (a
x forall a. a -> Infinite a -> Infinite a
:< Infinite a
xs) forall a. a -> Infinite a -> Infinite a
:< Infinite (Infinite a)
xss)

-- | Check whether a list is a prefix of an infinite list.
isPrefixOf :: Eq a => [a] -> Infinite a -> Bool
isPrefixOf :: forall a. Eq a => [a] -> Infinite a -> Bool
isPrefixOf [] = forall a b. a -> b -> a
const Bool
True
isPrefixOf (a
p : [a]
ps) = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b. (a -> b -> b) -> Infinite a -> b
foldr forall {a}. Eq a => a -> (NonEmpty a -> Bool) -> NonEmpty a -> Bool
alg) (a
p forall a. a -> [a] -> NonEmpty a
:| [a]
ps)
  where
    alg :: a -> (NonEmpty a -> Bool) -> NonEmpty a -> Bool
alg a
x NonEmpty a -> Bool
acc (a
y :| [a]
ys) = a
x forall a. Eq a => a -> a -> Bool
== a
y Bool -> Bool -> Bool
&& forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True NonEmpty a -> Bool
acc (forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [a]
ys)

-- | Find the first pair, whose first component is equal to the first argument,
-- and return the second component.
-- If there is nothing to be found, this function will hang indefinitely.
lookup :: Eq a => a -> Infinite (a, b) -> b
lookup :: forall a b. Eq a => a -> Infinite (a, b) -> b
lookup a
a = forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\(a
a', b
b) b
b' -> if a
a forall a. Eq a => a -> a -> Bool
== a
a' then b
b else b
b')

-- | Find the first element, satisfying a predicate.
-- If there is nothing to be found, this function will hang indefinitely.
find :: (a -> Bool) -> Infinite a -> a
find :: forall a. (a -> Bool) -> Infinite a -> a
find a -> Bool
f = forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\a
a a
a' -> if a -> Bool
f a
a then a
a else a
a')

-- | Filter an infinite list, removing elements which does not satisfy a predicate.
--
-- This function isn't productive (e. g., 'head' . 'filter' @f@ won't terminate),
-- if no elements of the input list satisfy the predicate.
--
-- A common objection is that since it could happen that no elements of the input
-- satisfy the predicate, the return type should be @[a]@ instead of 'Infinite' @a@.
-- This would not however make 'filter' any more productive. Note that such
-- hypothetical 'filter' could not ever generate @[]@ constructor, only @(:)@, so
-- we would just have a more lax type gaining nothing instead. Same reasoning applies
-- to other filtering \/ partitioning \/ searching functions.
filter :: (a -> Bool) -> Infinite a -> Infinite a
filter :: forall a. (a -> Bool) -> Infinite a -> Infinite a
filter a -> Bool
f = forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\a
a -> if a -> Bool
f a
a then (a
a forall a. a -> Infinite a -> Infinite a
:<) else forall a. a -> a
id)

filterFB :: (elt -> lst -> lst) -> (elt -> Bool) -> elt -> lst -> lst
filterFB :: forall elt lst.
(elt -> lst -> lst) -> (elt -> Bool) -> elt -> lst -> lst
filterFB elt -> lst -> lst
cons elt -> Bool
f elt
x lst
r
  | elt -> Bool
f elt
x = elt
x elt -> lst -> lst
`cons` lst
r
  | Bool
otherwise = lst
r

{-# NOINLINE [1] filter #-}

{-# INLINE [0] filterFB #-}

{-# RULES
"filter" [~1] forall f xs.
  filter f xs =
    build (\cons -> foldr (filterFB cons f) xs)
"filterList" [1] forall f.
  foldr (filterFB (:<) f) =
    filter f
"filterFB" forall cons f g.
  filterFB (filterFB cons f) g =
    filterFB cons (\x -> f x && g x)
  #-}

-- | Split an infinite list into two infinite lists: the first one contains elements,
-- satisfying a predicate, and the second one the rest.
--
-- This function isn't productive in the first component of the tuple
-- (e. g., 'head' . 'Data.Tuple.fst' . 'partition' @f@ won't terminate),
-- if no elements of the input list satisfy the predicate.
-- Same for the second component,
-- if all elements of the input list satisfy the predicate.
partition :: (a -> Bool) -> Infinite a -> (Infinite a, Infinite a)
partition :: forall a. (a -> Bool) -> Infinite a -> (Infinite a, Infinite a)
partition a -> Bool
f = forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\a
a -> if a -> Bool
f a
a then forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (a
a forall a. a -> Infinite a -> Infinite a
:<) else forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (a
a forall a. a -> Infinite a -> Infinite a
:<))

-- | Return /n/-th element of an infinite list.
-- On contrary to @Data.List.@'List.!!', this function takes 'Word' instead of 'Int'
-- to avoid 'Prelude.error' on negative arguments.
--
-- This is actually @index@ from
-- [@Representable@](https://hackage.haskell.org/package/adjunctions/docs/Data-Functor-Rep.html#t:Representable)
-- type class in disguise.
(!!) :: Infinite a -> Word -> a
!! :: forall a. Infinite a -> Word -> a
(!!) = forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\a
x Word -> a
acc Word
m -> if Word
m forall a. Eq a => a -> a -> Bool
== Word
0 then a
x else Word -> a
acc (Word
m forall a. Num a => a -> a -> a
- Word
1))

infixl 9 !!

-- | Return an index of the first element, equal to a given.
-- If there is nothing to be found, this function will hang indefinitely.
elemIndex :: Eq a => a -> Infinite a -> Word
elemIndex :: forall a. Eq a => a -> Infinite a -> Word
elemIndex = forall a. (a -> Bool) -> Infinite a -> Word
findIndex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> a -> Bool
(==)

-- | Return indices of all elements, equal to a given.
--
-- This function isn't productive (e. g., 'head' . 'elemIndices' @f@ won't terminate),
-- if no elements of the input list are equal the given one.
elemIndices :: Eq a => a -> Infinite a -> Infinite Word
elemIndices :: forall a. Eq a => a -> Infinite a -> Infinite Word
elemIndices = forall a. (a -> Bool) -> Infinite a -> Infinite Word
findIndices forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> a -> Bool
(==)

-- | Return an index of the first element, satisfying a predicate.
-- If there is nothing to be found, this function will hang indefinitely.
findIndex :: (a -> Bool) -> Infinite a -> Word
findIndex :: forall a. (a -> Bool) -> Infinite a -> Word
findIndex a -> Bool
f = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\a
x Word -> Word
acc !Word
m -> if a -> Bool
f a
x then Word
m else Word -> Word
acc (Word
m forall a. Num a => a -> a -> a
+ Word
1))) Word
0

-- | Return indices of all elements, satisfying a predicate.
--
-- This function isn't productive (e. g., 'head' . 'elemIndices' @f@ won't terminate),
-- if no elements of the input list satisfy the predicate.
findIndices :: (a -> Bool) -> Infinite a -> Infinite Word
findIndices :: forall a. (a -> Bool) -> Infinite a -> Infinite Word
findIndices a -> Bool
f = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\a
x Word -> Infinite Word
acc !Word
m -> (if a -> Bool
f a
x then (Word
m forall a. a -> Infinite a -> Infinite a
:<) else forall a. a -> a
id) (Word -> Infinite Word
acc (Word
m forall a. Num a => a -> a -> a
+ Word
1)))) Word
0

-- | Unzip an infinite list of tuples.
unzip :: Infinite (a, b) -> (Infinite a, Infinite b)
unzip :: forall a b. Infinite (a, b) -> (Infinite a, Infinite b)
unzip = forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\(a
a, b
b) ~(Infinite a
as, Infinite b
bs) -> (a
a forall a. a -> Infinite a -> Infinite a
:< Infinite a
as, b
b forall a. a -> Infinite a -> Infinite a
:< Infinite b
bs))
{-# INLINE unzip #-}

-- | Unzip an infinite list of triples.
unzip3 :: Infinite (a, b, c) -> (Infinite a, Infinite b, Infinite c)
unzip3 :: forall a b c.
Infinite (a, b, c) -> (Infinite a, Infinite b, Infinite c)
unzip3 = forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\(a
a, b
b, c
c) ~(Infinite a
as, Infinite b
bs, Infinite c
cs) -> (a
a forall a. a -> Infinite a -> Infinite a
:< Infinite a
as, b
b forall a. a -> Infinite a -> Infinite a
:< Infinite b
bs, c
c forall a. a -> Infinite a -> Infinite a
:< Infinite c
cs))
{-# INLINE unzip3 #-}

-- | Unzip an infinite list of quadruples.
unzip4 :: Infinite (a, b, c, d) -> (Infinite a, Infinite b, Infinite c, Infinite d)
unzip4 :: forall a b c d.
Infinite (a, b, c, d)
-> (Infinite a, Infinite b, Infinite c, Infinite d)
unzip4 = forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\(a
a, b
b, c
c, d
d) ~(Infinite a
as, Infinite b
bs, Infinite c
cs, Infinite d
ds) -> (a
a forall a. a -> Infinite a -> Infinite a
:< Infinite a
as, b
b forall a. a -> Infinite a -> Infinite a
:< Infinite b
bs, c
c forall a. a -> Infinite a -> Infinite a
:< Infinite c
cs, d
d forall a. a -> Infinite a -> Infinite a
:< Infinite d
ds))
{-# INLINE unzip4 #-}

-- | Unzip an infinite list of quintuples.
unzip5 :: Infinite (a, b, c, d, e) -> (Infinite a, Infinite b, Infinite c, Infinite d, Infinite e)
unzip5 :: forall a b c d e.
Infinite (a, b, c, d, e)
-> (Infinite a, Infinite b, Infinite c, Infinite d, Infinite e)
unzip5 = forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\(a
a, b
b, c
c, d
d, e
e) ~(Infinite a
as, Infinite b
bs, Infinite c
cs, Infinite d
ds, Infinite e
es) -> (a
a forall a. a -> Infinite a -> Infinite a
:< Infinite a
as, b
b forall a. a -> Infinite a -> Infinite a
:< Infinite b
bs, c
c forall a. a -> Infinite a -> Infinite a
:< Infinite c
cs, d
d forall a. a -> Infinite a -> Infinite a
:< Infinite d
ds, e
e forall a. a -> Infinite a -> Infinite a
:< Infinite e
es))
{-# INLINE unzip5 #-}

-- | Unzip an infinite list of sextuples.
unzip6 :: Infinite (a, b, c, d, e, f) -> (Infinite a, Infinite b, Infinite c, Infinite d, Infinite e, Infinite f)
unzip6 :: forall a b c d e f.
Infinite (a, b, c, d, e, f)
-> (Infinite a, Infinite b, Infinite c, Infinite d, Infinite e,
    Infinite f)
unzip6 = forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\(a
a, b
b, c
c, d
d, e
e, f
f) ~(Infinite a
as, Infinite b
bs, Infinite c
cs, Infinite d
ds, Infinite e
es, Infinite f
fs) -> (a
a forall a. a -> Infinite a -> Infinite a
:< Infinite a
as, b
b forall a. a -> Infinite a -> Infinite a
:< Infinite b
bs, c
c forall a. a -> Infinite a -> Infinite a
:< Infinite c
cs, d
d forall a. a -> Infinite a -> Infinite a
:< Infinite d
ds, e
e forall a. a -> Infinite a -> Infinite a
:< Infinite e
es, f
f forall a. a -> Infinite a -> Infinite a
:< Infinite f
fs))
{-# INLINE unzip6 #-}

-- | Unzip an infinite list of septuples.
unzip7 :: Infinite (a, b, c, d, e, f, g) -> (Infinite a, Infinite b, Infinite c, Infinite d, Infinite e, Infinite f, Infinite g)
unzip7 :: forall a b c d e f g.
Infinite (a, b, c, d, e, f, g)
-> (Infinite a, Infinite b, Infinite c, Infinite d, Infinite e,
    Infinite f, Infinite g)
unzip7 = forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\(a
a, b
b, c
c, d
d, e
e, f
f, g
g) ~(Infinite a
as, Infinite b
bs, Infinite c
cs, Infinite d
ds, Infinite e
es, Infinite f
fs, Infinite g
gs) -> (a
a forall a. a -> Infinite a -> Infinite a
:< Infinite a
as, b
b forall a. a -> Infinite a -> Infinite a
:< Infinite b
bs, c
c forall a. a -> Infinite a -> Infinite a
:< Infinite c
cs, d
d forall a. a -> Infinite a -> Infinite a
:< Infinite d
ds, e
e forall a. a -> Infinite a -> Infinite a
:< Infinite e
es, f
f forall a. a -> Infinite a -> Infinite a
:< Infinite f
fs, g
g forall a. a -> Infinite a -> Infinite a
:< Infinite g
gs))
{-# INLINE unzip7 #-}

-- | Split an infinite string into lines, by @\\n@. Empty lines are preserved.
--
-- In contrast to their counterparts from "Data.List", it holds that
-- 'unlines' @.@ 'lines' @=@ 'id'.
lines :: Infinite Char -> Infinite [Char]
lines :: Infinite Char -> Infinite [Char]
lines = forall a b. (a -> b -> b) -> Infinite a -> b
foldr Char -> Infinite [Char] -> Infinite [Char]
go
  where
    go :: Char -> Infinite [Char] -> Infinite [Char]
go Char
'\n' Infinite [Char]
xs = [] forall a. a -> Infinite a -> Infinite a
:< Infinite [Char]
xs
    go Char
c ~([Char]
x :< Infinite [Char]
xs) = (Char
c forall a. a -> [a] -> [a]
: [Char]
x) forall a. a -> Infinite a -> Infinite a
:< Infinite [Char]
xs

-- | Concatenate lines together with @\\n@.
--
-- In contrast to their counterparts from "Data.List", it holds that
-- 'unlines' @.@ 'lines' @=@ 'id'.
unlines :: Infinite [Char] -> Infinite Char
unlines :: Infinite [Char] -> Infinite Char
unlines = forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\[Char]
l Infinite Char
xs -> [Char]
l forall a. [a] -> Infinite a -> Infinite a
`prependList` (Char
'\n' forall a. a -> Infinite a -> Infinite a
:< Infinite Char
xs))

-- | Split an infinite string into words, by any 'isSpace' symbol.
-- Leading spaces are removed and, as underlined by the return type,
-- repeated spaces are treated as a single delimiter.
words :: Infinite Char -> Infinite (NonEmpty Char)
-- This is fundamentally a zygomorphism with 'isSpace' . 'head' as the small algebra.
-- But manual implementation via catamorphism requires twice less calls of 'isSpace'.
words :: Infinite Char -> Infinite (NonEmpty Char)
words = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall {a}. [a] -> Infinite (NonEmpty a) -> Infinite (NonEmpty a)
repack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b -> b) -> Infinite a -> b
foldr Char
-> ([Char], Infinite (NonEmpty Char))
-> ([Char], Infinite (NonEmpty Char))
go
  where
    repack :: [a] -> Infinite (NonEmpty a) -> Infinite (NonEmpty a)
repack [a]
zs Infinite (NonEmpty a)
acc = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Infinite (NonEmpty a)
acc (forall a. a -> Infinite a -> Infinite a
:< Infinite (NonEmpty a)
acc) (forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [a]
zs)

    go :: Char
-> ([Char], Infinite (NonEmpty Char))
-> ([Char], Infinite (NonEmpty Char))
go Char
x ~([Char]
zs, Infinite (NonEmpty Char)
acc) = ([Char]
zs', Infinite (NonEmpty Char)
acc')
      where
        s :: Bool
s = Char -> Bool
isSpace Char
x
        zs' :: [Char]
zs' = if Bool
s then [] else Char
x forall a. a -> [a] -> [a]
: [Char]
zs
        acc' :: Infinite (NonEmpty Char)
acc' = if Bool
s then forall {a}. [a] -> Infinite (NonEmpty a) -> Infinite (NonEmpty a)
repack [Char]
zs Infinite (NonEmpty Char)
acc else Infinite (NonEmpty Char)
acc

wordsFB :: (NonEmpty Char -> lst -> lst) -> Infinite Char -> lst
wordsFB :: forall lst. (NonEmpty Char -> lst -> lst) -> Infinite Char -> lst
wordsFB NonEmpty Char -> lst -> lst
cons = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Char] -> lst -> lst
repack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b -> b) -> Infinite a -> b
foldr Char -> ([Char], lst) -> ([Char], lst)
go
  where
    repack :: [Char] -> lst -> lst
repack [Char]
zs lst
acc = forall b a. b -> (a -> b) -> Maybe a -> b
maybe lst
acc (NonEmpty Char -> lst -> lst
`cons` lst
acc) (forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Char]
zs)

    go :: Char -> ([Char], lst) -> ([Char], lst)
go Char
x ~([Char]
zs, lst
acc) = ([Char]
zs', lst
acc')
      where
        s :: Bool
s = Char -> Bool
isSpace Char
x
        zs' :: [Char]
zs' = if Bool
s then [] else Char
x forall a. a -> [a] -> [a]
: [Char]
zs
        acc' :: lst
acc' = if Bool
s then [Char] -> lst -> lst
repack [Char]
zs lst
acc else lst
acc

{-# NOINLINE [1] words #-}

{-# INLINE [0] wordsFB #-}

{-# RULES
"words" [~1] forall s. words s = build (`wordsFB` s)
"wordsList" [1] wordsFB (:<) = words
  #-}

-- | Concatenate words together with a space.
--
-- The function is meant to be a counterpart of with 'words'.
-- If you need to concatenate together 'Infinite' @[@'Char'@]@,
-- use 'intercalate' @(@'pure' @' ')@.
unwords :: Infinite (NonEmpty Char) -> Infinite Char
unwords :: Infinite (NonEmpty Char) -> Infinite Char
unwords = forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\(Char
l :| [Char]
ls) Infinite Char
acc -> Char
l forall a. a -> Infinite a -> Infinite a
:< [Char]
ls forall a. [a] -> Infinite a -> Infinite a
`prependList` (Char
' ' forall a. a -> Infinite a -> Infinite a
:< Infinite Char
acc))

unwordsFB :: (Char -> lst -> lst) -> Infinite (NonEmpty Char) -> lst
unwordsFB :: forall lst. (Char -> lst -> lst) -> Infinite (NonEmpty Char) -> lst
unwordsFB Char -> lst -> lst
cons = forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\(Char
l :| [Char]
ls) lst
acc -> Char
l Char -> lst -> lst
`cons` forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr Char -> lst -> lst
cons (Char
' ' Char -> lst -> lst
`cons` lst
acc) [Char]
ls)

{-# NOINLINE [1] unwords #-}

{-# INLINE [0] unwordsFB #-}

{-# RULES
"unwords" [~1] forall s. unwords s = build (`unwordsFB` s)
"unwordsList" [1] unwordsFB (:<) = unwords
  #-}

-- | Remove duplicate from a list, keeping only the first occurrence of each element.
nub :: Eq a => Infinite a -> Infinite a
nub :: forall a. Eq a => Infinite a -> Infinite a
nub = forall a. (a -> a -> Bool) -> Infinite a -> Infinite a
nubBy forall a. Eq a => a -> a -> Bool
(==)

-- | Overloaded version of 'nub'.
nubBy :: (a -> a -> Bool) -> Infinite a -> Infinite a
nubBy :: forall a. (a -> a -> Bool) -> Infinite a -> Infinite a
nubBy a -> a -> Bool
eq = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b. (a -> b -> b) -> Infinite a -> b
foldr (\a
x [a] -> Infinite a
acc [a]
seen -> if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
List.any (a -> a -> Bool
`eq` a
x) [a]
seen then [a] -> Infinite a
acc [a]
seen else a
x forall a. a -> Infinite a -> Infinite a
:< [a] -> Infinite a
acc (a
x forall a. a -> [a] -> [a]
: [a]
seen))) []

-- | Remove all occurrences of an element from an infinite list.
delete :: Eq a => a -> Infinite a -> Infinite a
delete :: forall a. Eq a => a -> Infinite a -> Infinite a
delete = forall a b. (a -> b -> Bool) -> a -> Infinite b -> Infinite b
deleteBy forall a. Eq a => a -> a -> Bool
(==)

-- | Overloaded version of 'delete'.
deleteBy :: (a -> b -> Bool) -> a -> Infinite b -> Infinite b
deleteBy :: forall a b. (a -> b -> Bool) -> a -> Infinite b -> Infinite b
deleteBy a -> b -> Bool
eq a
x = forall a b. (a -> Infinite a -> b -> b) -> Infinite a -> b
para (\b
y Infinite b
ys Infinite b
acc -> if a -> b -> Bool
eq a
x b
y then Infinite b
ys else b
y forall a. a -> Infinite a -> Infinite a
:< Infinite b
acc)

-- | Take an infinite list and remove the first occurrence of every element
-- of a finite list.
(\\) :: Eq a => Infinite a -> [a] -> Infinite a
\\ :: forall a. Eq a => Infinite a -> [a] -> Infinite a
(\\) = forall a b. (a -> b -> Bool) -> Infinite b -> [a] -> Infinite b
deleteFirstsBy forall a. Eq a => a -> a -> Bool
(==)

-- | Overloaded version of '(\\)'.
deleteFirstsBy :: (a -> b -> Bool) -> Infinite b -> [a] -> Infinite b
deleteFirstsBy :: forall a b. (a -> b -> Bool) -> Infinite b -> [a] -> Infinite b
deleteFirstsBy a -> b -> Bool
eq = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b. (a -> b -> Bool) -> a -> Infinite b -> Infinite b
deleteBy a -> b -> Bool
eq))

-- | Union of a finite and an infinite list. It contains the finite list
-- as a prefix and afterwards all non-duplicate elements of the infinite list,
-- which are not members of the finite list.
union :: Eq a => [a] -> Infinite a -> Infinite a
union :: forall a. Eq a => [a] -> Infinite a -> Infinite a
union = forall a. (a -> a -> Bool) -> [a] -> Infinite a -> Infinite a
unionBy forall a. Eq a => a -> a -> Bool
(==)

-- | Overloaded version of 'union'.
unionBy :: (a -> a -> Bool) -> [a] -> Infinite a -> Infinite a
unionBy :: forall a. (a -> a -> Bool) -> [a] -> Infinite a -> Infinite a
unionBy a -> a -> Bool
eq [a]
xs Infinite a
ys = [a]
xs forall a. [a] -> Infinite a -> Infinite a
`prependList` forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b. (a -> b -> Bool) -> a -> Infinite b -> Infinite b
deleteBy a -> a -> Bool
eq)) (forall a. (a -> a -> Bool) -> Infinite a -> Infinite a
nubBy a -> a -> Bool
eq Infinite a
ys) [a]
xs

-- | Insert an element at the first position where it is less than or equal
-- to the next one. If the input was sorted, the output remains sorted as well.
insert :: Ord a => a -> Infinite a -> Infinite a
insert :: forall a. Ord a => a -> Infinite a -> Infinite a
insert = forall a. (a -> a -> Ordering) -> a -> Infinite a -> Infinite a
insertBy forall a. Ord a => a -> a -> Ordering
compare

-- | Overloaded version of 'insert'.
insertBy :: (a -> a -> Ordering) -> a -> Infinite a -> Infinite a
insertBy :: forall a. (a -> a -> Ordering) -> a -> Infinite a -> Infinite a
insertBy a -> a -> Ordering
cmp a
x = forall a b. (a -> Infinite a -> b -> b) -> Infinite a -> b
para (\a
y Infinite a
ys Infinite a
acc -> case a -> a -> Ordering
cmp a
x a
y of Ordering
GT -> a
y forall a. a -> Infinite a -> Infinite a
:< Infinite a
acc; Ordering
_ -> a
x forall a. a -> Infinite a -> Infinite a
:< a
y forall a. a -> Infinite a -> Infinite a
:< Infinite a
ys)

-- | Return all elements of an infinite list, which are simultaneously
-- members of a finite list.
intersect :: Eq a => Infinite a -> [a] -> Infinite a
intersect :: forall a. Eq a => Infinite a -> [a] -> Infinite a
intersect = forall a b. (a -> b -> Bool) -> Infinite a -> [b] -> Infinite a
intersectBy forall a. Eq a => a -> a -> Bool
(==)

-- | Overloaded version of 'intersect'.
intersectBy :: (a -> b -> Bool) -> Infinite a -> [b] -> Infinite a
intersectBy :: forall a b. (a -> b -> Bool) -> Infinite a -> [b] -> Infinite a
intersectBy a -> b -> Bool
eq Infinite a
xs [b]
ys = forall a. (a -> Bool) -> Infinite a -> Infinite a
filter (\a
x -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
List.any (a -> b -> Bool
eq a
x) [b]
ys) Infinite a
xs

-- | Prepend a list to an infinite list.
prependList :: [a] -> Infinite a -> Infinite a
prependList :: forall a. [a] -> Infinite a -> Infinite a
prependList = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr forall a. a -> Infinite a -> Infinite a
(:<))

-- | Apply a function to every element of an infinite list and collect 'Just' results.
--
-- This function isn't productive (e. g., 'head' . 'mapMaybe' @f@ won't terminate),
-- if no elements of the input list result in 'Just'.
--
-- @since 0.1.1
mapMaybe :: (a -> Maybe b) -> Infinite a -> Infinite b
mapMaybe :: forall a b. (a -> Maybe b) -> Infinite a -> Infinite b
mapMaybe = forall a b. (a -> b -> b) -> Infinite a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall a. a -> Infinite a -> Infinite a
(:<) forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

-- | Keep only 'Just' elements.
--
-- This function isn't productive (e. g., 'head' . 'catMaybes' won't terminate),
-- if no elements of the input list are 'Just'.
--
-- @since 0.1.1
catMaybes :: Infinite (Maybe a) -> Infinite a
catMaybes :: forall a. Infinite (Maybe a) -> Infinite a
catMaybes = forall a b. (a -> b -> b) -> Infinite a -> b
foldr (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall a. a -> Infinite a -> Infinite a
(:<))

-- | Apply a function to every element of an infinite list and
-- separate 'Data.Either.Left' and 'Data.Either.Right' results.
--
-- This function isn't productive (e. g., 'head' . 'Data.Tuple.fst' .
-- 'mapEither' @f@ won't terminate),
-- if no elements of the input list result in 'Data.Either.Left' or 'Data.Either.Right'.
--
-- @since 0.1.1
mapEither :: (a -> Either b c) -> Infinite a -> (Infinite b, Infinite c)
mapEither :: forall a b c.
(a -> Either b c) -> Infinite a -> (Infinite b, Infinite c)
mapEither = forall a b. (a -> b -> b) -> Infinite a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Infinite a -> Infinite a
(:<)) (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Infinite a -> Infinite a
(:<)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

-- | Separate 'Data.Either.Left' and 'Data.Either.Right' elements.
--
-- This function isn't productive (e. g., 'head' . 'Data.Tuple.fst' . 'partitionEithers'
-- won't terminate),
-- if no elements of the input list are 'Data.Either.Left' or 'Data.Either.Right'.
--
-- @since 0.1.1
partitionEithers :: Infinite (Either a b) -> (Infinite a, Infinite b)
partitionEithers :: forall a b. Infinite (Either a b) -> (Infinite a, Infinite b)
partitionEithers = forall a b. (a -> b -> b) -> Infinite a -> b
foldr (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Infinite a -> Infinite a
(:<)) (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Infinite a -> Infinite a
(:<)))