infinite-list-0.1.1/0000755000000000000000000000000007346545000012460 5ustar0000000000000000infinite-list-0.1.1/CHANGELOG.md0000644000000000000000000000066107346545000014274 0ustar0000000000000000# 0.1.1 * Add `mapMaybe` and `catMaybes`. * Add `mapEither` and `partitionEithers`. * Decrease operator precedence for `(...)` and `(....)`. * Add fusion rules for `genericTake`. * Remove harmful fusion rules for `drop` and `dropWhile`. Cf. https://gitlab.haskell.org/ghc/ghc/-/issues/23021. * Fix `instance Monad Infinite` on 32-bit machines. It was violating monad laws once the index exceeds 2^32. # 0.1 * Initial release. infinite-list-0.1.1/LICENSE0000644000000000000000000000275207346545000013473 0ustar0000000000000000Copyright (c) 2022, Bodigrim All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Bodigrim nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. infinite-list-0.1.1/README.md0000644000000000000000000001075707346545000013751 0ustar0000000000000000# infinite-list 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 `Foldable`. * Use `NonEmpty` where applicable. * Use `Word` for indices. * Be lazy, but not too lazy. ```haskell {-# LANGUAGE PostfixOperators #-} import Data.List.Infinite (Infinite(..), (...), (....)) import qualified Data.List.Infinite as Inf ``` ## Prior art and inspiration * [`Data.Stream.Infinite`](https://hackage.haskell.org/package/streams/docs/Data-Stream-Infinite.html) from [`streams`](https://hackage.haskell.org/package/streams) package: * Large dependency footprint, e. g., `adjunctions`. * Provides dangerous instances such as `Foldable`. * No fusion framework. * [`Data.Stream`](https://hackage.haskell.org/package/Stream/docs/Data-Stream.html) from [`Stream`](https://hackage.haskell.org/package/Stream) package: * No fusion framework. * No repository or issue tracker. * [`GHC.Data.List.Infinite`](https://gitlab.haskell.org/ghc/ghc/-/blob/080fffa1015bcc0cff8ab4ad1eeb507fb7a13383/compiler/GHC/Data/List/Infinite.hs) in GHC source tree: * Limited API, only to cater for GHC internals. * Not available as a separate package outside of GHC. ## Why no `Foldable` or `Traversable`? The breakdown of members of `Foldable` is as follows: * `foldr`, `foldr1`, `foldMap`, `fold`, `toList` and `null` can be productive on infinite lists; * `foldr'`, `foldMap'` cannot, because forcing an accumulator even to a WHNF makes fold non-terminating; * `foldl`, `foldl'`, `foldl1` cannot, because no left fold can; * `length` always diverges; * `elem` either returns `True`, or does not terminate, but never returns `False`; * `maximum`, `minimum`, `sum` and `product` are unlikely to be productive, unless an underlying `instance Ord` or `instance Num` is extremely lazy. Altogether it means that code, polymorphic by `Foldable`, cannot confidently work with infinite lists. Even a trivial refactoring can get you in a deep trouble. It's better to save users from this pitfall and do not provide `instance Foldable` at all. We do provide a right fold however. Since there is no `Foldable`, there could be no `Traversable`. Even if it was not prohibited because of a missing superclass, there are only a few monads, which are lazy enough to be productive for infinite traversals. If you are looking for a traverse with a lazy state, use `mapAccumL`. ## Laziness Operations, returning a data type with a single constructor, can be implemented in an extremely lazy fashion. Namely, always return the constructor before inspecting any of the arguments. For instance, note the irrefutable pattern matching in `Data.List.NonEmpty`: ```haskell map :: (a -> b) -> NonEmpty a -> NonEmpty b map f ~(a :| as) = f a :| fmap f as ``` which is equivalent to ```haskell map :: (a -> b) -> NonEmpty a -> NonEmpty b map f x = (let a :| _ = x in f a) :| (let _ :| as = x in fmap f as) ``` Because of it forcing the result to WHNF does not force any of the arguments, e. g., ``Data.List.NonEmpty.map undefined undefined `seq` 1`` returns `1`. This is not the case for normal lists: since there are two constructors, `map` has to inspect the argument before returning anything, and ``Data.List.map undefined undefined `seq` 1`` throws an error. While `Data.List.Infinite` has a single constructor, we believe that following the example of `Data.List.NonEmpty` is harmful for the majority of applications. Instead the laziness of the API is modeled on the laziness of respective operations on `Data.List`: a function `Data.List.Infinite.foo` operating over `Infinite a` is expected to have the same strictness properties as `Data.List.foo` operating over `[a]`. For instance, ``Data.List.Infinite.map undefined undefined `seq` 1`` diverges. ## Indexing Most of historical APIs (such as `Data.List`) use `Int` to index elements of containers. This library makes another choice: namely, indices are represented by an unsigned type, `Word`. This way the notorious partial function `(!!) :: [a] -> Int -> a` becomes a total `(!!) :: Infinite a -> Word -> a`. An argument can be made to use an arbitrary-precision type `Natural` instead of finite `Word`. Unfortunately, this causes performance penalties since `Natural` is represented by a heap object and cannot be easily unboxed. On any GHC-supported architecture the addressable memory is less than `maxBound :: Word` bytes and thus it's impossible to materialize a container with more than `maxBound :: Word` elements. infinite-list-0.1.1/bench/0000755000000000000000000000000007346545000013537 5ustar0000000000000000infinite-list-0.1.1/bench/Bench.hs0000644000000000000000000000024607346545000015114 0ustar0000000000000000{-# LANGUAGE PostfixOperators #-} module Main where -- import qualified Data.List.Infinite as Inf import Test.Tasty.Bench main :: IO () main = defaultMain [ ] infinite-list-0.1.1/infinite-list.cabal0000644000000000000000000000537107346545000016230 0ustar0000000000000000cabal-version: 2.2 name: infinite-list version: 0.1.1 license: BSD-3-Clause license-file: LICENSE maintainer: andrew.lelechenko@gmail.com author: Bodigrim tested-with: ghc ==8.0.2 ghc ==8.2.2 ghc ==8.4.4 ghc ==8.6.5 ghc ==8.8.4 ghc ==8.10.7 ghc ==9.0.2 ghc ==9.2.8 ghc ==9.4.8 ghc ==9.6.3 ghc ==9.8.1 homepage: https://github.com/Bodigrim/infinite-list synopsis: Infinite lists description: 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 `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 @ category: Data build-type: Simple extra-doc-files: CHANGELOG.md README.md source-repository head type: git location: https://github.com/Bodigrim/infinite-list library exposed-modules: Data.List.Infinite hs-source-dirs: src other-modules: Data.List.Infinite.Zip Data.List.Infinite.Internal default-language: Haskell2010 ghc-options: -Wall build-depends: base >=4.9 && <5 if impl(ghc <8.2) build-depends: ghc-prim <1 test-suite infinite-properties type: exitcode-stdio-1.0 main-is: Properties.hs hs-source-dirs: test default-language: Haskell2010 ghc-options: -Wall build-depends: base, infinite-list, QuickCheck, tasty, tasty-quickcheck test-suite infinite-properties-O0 type: exitcode-stdio-1.0 main-is: Properties.hs hs-source-dirs: test default-language: Haskell2010 ghc-options: -Wall -O0 build-depends: base, infinite-list, QuickCheck, tasty, tasty-quickcheck test-suite infinite-fusion type: exitcode-stdio-1.0 main-is: Fusion.hs hs-source-dirs: test default-language: Haskell2010 ghc-options: -Wall build-depends: base, infinite-list, tasty, tasty-inspection-testing, tasty-expected-failure if impl(ghc <9.2) buildable: False benchmark infinite-bench type: exitcode-stdio-1.0 main-is: Bench.hs hs-source-dirs: bench default-language: Haskell2010 ghc-options: -Wall build-depends: base, infinite-list, tasty-bench if impl(ghc >=8.6) ghc-options: -fproc-alignment=64 infinite-list-0.1.1/src/Data/List/0000755000000000000000000000000007346545000015033 5ustar0000000000000000infinite-list-0.1.1/src/Data/List/Infinite.hs0000644000000000000000000010711207346545000017136 0ustar0000000000000000{-# 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 f = go where go (x :< xs) = f x (go 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 f = go where go :: Infinite a -> b go (x :< xs) = f x xs (go xs) -- | Convert to a list. Use 'cycle' to go in the opposite direction. toList :: Infinite a -> [a] toList = 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 (...) = unsafeCycle . enumFrom {-# INLINE [0] (...) #-} infix 0 ... {-# RULES "ellipsis3Int" (...) = ellipsis3Int "ellipsis3Word" (...) = ellipsis3Word "ellipsis3Integer" (...) = ellipsis3Integer "ellipsis3Natural" (...) = ellipsis3Natural #-} ellipsis3Int :: Int -> Infinite Int ellipsis3Int from = iterate' (\n -> if n == maxBound then from else n + 1) from {-# INLINE ellipsis3Int #-} ellipsis3Word :: Word -> Infinite Word ellipsis3Word from = iterate' (\n -> if n == maxBound then from else n + 1) from {-# INLINE ellipsis3Word #-} ellipsis3Integer :: Integer -> Infinite Integer ellipsis3Integer = iterate' (+ 1) {-# INLINE ellipsis3Integer #-} ellipsis3Natural :: Natural -> Infinite Natural ellipsis3Natural = iterate' (+ 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 (....) = unsafeCycle . uncurry enumFromThen {-# INLINE [0] (....) #-} infix 0 .... {-# RULES "ellipsis4Int" (....) = ellipsis4Int "ellipsis4Word" (....) = ellipsis4Word "ellipsis4Integer" (....) = ellipsis4Integer "ellipsis4Natural" (....) = ellipsis4Natural #-} ellipsis4Int :: (Int, Int) -> Infinite Int ellipsis4Int (from, thn) | from <= thn = let d = thn - from in iterate' (\n -> if n > maxBound - d then from else n + d) from | otherwise = let d = from - thn in iterate' (\n -> if n < minBound + d then from else n - d) from {-# INLINE ellipsis4Int #-} ellipsis4Word :: (Word, Word) -> Infinite Word ellipsis4Word (from, thn) | from <= thn = let d = thn - from in iterate' (\n -> if n > maxBound - d then from else n + d) from | otherwise = let d = from - thn in iterate' (\n -> if n < d then from else n - d) from {-# INLINE ellipsis4Word #-} ellipsis4Integer :: (Integer, Integer) -> Infinite Integer ellipsis4Integer (from, thn) = iterate' (+ (thn - from)) from {-# INLINE ellipsis4Integer #-} ellipsis4Natural :: (Natural, Natural) -> Infinite Natural ellipsis4Natural (from, thn) | from <= thn = iterate' (+ (thn - from)) from | otherwise = let d = from - thn in iterate' (\n -> if n < d then from else n - d) from {-# INLINE ellipsis4Natural #-} -- | Just a pointwise 'map'. instance Functor Infinite where fmap = map (<$) = const . repeat -- | This instance operates pointwise, similar to 'Control.Applicative.ZipList'. instance Applicative Infinite where pure = repeat (f :< fs) <*> (x :< xs) = f x :< (fs <*> xs) (<*) = const (*>) = const id #if MIN_VERSION_base(4,10,0) liftA2 = 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 xs >>= f = go 0 xs where go !n (y :< ys) = (f y `index` n) :< go (n + 1) ys index :: Infinite a -> Natural -> a index ys n = head (genericDrop n ys) {-# INLINE (>>=) #-} (>>) = (*>) -- | Get the first elements of an infinite list. head :: Infinite a -> a head (x :< _) = 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 (_ :< xs) = xs -- | Split an infinite list into its 'head' and 'tail'. uncons :: Infinite a -> (a, Infinite a) uncons (x :< xs) = (x, xs) -- | Apply a function to every element of an infinite list. map :: (a -> b) -> Infinite a -> Infinite b map = foldr . ((:<) .) mapFB :: (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst mapFB = (.) {-# 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 = foldr (\(x :| xs) acc -> x :< (xs `prependList` 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 f = foldr (\a acc -> let (x :| xs) = f a in x :< (xs `prependList` 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 (x :< xs) ys = x :< interleave ys xs -- | Insert an element between adjacent elements of an infinite list. intersperse :: a -> Infinite a -> Infinite a intersperse a = foldr (\x -> (x :<) . (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 ~(a :| as) = foldr (\xs -> prependList xs . (a :<) . prependList 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 xss = fmap head xss :< transpose (fmap tail xss) -- | Generate an infinite list of all subsequences of the argument. subsequences :: Infinite a -> Infinite [a] subsequences = ([] :<) . map NE.toList . subsequences1 -- | Generate an infinite list of all non-empty subsequences of the argument. subsequences1 :: Infinite a -> Infinite (NonEmpty a) subsequences1 = foldr go where go :: a -> Infinite (NonEmpty a) -> Infinite (NonEmpty a) go x sxs = (x :| []) :< foldr f sxs where f ys r = ys :< (x `NE.cons` ys) :< r -- | Generate an infinite list of all permutations of the argument. permutations :: Infinite a -> Infinite (Infinite a) permutations xs0 = xs0 :< perms xs0 [] where perms :: forall a. Infinite a -> [a] -> Infinite (Infinite a) perms (t :< ts) is = List.foldr interleaveList (perms ts (t : is)) (List.permutations is) where interleaveList :: [a] -> Infinite (Infinite a) -> Infinite (Infinite a) interleaveList = (snd .) . interleaveList' id interleaveList' :: (Infinite a -> b) -> [a] -> Infinite b -> (Infinite a, Infinite b) interleaveList' _ [] r = (ts, r) interleaveList' f (y : ys) r = (y :< us, f (t :< y :< us) :< zs) where (us, zs) = interleaveList' (f . (y :<)) ys 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 f z0 = (z0 :<) . flip (foldr (\x acc z -> let fzx = f z x in fzx :< acc fzx)) z0 scanlFB :: (elt' -> elt -> elt') -> (elt' -> lst -> lst) -> elt -> (elt' -> lst) -> elt' -> lst scanlFB f cons = \elt g -> oneShot (\x -> let elt' = f x elt in elt' `cons` g 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' f z0 = (z0 :<) . flip (foldr (\x acc z -> let !fzx = f z x in fzx :< acc fzx)) z0 scanlFB' :: (elt' -> elt -> elt') -> (elt' -> lst -> lst) -> elt -> (elt' -> lst) -> elt' -> lst scanlFB' f cons = \elt g -> oneShot (\x -> let !elt' = f x elt in elt' `cons` g 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 f (x :< xs) = scanl f x 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 f = flip (foldr (\x acc s -> let (s', y) = f s x in y :< acc s')) mapAccumLFB :: (acc -> x -> (acc, y)) -> x -> (acc -> Infinite y) -> acc -> Infinite y mapAccumLFB f = \x r -> oneShot (\s -> let (s', y) = f s x in y :< r 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 f = go where go x = x :< go (f x) iterateFB :: (elt -> lst -> lst) -> (elt -> elt) -> elt -> lst iterateFB cons f = go where go x = x `cons` go (f 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' f = go where go !x = x :< go (f x) iterateFB' :: (elt -> lst -> lst) -> (elt -> elt) -> elt -> lst iterateFB' cons f = go where go !x = x `cons` go (f 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 x = go where go = x :< go repeatFB :: (elt -> lst -> lst) -> elt -> lst repeatFB cons x = go where go = x `cons` 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 (x :| xs) = unsafeCycle (x : xs) {-# INLINE cycle #-} unsafeCycle :: [a] -> Infinite a unsafeCycle xs = go where go = xs `prependList` go unsafeCycleFB :: (elt -> lst -> lst) -> [elt] -> lst unsafeCycleFB cons xs = go where go = F.foldr cons go 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 f = go where go b = let (a, b') = f b in a :< go 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 f = unfoldr (\n -> (f n, n + 1)) 0 {-# INLINE tabulate #-} -- | Take a prefix of given length. take :: Int -> Infinite a -> [a] take = GHC.Exts.inline 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 n | n < 1 = const [] | otherwise = flip (foldr (\hd f m -> hd : (if m <= 1 then [] else f (m - 1)))) n genericTakeFB :: Integral i => (elt -> lst -> lst) -> lst -> elt -> (i -> lst) -> i -> lst genericTakeFB cons nil x xs = \m -> if m <= 1 then x `cons` nil else x `cons` xs (m - 1) -- | Drop a prefix of given length. drop :: Int -> Infinite a -> Infinite a drop = GHC.Exts.inline genericDrop -- | Drop a prefix of given length. genericDrop :: Integral i => i -> Infinite a -> Infinite a genericDrop = flip (para (\hd tl f m -> if m < 1 then hd :< tl else f (m - 1))) {-# INLINEABLE genericDrop #-} -- | Split an infinite list into a prefix of given length and the rest. splitAt :: Int -> Infinite a -> ([a], Infinite a) splitAt = GHC.Exts.inline genericSplitAt -- | Split an infinite list into a prefix of given length and the rest. genericSplitAt :: Integral i => i -> Infinite a -> ([a], Infinite a) genericSplitAt n | n < 1 = ([],) | otherwise = flip (para (\hd tl f m -> if m <= 1 then ([hd], tl) else first (hd :) (f (m - 1)))) n {-# INLINEABLE genericSplitAt #-} -- | Take the longest prefix satisfying a predicate. takeWhile :: (a -> Bool) -> Infinite a -> [a] takeWhile p = foldr (\x xs -> if p x then x : xs else []) takeWhileFB :: (elt -> Bool) -> (elt -> lst -> lst) -> lst -> elt -> lst -> lst takeWhileFB p cons nil = \x r -> if p x then x `cons` r else 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 p = para (\x xs -> if p x then id else const (x :< 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 p = para (\x xs -> if p x then first (x :) else const ([], x :< 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 = span . (not .) -- | 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 [] = Just stripPrefix (p : ps) = flip (para alg) (p :| ps) where alg x xs acc (y :| ys) | x == y = maybe (Just xs) acc (NE.nonEmpty ys) | otherwise = Nothing -- | Group consecutive equal elements. group :: Eq a => Infinite a -> Infinite (NonEmpty a) group = groupBy (==) -- | 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 f = go where go (x :< xs) = (x :| ys) :< go zs where (ys, zs) = span (f x) xs -- | Generate all prefixes of an infinite list. inits :: Infinite a -> Infinite [a] inits = map (\(SnocBuilder _ front rear) -> front List.++ List.reverse rear) . scanl' (\(SnocBuilder count front rear) x -> snocBuilder (count + 1) front (x : rear)) (SnocBuilder 0 [] []) data SnocBuilder a = SnocBuilder { _count :: !Word , _front :: [a] , _rear :: [a] } snocBuilder :: Word -> [a] -> [a] -> SnocBuilder a snocBuilder count front rear | count < 8 || (count .&. (count + 1)) /= 0 = SnocBuilder count front rear | otherwise = SnocBuilder count (front List.++ List.reverse rear) [] {-# INLINE snocBuilder #-} -- | Generate all non-empty prefixes of an infinite list. inits1 :: Infinite a -> Infinite (NonEmpty a) inits1 (x :< xs) = map (x :|) (inits xs) -- | Generate all suffixes of an infinite list. tails :: Infinite a -> Infinite (Infinite a) tails = foldr (\x xss@(~(xs :< _)) -> (x :< xs) :< xss) -- | Check whether a list is a prefix of an infinite list. isPrefixOf :: Eq a => [a] -> Infinite a -> Bool isPrefixOf [] = const True isPrefixOf (p : ps) = flip (foldr alg) (p :| ps) where alg x acc (y :| ys) = x == y && maybe True acc (NE.nonEmpty 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 a = foldr (\(a', b) b' -> if a == a' then b else 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 f = foldr (\a a' -> if f a then a else 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 f = foldr (\a -> if f a then (a :<) else id) filterFB :: (elt -> lst -> lst) -> (elt -> Bool) -> elt -> lst -> lst filterFB cons f x r | f x = x `cons` r | otherwise = 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 f = foldr (\a -> if f a then first (a :<) else second (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 (!!) = foldr (\x acc m -> if m == 0 then x else acc (m - 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 = findIndex . (==) -- | 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 = findIndices . (==) -- | 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 f = flip (foldr (\x acc !m -> if f x then m else acc (m + 1))) 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 f = flip (foldr (\x acc !m -> (if f x then (m :<) else id) (acc (m + 1)))) 0 -- | Unzip an infinite list of tuples. unzip :: Infinite (a, b) -> (Infinite a, Infinite b) unzip = foldr (\(a, b) ~(as, bs) -> (a :< as, b :< bs)) {-# INLINE unzip #-} -- | Unzip an infinite list of triples. unzip3 :: Infinite (a, b, c) -> (Infinite a, Infinite b, Infinite c) unzip3 = foldr (\(a, b, c) ~(as, bs, cs) -> (a :< as, b :< bs, 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 = foldr (\(a, b, c, d) ~(as, bs, cs, ds) -> (a :< as, b :< bs, c :< cs, 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 = foldr (\(a, b, c, d, e) ~(as, bs, cs, ds, es) -> (a :< as, b :< bs, c :< cs, d :< ds, 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 = foldr (\(a, b, c, d, e, f) ~(as, bs, cs, ds, es, fs) -> (a :< as, b :< bs, c :< cs, d :< ds, e :< es, 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 = foldr (\(a, b, c, d, e, f, g) ~(as, bs, cs, ds, es, fs, gs) -> (a :< as, b :< bs, c :< cs, d :< ds, e :< es, f :< fs, 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 = foldr go where go '\n' xs = [] :< xs go c ~(x :< xs) = (c : x) :< 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 = foldr (\l xs -> l `prependList` ('\n' :< 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 = uncurry repack . foldr go where repack zs acc = maybe acc (:< acc) (NE.nonEmpty zs) go x ~(zs, acc) = (zs', acc') where s = isSpace x zs' = if s then [] else x : zs acc' = if s then repack zs acc else acc wordsFB :: (NonEmpty Char -> lst -> lst) -> Infinite Char -> lst wordsFB cons = uncurry repack . foldr go where repack zs acc = maybe acc (`cons` acc) (NE.nonEmpty zs) go x ~(zs, acc) = (zs', acc') where s = isSpace x zs' = if s then [] else x : zs acc' = if s then repack zs acc else 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 = foldr (\(l :| ls) acc -> l :< ls `prependList` (' ' :< acc)) unwordsFB :: (Char -> lst -> lst) -> Infinite (NonEmpty Char) -> lst unwordsFB cons = foldr (\(l :| ls) acc -> l `cons` List.foldr cons (' ' `cons` acc) 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 = nubBy (==) -- | Overloaded version of 'nub'. nubBy :: (a -> a -> Bool) -> Infinite a -> Infinite a nubBy eq = flip (foldr (\x acc seen -> if List.any (`eq` x) seen then acc seen else x :< acc (x : seen))) [] -- | Remove all occurrences of an element from an infinite list. delete :: Eq a => a -> Infinite a -> Infinite a delete = deleteBy (==) -- | Overloaded version of 'delete'. deleteBy :: (a -> b -> Bool) -> a -> Infinite b -> Infinite b deleteBy eq x = para (\y ys acc -> if eq x y then ys else y :< acc) -- | Take an infinite list and remove the first occurrence of every element -- of a finite list. (\\) :: Eq a => Infinite a -> [a] -> Infinite a (\\) = deleteFirstsBy (==) -- | Overloaded version of '(\\)'. deleteFirstsBy :: (a -> b -> Bool) -> Infinite b -> [a] -> Infinite b deleteFirstsBy eq = List.foldl (flip (deleteBy 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 = unionBy (==) -- | Overloaded version of 'union'. unionBy :: (a -> a -> Bool) -> [a] -> Infinite a -> Infinite a unionBy eq xs ys = xs `prependList` List.foldl (flip (deleteBy eq)) (nubBy eq ys) 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 = insertBy compare -- | Overloaded version of 'insert'. insertBy :: (a -> a -> Ordering) -> a -> Infinite a -> Infinite a insertBy cmp x = para (\y ys acc -> case cmp x y of GT -> y :< acc; _ -> x :< y :< 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 = intersectBy (==) -- | Overloaded version of 'intersect'. intersectBy :: (a -> b -> Bool) -> Infinite a -> [b] -> Infinite a intersectBy eq xs ys = filter (\x -> List.any (eq x) ys) xs -- | Prepend a list to an infinite list. prependList :: [a] -> Infinite a -> Infinite a prependList = flip (F.foldr (:<)) -- | 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 = foldr . (maybe id (:<) .) -- | 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 = foldr (maybe id (:<)) -- | 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 = foldr . (either (first . (:<)) (second . (:<)) .) -- | 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 = foldr (either (first . (:<)) (second . (:<))) infinite-list-0.1.1/src/Data/List/Infinite/0000755000000000000000000000000007346545000016600 5ustar0000000000000000infinite-list-0.1.1/src/Data/List/Infinite/Internal.hs0000644000000000000000000000103307346545000020705 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} -- | -- Copyright: (c) 2022 Bodigrim -- License: BSD3 module Data.List.Infinite.Internal ( Infinite (..), build, ) where -- | Type of infinite lists. -- -- In terms of recursion schemes, 'Infinite' @a@ is a fix point of the base functor @(a,)@, -- 'Data.List.Infinite.foldr' is a catamorphism and 'Data.List.Infinite.unfoldr' is an anamorphism. data Infinite a = a :< Infinite a infixr 5 :< build :: forall a. (forall b. (a -> b -> b) -> b) -> Infinite a build g = g (:<) {-# INLINE [1] build #-} infinite-list-0.1.1/src/Data/List/Infinite/Zip.hs0000644000000000000000000004165607346545000017712 0ustar0000000000000000-- | -- Copyright: (c) 2022 Bodigrim -- License: BSD3 module Data.List.Infinite.Zip ( zip, zipWith, zip3, zipWith3, zip4, zipWith4, zip5, zipWith5, zip6, zipWith6, zip7, zipWith7, ) where import Prelude (flip, (.)) import Data.List.Infinite.Internal -- | Zip two infinite lists. zip :: Infinite a -> Infinite b -> Infinite (a, b) zip = zipWith (,) {-# INLINE zip #-} -- | Zip two infinite lists with a given function. zipWith :: (a -> b -> c) -> Infinite a -> Infinite b -> Infinite c zipWith fun = go where go (a :< as) (b :< bs) = fun a b :< go as bs zipWithFB :: (elt -> lst -> lst') -> (a -> b -> elt) -> a -> b -> lst -> lst' zipWithFB = (.) . (.) {-# NOINLINE [1] zipWith #-} {-# INLINE [0] zipWithFB #-} {-# RULES "zipWith" [~1] forall f xs ys. zipWith f xs ys = build (\cons -> foldr2 (zipWithFB cons f) xs ys) "zipWithList" [1] forall f. foldr2 (zipWithFB (:<) f) = zipWith f #-} foldr2 :: (elt1 -> elt2 -> lst -> lst) -> Infinite elt1 -> Infinite elt2 -> lst foldr2 cons = go where go (a :< as) (b :< bs) = cons a b (go as bs) {-# INLINE [0] foldr2 #-} foldr2_left :: (elt1 -> elt2 -> lst -> lst') -> elt1 -> (Infinite elt2 -> lst) -> Infinite elt2 -> lst' foldr2_left cons a r (b :< bs) = cons a b (r bs) {-# RULES "foldr2/1" forall (cons :: elt1 -> elt2 -> lst -> lst) (bs :: Infinite elt2) (g :: forall b. (elt1 -> b -> b) -> b). foldr2 cons (build g) bs = g (foldr2_left cons) bs "foldr2/2" forall (cons :: elt1 -> elt2 -> lst -> lst) (as :: Infinite elt1) (g :: forall b. (elt2 -> b -> b) -> b). foldr2 cons as (build g) = g (foldr2_left (flip cons)) as #-} -- | Zip three infinite lists. zip3 :: Infinite a -> Infinite b -> Infinite c -> Infinite (a, b, c) zip3 = zipWith3 (,,) {-# INLINE zip3 #-} -- | Zip three infinite lists with a given function. zipWith3 :: (a -> b -> c -> d) -> Infinite a -> Infinite b -> Infinite c -> Infinite d zipWith3 fun = go where go (a :< as) (b :< bs) (c :< cs) = fun a b c :< go as bs cs zipWith3FB :: (elt -> lst -> lst') -> (a -> b -> c -> elt) -> a -> b -> c -> lst -> lst' zipWith3FB = (.) . (.) . (.) {-# NOINLINE [1] zipWith3 #-} {-# INLINE [0] zipWith3FB #-} {-# RULES "zipWith3" [~1] forall f xs ys zs. zipWith3 f xs ys zs = build (\cons -> foldr3 (zipWith3FB cons f) xs ys zs) "zipWith3List" [1] forall f. foldr3 (zipWith3FB (:<) f) = zipWith3 f #-} foldr3 :: (elt1 -> elt2 -> elt3 -> lst -> lst) -> Infinite elt1 -> Infinite elt2 -> Infinite elt3 -> lst foldr3 cons = go where go (a :< as) (b :< bs) (c :< cs) = cons a b c (go as bs cs) {-# INLINE [0] foldr3 #-} foldr3_left :: (elt1 -> elt2 -> elt3 -> lst -> lst') -> elt1 -> (Infinite elt2 -> Infinite elt3 -> lst) -> Infinite elt2 -> Infinite elt3 -> lst' foldr3_left cons a r (b :< bs) (c :< cs) = cons a b c (r bs cs) {-# RULES "foldr3/1" forall (cons :: elt1 -> elt2 -> elt3 -> lst -> lst) (bs :: Infinite elt2) (cs :: Infinite elt3) (g :: forall b. (elt1 -> b -> b) -> b). foldr3 cons (build g) bs cs = g (foldr3_left cons) bs cs "foldr3/2" forall (cons :: elt1 -> elt2 -> elt3 -> lst -> lst) (as :: Infinite elt1) (cs :: Infinite elt3) (g :: forall b. (elt2 -> b -> b) -> b). foldr3 cons as (build g) cs = g (foldr3_left (flip cons)) as cs "foldr3/3" forall (cons :: elt1 -> elt2 -> elt3 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (g :: forall b. (elt3 -> b -> b) -> b). foldr3 cons as bs (build g) = g (foldr3_left (\c a b -> cons a b c)) as bs #-} -- | Zip four infinite lists. zip4 :: Infinite a -> Infinite b -> Infinite c -> Infinite d -> Infinite (a, b, c, d) zip4 = zipWith4 (,,,) {-# INLINE zip4 #-} -- | Zip four infinite lists with a given function. zipWith4 :: (a -> b -> c -> d -> e) -> Infinite a -> Infinite b -> Infinite c -> Infinite d -> Infinite e zipWith4 fun = go where go (a :< as) (b :< bs) (c :< cs) (d :< ds) = fun a b c d :< go as bs cs ds zipWith4FB :: (elt -> lst -> lst') -> (a -> b -> c -> d -> elt) -> a -> b -> c -> d -> lst -> lst' zipWith4FB = (.) . (.) . (.) . (.) {-# NOINLINE [1] zipWith4 #-} {-# INLINE [0] zipWith4FB #-} {-# RULES "zipWith4" [~1] forall f xs ys zs ts. zipWith4 f xs ys zs ts = build (\cons -> foldr4 (zipWith4FB cons f) xs ys zs ts) "zipWith4List" [1] forall f. foldr4 (zipWith4FB (:<) f) = zipWith4 f #-} foldr4 :: (elt1 -> elt2 -> elt3 -> elt4 -> lst -> lst) -> Infinite elt1 -> Infinite elt2 -> Infinite elt3 -> Infinite elt4 -> lst foldr4 cons = go where go (a :< as) (b :< bs) (c :< cs) (d :< ds) = cons a b c d (go as bs cs ds) {-# INLINE [0] foldr4 #-} foldr4_left :: (elt1 -> elt2 -> elt3 -> elt4 -> lst -> lst') -> elt1 -> (Infinite elt2 -> Infinite elt3 -> Infinite elt4 -> lst) -> Infinite elt2 -> Infinite elt3 -> Infinite elt4 -> lst' foldr4_left cons a r (b :< bs) (c :< cs) (d :< ds) = cons a b c d (r bs cs ds) {-# RULES "foldr4/1" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> lst -> lst) (bs :: Infinite elt2) (cs :: Infinite elt3) (ds :: Infinite elt4) (g :: forall b. (elt1 -> b -> b) -> b). foldr4 cons (build g) bs cs ds = g (foldr4_left cons) bs cs ds "foldr4/2" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> lst -> lst) (as :: Infinite elt1) (cs :: Infinite elt3) (ds :: Infinite elt4) (g :: forall b. (elt2 -> b -> b) -> b). foldr4 cons as (build g) cs ds = g (foldr4_left (flip cons)) as cs ds "foldr4/3" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (ds :: Infinite elt4) (g :: forall b. (elt3 -> b -> b) -> b). foldr4 cons as bs (build g) ds = g (foldr4_left (\c a b d -> cons a b c d)) as bs ds "foldr4/4" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (cs :: Infinite elt3) (g :: forall b. (elt4 -> b -> b) -> b). foldr4 cons as bs cs (build g) = g (foldr4_left (\d a b c -> cons a b c d)) as bs cs #-} -- | Zip five infinite lists. zip5 :: Infinite a -> Infinite b -> Infinite c -> Infinite d -> Infinite e -> Infinite (a, b, c, d, e) zip5 = zipWith5 (,,,,) {-# INLINE zip5 #-} -- | Zip five infinite lists with a given function. zipWith5 :: (a -> b -> c -> d -> e -> f) -> Infinite a -> Infinite b -> Infinite c -> Infinite d -> Infinite e -> Infinite f zipWith5 fun = go where go (a :< as) (b :< bs) (c :< cs) (d :< ds) (e :< es) = fun a b c d e :< go as bs cs ds es zipWith5FB :: (elt -> lst -> lst') -> (a -> b -> c -> d -> e -> elt) -> a -> b -> c -> d -> e -> lst -> lst' zipWith5FB = (.) . (.) . (.) . (.) . (.) {-# NOINLINE [1] zipWith5 #-} {-# INLINE [0] zipWith5FB #-} {-# RULES "zipWith5" [~1] forall f xs ys zs ts us. zipWith5 f xs ys zs ts us = build (\cons -> foldr5 (zipWith5FB cons f) xs ys zs ts us) "zipWith5List" [1] forall f. foldr5 (zipWith5FB (:<) f) = zipWith5 f #-} foldr5 :: (elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> lst -> lst) -> Infinite elt1 -> Infinite elt2 -> Infinite elt3 -> Infinite elt4 -> Infinite elt5 -> lst foldr5 cons = go where go (a :< as) (b :< bs) (c :< cs) (d :< ds) (e :< es) = cons a b c d e (go as bs cs ds es) {-# INLINE [0] foldr5 #-} foldr5_left :: (elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> lst -> lst') -> elt1 -> (Infinite elt2 -> Infinite elt3 -> Infinite elt4 -> Infinite elt5 -> lst) -> Infinite elt2 -> Infinite elt3 -> Infinite elt4 -> Infinite elt5 -> lst' foldr5_left cons a r (b :< bs) (c :< cs) (d :< ds) (e :< es) = cons a b c d e (r bs cs ds es) {-# RULES "foldr5/1" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> lst -> lst) (bs :: Infinite elt2) (cs :: Infinite elt3) (ds :: Infinite elt4) (es :: Infinite elt5) (g :: forall b. (elt1 -> b -> b) -> b). foldr5 cons (build g) bs cs ds es = g (foldr5_left cons) bs cs ds es "foldr5/2" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> lst -> lst) (as :: Infinite elt1) (cs :: Infinite elt3) (ds :: Infinite elt4) (es :: Infinite elt5) (g :: forall b. (elt2 -> b -> b) -> b). foldr5 cons as (build g) cs ds es = g (foldr5_left (flip cons)) as cs ds es "foldr5/3" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (ds :: Infinite elt4) (es :: Infinite elt5) (g :: forall b. (elt3 -> b -> b) -> b). foldr5 cons as bs (build g) ds es = g (foldr5_left (\c a b d e -> cons a b c d e)) as bs ds es "foldr5/4" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (cs :: Infinite elt3) (es :: Infinite elt5) (g :: forall b. (elt4 -> b -> b) -> b). foldr5 cons as bs cs (build g) es = g (foldr5_left (\d a b c e -> cons a b c d e)) as bs cs es "foldr5/5" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (cs :: Infinite elt3) (ds :: Infinite elt4) (g :: forall b. (elt5 -> b -> b) -> b). foldr5 cons as bs cs ds (build g) = g (foldr5_left (\e a b c d -> cons a b c d e)) as bs cs ds #-} -- | Zip six infinite lists. zip6 :: Infinite a -> Infinite b -> Infinite c -> Infinite d -> Infinite e -> Infinite f -> Infinite (a, b, c, d, e, f) zip6 = zipWith6 (,,,,,) {-# INLINE zip6 #-} -- | Zip six infinite lists with a given function. zipWith6 :: (a -> b -> c -> d -> e -> f -> g) -> Infinite a -> Infinite b -> Infinite c -> Infinite d -> Infinite e -> Infinite f -> Infinite g zipWith6 fun = go where go (a :< as) (b :< bs) (c :< cs) (d :< ds) (e :< es) (f :< fs) = fun a b c d e f :< go as bs cs ds es fs zipWith6FB :: (elt -> lst -> lst') -> (a -> b -> c -> d -> e -> f -> elt) -> a -> b -> c -> d -> e -> f -> lst -> lst' zipWith6FB = (.) . (.) . (.) . (.) . (.) . (.) {-# NOINLINE [1] zipWith6 #-} {-# INLINE [0] zipWith6FB #-} {-# RULES "zipWith6" [~1] forall f xs ys zs ts us vs. zipWith6 f xs ys zs ts us vs = build (\cons -> foldr6 (zipWith6FB cons f) xs ys zs ts us vs) "zipWith6List" [1] forall f. foldr6 (zipWith6FB (:<) f) = zipWith6 f #-} foldr6 :: (elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> lst -> lst) -> Infinite elt1 -> Infinite elt2 -> Infinite elt3 -> Infinite elt4 -> Infinite elt5 -> Infinite elt6 -> lst foldr6 cons = go where go (a :< as) (b :< bs) (c :< cs) (d :< ds) (e :< es) (f :< fs) = cons a b c d e f (go as bs cs ds es fs) {-# INLINE [0] foldr6 #-} foldr6_left :: (elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> lst -> lst') -> elt1 -> (Infinite elt2 -> Infinite elt3 -> Infinite elt4 -> Infinite elt5 -> Infinite elt6 -> lst) -> Infinite elt2 -> Infinite elt3 -> Infinite elt4 -> Infinite elt5 -> Infinite elt6 -> lst' foldr6_left cons a r (b :< bs) (c :< cs) (d :< ds) (e :< es) (f :< fs) = cons a b c d e f (r bs cs ds es fs) {-# RULES "foldr6/1" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> lst -> lst) (bs :: Infinite elt2) (cs :: Infinite elt3) (ds :: Infinite elt4) (es :: Infinite elt5) (fs :: Infinite elt6) (g :: forall b. (elt1 -> b -> b) -> b). foldr6 cons (build g) bs cs ds es fs = g (foldr6_left cons) bs cs ds es fs "foldr6/2" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> lst -> lst) (as :: Infinite elt1) (cs :: Infinite elt3) (ds :: Infinite elt4) (es :: Infinite elt5) (fs :: Infinite elt6) (g :: forall b. (elt2 -> b -> b) -> b). foldr6 cons as (build g) cs ds es fs = g (foldr6_left (flip cons)) as cs ds es fs "foldr6/3" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (ds :: Infinite elt4) (es :: Infinite elt5) (fs :: Infinite elt6) (g :: forall b. (elt3 -> b -> b) -> b). foldr6 cons as bs (build g) ds es fs = g (foldr6_left (\c a b d e f -> cons a b c d e f)) as bs ds es fs "foldr6/4" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (cs :: Infinite elt3) (es :: Infinite elt5) (fs :: Infinite elt6) (g :: forall b. (elt4 -> b -> b) -> b). foldr6 cons as bs cs (build g) es fs = g (foldr6_left (\d a b c e f -> cons a b c d e f)) as bs cs es fs "foldr6/5" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (cs :: Infinite elt3) (ds :: Infinite elt4) (fs :: Infinite elt6) (g :: forall b. (elt5 -> b -> b) -> b). foldr6 cons as bs cs ds (build g) fs = g (foldr6_left (\e a b c d f -> cons a b c d e f)) as bs cs ds fs "foldr6/6" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (cs :: Infinite elt3) (ds :: Infinite elt4) (es :: Infinite elt5) (g :: forall b. (elt6 -> b -> b) -> b). foldr6 cons as bs cs ds es (build g) = g (foldr6_left (\f a b c d e -> cons a b c d e f)) as bs cs ds es #-} -- | Zip seven infinite lists. zip7 :: Infinite a -> Infinite b -> Infinite c -> Infinite d -> Infinite e -> Infinite f -> Infinite g -> Infinite (a, b, c, d, e, f, g) zip7 = zipWith7 (,,,,,,) {-# INLINE zip7 #-} -- | Zip seven infinite lists with a given function. zipWith7 :: (a -> b -> c -> d -> e -> f -> g -> h) -> Infinite a -> Infinite b -> Infinite c -> Infinite d -> Infinite e -> Infinite f -> Infinite g -> Infinite h zipWith7 fun = go where go (a :< as) (b :< bs) (c :< cs) (d :< ds) (e :< es) (f :< fs) (g :< gs) = fun a b c d e f g :< go as bs cs ds es fs gs zipWith7FB :: (elt -> lst -> lst') -> (a -> b -> c -> d -> e -> f -> g -> elt) -> a -> b -> c -> d -> e -> f -> g -> lst -> lst' zipWith7FB = (.) . (.) . (.) . (.) . (.) . (.) . (.) {-# NOINLINE [1] zipWith7 #-} {-# INLINE [0] zipWith7FB #-} {-# RULES "zipWith7" [~1] forall f xs ys zs ts us vs ws. zipWith7 f xs ys zs ts us vs ws = build (\cons -> foldr7 (zipWith7FB cons f) xs ys zs ts us vs ws) "zipWith7List" [1] forall f. foldr7 (zipWith7FB (:<) f) = zipWith7 f #-} foldr7 :: (elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> elt7 -> lst -> lst) -> Infinite elt1 -> Infinite elt2 -> Infinite elt3 -> Infinite elt4 -> Infinite elt5 -> Infinite elt6 -> Infinite elt7 -> lst foldr7 cons = go where go (a :< as) (b :< bs) (c :< cs) (d :< ds) (e :< es) (f :< fs) (g :< gs) = cons a b c d e f g (go as bs cs ds es fs gs) {-# INLINE [0] foldr7 #-} foldr7_left :: (elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> elt7 -> lst -> lst') -> elt1 -> (Infinite elt2 -> Infinite elt3 -> Infinite elt4 -> Infinite elt5 -> Infinite elt6 -> Infinite elt7 -> lst) -> Infinite elt2 -> Infinite elt3 -> Infinite elt4 -> Infinite elt5 -> Infinite elt6 -> Infinite elt7 -> lst' foldr7_left cons a r (b :< bs) (c :< cs) (d :< ds) (e :< es) (f :< fs) (g :< gs) = cons a b c d e f g (r bs cs ds es fs gs) {-# RULES "foldr7/1" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> elt7 -> lst -> lst) (bs :: Infinite elt2) (cs :: Infinite elt3) (ds :: Infinite elt4) (es :: Infinite elt5) (fs :: Infinite elt6) (gs :: Infinite elt7) (g :: forall b. (elt1 -> b -> b) -> b). foldr7 cons (build g) bs cs ds es fs gs = g (foldr7_left cons) bs cs ds es fs gs "foldr7/2" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> elt7 -> lst -> lst) (as :: Infinite elt1) (cs :: Infinite elt3) (ds :: Infinite elt4) (es :: Infinite elt5) (fs :: Infinite elt6) (gs :: Infinite elt7) (g :: forall b. (elt2 -> b -> b) -> b). foldr7 cons as (build g) cs ds es fs gs = g (foldr7_left (flip cons)) as cs ds es fs gs "foldr7/3" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> elt7 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (ds :: Infinite elt4) (es :: Infinite elt5) (fs :: Infinite elt6) (gs :: Infinite elt7) (g :: forall b. (elt3 -> b -> b) -> b). foldr7 cons as bs (build g) ds es fs gs = g (foldr7_left (\c a b d e f g' -> cons a b c d e f g')) as bs ds es fs gs "foldr7/4" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> elt7 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (cs :: Infinite elt3) (es :: Infinite elt5) (fs :: Infinite elt6) (gs :: Infinite elt7) (g :: forall b. (elt4 -> b -> b) -> b). foldr7 cons as bs cs (build g) es fs gs = g (foldr7_left (\d a b c e f g' -> cons a b c d e f g')) as bs cs es fs gs "foldr7/5" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> elt7 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (cs :: Infinite elt3) (ds :: Infinite elt4) (fs :: Infinite elt6) (gs :: Infinite elt7) (g :: forall b. (elt5 -> b -> b) -> b). foldr7 cons as bs cs ds (build g) fs gs = g (foldr7_left (\e a b c d f g' -> cons a b c d e f g')) as bs cs ds fs gs "foldr7/6" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> elt7 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (cs :: Infinite elt3) (ds :: Infinite elt4) (es :: Infinite elt5) (gs :: Infinite elt7) (g :: forall b. (elt6 -> b -> b) -> b). foldr7 cons as bs cs ds es (build g) gs = g (foldr7_left (\f a b c d e g' -> cons a b c d e f g')) as bs cs ds es gs "foldr7/7" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> elt7 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (cs :: Infinite elt3) (ds :: Infinite elt4) (es :: Infinite elt5) (fs :: Infinite elt6) (g :: forall b. (elt7 -> b -> b) -> b). foldr7 cons as bs cs ds es fs (build g) = g (foldr7_left (\g' a b c d e f -> cons a b c d e f g')) as bs cs ds es fs #-} infinite-list-0.1.1/test/0000755000000000000000000000000007346545000013437 5ustar0000000000000000infinite-list-0.1.1/test/Fusion.hs0000644000000000000000000003343207346545000015243 0ustar0000000000000000-- | -- Copyright: (c) 2022 Bodigrim -- Licence: BSD3 {-# LANGUAGE PostfixOperators #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -O -dsuppress-all -dno-suppress-type-signatures -fplugin=Test.Tasty.Inspection.Plugin #-} module Main where import Test.Tasty import Test.Tasty.ExpectedFailure import Test.Tasty.Inspection import Test.Tasty.Runners import Data.Coerce import Data.Ord import Data.List.Infinite (Infinite(..)) import qualified Data.List.Infinite as I import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NE foldrMap :: Infinite Int -> Infinite Int foldrMap xs = I.foldr (\x acc -> fromIntegral x :< acc) (I.map fromIntegral xs :: Infinite Word) foldrConsMap :: Int -> Infinite Int -> Infinite Int foldrConsMap i xs = I.foldr (\x acc -> fromIntegral x :< acc) (fromIntegral i :< (I.map fromIntegral xs :: Infinite Word)) mapMap :: Infinite Int -> Infinite Int mapMap xs = I.map fromIntegral (I.map fromIntegral xs :: Infinite Word) mapId :: Infinite Int -> Infinite Int mapId xs = I.map id (I.map id xs) mapCoerce :: Infinite Int -> Infinite (Down Int) mapCoerce xs = I.map coerce xs headIterate :: Int -> Int headIterate x = I.head (I.iterate (+ 1) x) foldrIterate :: Int -> [Int] foldrIterate x = I.foldr (\a acc -> a : a : acc) (I.iterate (+ 1) x) foldrIterate' :: Int -> [Int] foldrIterate' x = I.foldr (\a acc -> a : a : acc) (I.iterate (+ 1) x) foldrRepeat :: Int -> [Int] foldrRepeat x = I.foldr (\a acc -> a : a : acc) (I.repeat x) headFilterIterate :: Int -> Int headFilterIterate x = I.head (I.filter (> 10) (I.iterate (+ 1) x)) filterFilter :: Infinite Int -> Infinite Int filterFilter xs = I.filter (> 10) (I.filter (> 5) xs) filterFilter' :: Infinite Int -> Infinite Int filterFilter' xs = I.filter (\x -> x > 10 && x > 5) xs foldrScanl :: Infinite Int -> Infinite Int foldrScanl xs = I.foldr (\a acc -> fromIntegral a :< acc) (I.scanl (\_acc a -> fromIntegral a) (0 :: Word) xs) foldrScanl' :: Infinite Int -> Infinite Int foldrScanl' xs = I.foldr (\a acc -> fromIntegral a :< acc) (I.scanl' (\_acc a -> fromIntegral a) (0 :: Word) xs) takeRepeat :: Int -> [Int] takeRepeat x = I.take x (I.repeat x) takeWhileIterate :: Int -> [Int] takeWhileIterate x = I.takeWhile (< 10) (I.iterate (+ 1) x) foldrCycle :: NonEmpty Int -> [Int] foldrCycle xs = I.foldr (:) (I.cycle xs) foldrWordsCycle :: [Char] -> [Char] foldrWordsCycle xs = I.foldr (\a acc -> NE.head a : acc) (I.words (I.cycle (' ' :| xs))) foldrMapAccumL :: Infinite Int -> Infinite Int foldrMapAccumL xs = I.foldr (\a acc -> fromIntegral a :< acc) (I.mapAccumL (\acc x -> (acc, fromIntegral x :: Word)) (0 :: Int) xs) mapAccumLRepeat :: Int -> Infinite Int mapAccumLRepeat n = I.mapAccumL (\acc x -> (acc, fromIntegral x)) 'q' (I.repeat (fromIntegral n :: Word)) takeFilterIterate :: [Int] takeFilterIterate = I.take 100 $ I.filter odd $ I.iterate (+ 1) 0 sumTakeFilterIterate :: Int sumTakeFilterIterate = sum $ I.take 100 $ I.filter odd $ I.iterate (+ 1) 0 takeFilterCycle :: [Int] takeFilterCycle = I.take 100 $ I.filter odd $ I.cycle $ 0 :| [1..] takeFilterEllipsis3 :: [Int] takeFilterEllipsis3 = I.take 100 $ I.filter odd (0 I....) takeFilterEllipsis4 :: [Int] takeFilterEllipsis4 = I.take 100 $ I.filter odd ((0, 3) I.....) sumTakeFilterEllipsis3 :: Int sumTakeFilterEllipsis3 = sum $ I.take 100 $ I.filter odd (0 I....) sumTakeFilterEllipsis4 :: Int sumTakeFilterEllipsis4 = sum $ I.take 100 $ I.filter odd ((0, 3) I.....) takeToListFilterIterate :: [Int] takeToListFilterIterate = Prelude.take 100 $ I.toList $ I.filter odd $ I.iterate (+ 1) 0 sumTakeToListFilterIterate :: Int sumTakeToListFilterIterate = sum $ Prelude.take 100 $ I.toList $ I.filter odd $ I.iterate (+ 1) 0 takeToListFilterCycle :: [Int] takeToListFilterCycle = Prelude.take 100 $ I.toList $ I.filter odd $ I.cycle $ 0 :| [1..] takeToListFilterEllipsis3 :: [Int] takeToListFilterEllipsis3 = Prelude.take 100 $ I.toList $ I.filter odd (0 I....) takeToListFilterEllipsis4 :: [Int] takeToListFilterEllipsis4 = Prelude.take 100 $ I.toList $ I.filter odd ((0, 3) I.....) sumTakeToListFilterEllipsis3 :: Int sumTakeToListFilterEllipsis3 = sum $ Prelude.take 100 $ I.toList $ I.filter odd (0 I....) sumTakeToListFilterEllipsis4 :: Int sumTakeToListFilterEllipsis4 = sum $ Prelude.take 100 $ I.toList $ I.filter odd ((0, 3) I.....) headFilterMapEllipsis3 :: Int headFilterMapEllipsis3 = I.head $ I.filter odd $ I.map (+ 1) (0 I....) headFilterMapEllipsis4 :: Int headFilterMapEllipsis4 = I.head $ I.filter odd $ I.map (+ 1) ((0, 3) I.....) toListConcatRepeat :: [Int] toListConcatRepeat = I.toList $ I.concat $ I.repeat $ NE.singleton 1 toListConcatMapRepeat :: [Int] toListConcatMapRepeat = I.toList $ I.concatMap NE.singleton $ I.repeat 1 toListIntersperseRepeat :: [Int] toListIntersperseRepeat = I.toList $ I.intersperse 1 $ I.repeat 0 toListIntercalateRepeat :: [Int] toListIntercalateRepeat = I.toList $ I.intercalate (NE.singleton 1) $ I.repeat [0] headMapZipIterate :: Bool headMapZipIterate = I.head $ I.map ((> 0) . snd) $ I.zip (I.repeat (1 :: Word)) $ I.iterate id (0 :: Int) headMapFlipZipIterate :: Bool headMapFlipZipIterate = I.head $ I.map ((> 0) . fst) $ flip I.zip (I.repeat (1 :: Word)) $ I.iterate id (0 :: Int) zeros :: Infinite Word zeros = I.repeat 0 {-# NOINLINE zeros #-} zipWithRepeat1 :: Infinite Bool zipWithRepeat1 = I.zipWith (\x y -> x == fromIntegral y) (I.repeat (1 :: Int)) zeros zipWithRepeat2 :: Infinite Bool zipWithRepeat2 = I.zipWith (\x y -> y == fromIntegral x) zeros (I.repeat (1 :: Int)) zipWith3Repeat1 :: Infinite Bool zipWith3Repeat1 = I.zipWith3 (\x y z -> x == fromIntegral (y + z)) (I.repeat (1 :: Int)) zeros zeros zipWith3Repeat2 :: Infinite Bool zipWith3Repeat2 = I.zipWith3 (\x y z -> y == fromIntegral (x + z)) zeros (I.repeat (1 :: Int)) zeros zipWith3Repeat3 :: Infinite Bool zipWith3Repeat3 = I.zipWith3 (\x y z -> z == fromIntegral (x + y)) zeros zeros (I.repeat (1 :: Int)) zipWith4Repeat1 :: Infinite Bool zipWith4Repeat1 = I.zipWith4 (\x y z t -> x == fromIntegral (y + z + t)) (I.repeat (1 :: Int)) zeros zeros zeros zipWith4Repeat2 :: Infinite Bool zipWith4Repeat2 = I.zipWith4 (\x y z t -> y == fromIntegral (x + z + t)) zeros (I.repeat (1 :: Int)) zeros zeros zipWith4Repeat3 :: Infinite Bool zipWith4Repeat3 = I.zipWith4 (\x y z t -> z == fromIntegral (x + y + t)) zeros zeros (I.repeat (1 :: Int)) zeros zipWith4Repeat4 :: Infinite Bool zipWith4Repeat4 = I.zipWith4 (\x y z t -> t == fromIntegral (x + y + z)) zeros zeros zeros (I.repeat (1 :: Int)) zipWith5Repeat1 :: Infinite Bool zipWith5Repeat1 = I.zipWith5 (\x y z t u -> x == fromIntegral (y + z + t + u)) (I.repeat (1 :: Int)) zeros zeros zeros zeros zipWith5Repeat2 :: Infinite Bool zipWith5Repeat2 = I.zipWith5 (\x y z t u -> y == fromIntegral (x + z + t + u)) zeros (I.repeat (1 :: Int)) zeros zeros zeros zipWith5Repeat3 :: Infinite Bool zipWith5Repeat3 = I.zipWith5 (\x y z t u -> z == fromIntegral (x + y + t + u)) zeros zeros (I.repeat (1 :: Int)) zeros zeros zipWith5Repeat4 :: Infinite Bool zipWith5Repeat4 = I.zipWith5 (\x y z t u -> t == fromIntegral (x + y + z + u)) zeros zeros zeros (I.repeat (1 :: Int)) zeros zipWith5Repeat5 :: Infinite Bool zipWith5Repeat5 = I.zipWith5 (\x y z t u -> u == fromIntegral (x + y + z + t)) zeros zeros zeros zeros (I.repeat (1 :: Int)) zipWith6Repeat1 :: Infinite Bool zipWith6Repeat1 = I.zipWith6 (\x y z t u v -> x == fromIntegral (y + z + t + u + v)) (I.repeat (1 :: Int)) zeros zeros zeros zeros zeros zipWith6Repeat2 :: Infinite Bool zipWith6Repeat2 = I.zipWith6 (\x y z t u v -> y == fromIntegral (x + z + t + u + v)) zeros (I.repeat (1 :: Int)) zeros zeros zeros zeros zipWith6Repeat3 :: Infinite Bool zipWith6Repeat3 = I.zipWith6 (\x y z t u v -> z == fromIntegral (x + y + t + u + v)) zeros zeros (I.repeat (1 :: Int)) zeros zeros zeros zipWith6Repeat4 :: Infinite Bool zipWith6Repeat4 = I.zipWith6 (\x y z t u v -> t == fromIntegral (x + y + z + u + v)) zeros zeros zeros (I.repeat (1 :: Int)) zeros zeros zipWith6Repeat5 :: Infinite Bool zipWith6Repeat5 = I.zipWith6 (\x y z t u v -> u == fromIntegral (x + y + z + t + v)) zeros zeros zeros zeros (I.repeat (1 :: Int)) zeros zipWith6Repeat6 :: Infinite Bool zipWith6Repeat6 = I.zipWith6 (\x y z t u v -> v == fromIntegral (x + y + z + t + u)) zeros zeros zeros zeros zeros (I.repeat (1 :: Int)) zipWith7Repeat1 :: Infinite Bool zipWith7Repeat1 = I.zipWith7 (\x y z t u v w -> x == fromIntegral (y + z + t + u + v + w)) (I.repeat (1 :: Int)) zeros zeros zeros zeros zeros zeros zipWith7Repeat2 :: Infinite Bool zipWith7Repeat2 = I.zipWith7 (\x y z t u v w -> y == fromIntegral (x + z + t + u + v + w)) zeros (I.repeat (1 :: Int)) zeros zeros zeros zeros zeros zipWith7Repeat3 :: Infinite Bool zipWith7Repeat3 = I.zipWith7 (\x y z t u v w -> z == fromIntegral (x + y + t + u + v + w)) zeros zeros (I.repeat (1 :: Int)) zeros zeros zeros zeros zipWith7Repeat4 :: Infinite Bool zipWith7Repeat4 = I.zipWith7 (\x y z t u v w -> t == fromIntegral (x + y + z + u + v + w)) zeros zeros zeros (I.repeat (1 :: Int)) zeros zeros zeros zipWith7Repeat5 :: Infinite Bool zipWith7Repeat5 = I.zipWith7 (\x y z t u v w -> u == fromIntegral (x + y + z + t + v + w)) zeros zeros zeros zeros (I.repeat (1 :: Int)) zeros zeros zipWith7Repeat6 :: Infinite Bool zipWith7Repeat6 = I.zipWith7 (\x y z t u v w -> v == fromIntegral (x + y + z + t + u + w)) zeros zeros zeros zeros zeros (I.repeat (1 :: Int)) zeros zipWith7Repeat7 :: Infinite Bool zipWith7Repeat7 = I.zipWith7 (\x y z t u v w -> w == fromIntegral (x + y + z + t + u + v)) zeros zeros zeros zeros zeros zeros (I.repeat (1 :: Int)) main :: IO () main = defaultMain $ testGroup "All" [ $(inspectTest $ 'foldrMap `hasNoType` ''Word) , $(inspectTest $ 'foldrConsMap `hasNoType` ''Word) , $(inspectTest $ 'mapMap `hasNoType` ''Word) , $(inspectTest $ 'mapId `hasNoType` ''Word) , $(inspectTest $ 'mapCoerce ==- 'mapId) , $(inspectTest $ 'headIterate `hasNoType` ''Infinite) , $(inspectTest $ 'foldrIterate `hasNoType` ''Infinite) , $(inspectTest $ 'foldrIterate' `hasNoType` ''Infinite) , $(inspectTest $ 'foldrRepeat `hasNoType` ''Infinite) , $(inspectTest $ 'headFilterIterate `hasNoType` ''Infinite) , $(inspectTest $ 'filterFilter ==- 'filterFilter') , $(inspectTest $ 'foldrScanl `hasNoType` ''Word) , $(inspectTest $ 'foldrScanl' `hasNoType` ''Word) , $(inspectTest $ 'takeRepeat `hasNoType` ''Infinite) , $(inspectTest $ 'takeWhileIterate `hasNoType` ''Infinite) , $(inspectTest $ 'foldrCycle `hasNoType` ''Infinite) , $(inspectTest $ 'foldrWordsCycle `hasNoType` ''NonEmpty) , $(inspectTest $ 'mapAccumLRepeat `hasNoType` ''Word) , $(inspectTest $ 'takeFilterIterate `hasNoType` ''Infinite) , $(inspectTest $ 'sumTakeFilterIterate `hasNoTypes` [''Infinite, ''[]]) , $(inspectTest $ 'takeFilterCycle `hasNoType` ''Infinite) , $(inspectTest $ 'takeFilterEllipsis3 `hasNoType` ''Infinite) , $(inspectTest $ 'takeFilterEllipsis4 `hasNoType` ''Infinite) , $(inspectTest $ 'sumTakeFilterEllipsis3 `hasNoTypes` [''Infinite, ''[]]) , $(inspectTest $ 'sumTakeFilterEllipsis4 `hasNoTypes` [''Infinite, ''[]]) , $(inspectTest $ 'takeToListFilterIterate `hasNoType` ''Infinite) , $(inspectTest $ 'sumTakeToListFilterIterate `hasNoTypes` [''Infinite, ''[]]) , $(inspectTest $ 'takeToListFilterCycle `hasNoType` ''Infinite) , $(inspectTest $ 'takeToListFilterEllipsis3 `hasNoType` ''Infinite) , $(inspectTest $ 'takeToListFilterEllipsis4 `hasNoType` ''Infinite) , $(inspectTest $ 'sumTakeToListFilterEllipsis3 `hasNoTypes` [''Infinite, ''[]]) , $(inspectTest $ 'sumTakeToListFilterEllipsis4 `hasNoTypes` [''Infinite, ''[]]) , $(inspectTest $ 'headFilterMapEllipsis3 `hasNoTypes` [''Infinite, ''[]]) , $(inspectTest $ 'headFilterMapEllipsis4 `hasNoTypes` [''Infinite, ''[]]) , $(inspectTest $ 'toListConcatRepeat `hasNoType` ''Infinite) , $(inspectTest $ 'toListConcatMapRepeat `hasNoType` ''Infinite) , $(inspectTest $ 'toListIntersperseRepeat `hasNoType` ''Infinite) , $(inspectTest $ 'toListIntercalateRepeat `hasNoType` ''Infinite) , $(inspectTest $ 'headMapZipIterate `hasNoType` ''Word) , $(inspectTest $ 'headMapFlipZipIterate `hasNoType` ''Int) , $(inspectTest $ 'zipWithRepeat1 `hasNoType` ''Int) , $(inspectTest $ 'zipWithRepeat2 `hasNoType` ''Int) , $(inspectTest $ 'zipWith3Repeat1 `hasNoType` ''Int) , $(inspectTest $ 'zipWith3Repeat2 `hasNoType` ''Int) , $(inspectTest $ 'zipWith3Repeat3 `hasNoType` ''Int) , $(inspectTest $ 'zipWith4Repeat1 `hasNoType` ''Int) , $(inspectTest $ 'zipWith4Repeat2 `hasNoType` ''Int) , $(inspectTest $ 'zipWith4Repeat3 `hasNoType` ''Int) , $(inspectTest $ 'zipWith4Repeat4 `hasNoType` ''Int) , $(inspectTest $ 'zipWith5Repeat1 `hasNoType` ''Int) , $(inspectTest $ 'zipWith5Repeat2 `hasNoType` ''Int) , $(inspectTest $ 'zipWith5Repeat3 `hasNoType` ''Int) , $(inspectTest $ 'zipWith5Repeat4 `hasNoType` ''Int) , $(inspectTest $ 'zipWith5Repeat5 `hasNoType` ''Int) , $(inspectTest $ 'zipWith6Repeat1 `hasNoType` ''Int) , $(inspectTest $ 'zipWith6Repeat2 `hasNoType` ''Int) , $(inspectTest $ 'zipWith6Repeat3 `hasNoType` ''Int) , $(inspectTest $ 'zipWith6Repeat4 `hasNoType` ''Int) , $(inspectTest $ 'zipWith6Repeat5 `hasNoType` ''Int) , $(inspectTest $ 'zipWith6Repeat6 `hasNoType` ''Int) , $(inspectTest $ 'zipWith7Repeat1 `hasNoType` ''Int) , $(inspectTest $ 'zipWith7Repeat2 `hasNoType` ''Int) , $(inspectTest $ 'zipWith7Repeat3 `hasNoType` ''Int) , $(inspectTest $ 'zipWith7Repeat4 `hasNoType` ''Int) , $(inspectTest $ 'zipWith7Repeat5 `hasNoType` ''Int) , $(inspectTest $ 'zipWith7Repeat6 `hasNoType` ''Int) , $(inspectTest $ 'zipWith7Repeat7 `hasNoType` ''Int) ] invertResult :: TestTree -> TestTree invertResult = wrapTest (fmap change) where change r | resultSuccessful r = r { resultOutcome = Failure TestFailed, resultShortDescription = "FAIL" } | otherwise = r { resultOutcome = Success, resultShortDescription = "OK", resultDescription = "" } infinite-list-0.1.1/test/Properties.hs0000644000000000000000000005515407346545000016141 0ustar0000000000000000-- | -- Copyright: (c) 2022 Bodigrim -- Licence: BSD3 {-# LANGUAGE PostfixOperators #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-unrecognised-warning-flags #-} {-# OPTIONS_GHC -Wno-x-partial #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# HLINT ignore "Use <$>" #-} {-# HLINT ignore "Monad law, left identity" #-} {-# HLINT ignore "Monad law, right identity" #-} module Main where import Test.QuickCheck.Function import Test.Tasty import Test.Tasty.QuickCheck as QC import Control.Applicative import Control.Monad import Data.Bifunctor import Data.Bits import Data.Either import qualified Data.List as L import Data.List.Infinite (Infinite(..)) import qualified Data.List.Infinite as I import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NE import Data.Maybe import Data.Word (Word32) import Numeric.Natural import Prelude hiding (Applicative(..)) instance Arbitrary a => Arbitrary (Infinite a) where arbitrary = (:<) <$> arbitrary <*> arbitrary shrink = const [] instance Arbitrary a => Arbitrary (NonEmpty a) where arbitrary = (:|) <$> arbitrary <*> arbitrary trim :: Infinite a -> [a] trim = I.take 10 trim1 :: Infinite a -> [a] trim1 = I.take 11 mapMapFusion :: Infinite Int -> Infinite Int mapMapFusion xs = I.map fromIntegral (I.map fromIntegral xs :: Infinite Word) mapEither :: (a -> Either b c) -> [a] -> ([b], [c]) mapEither f = foldr (either (first . (:)) (second . (:)) . f) ([], []) main :: IO () main = defaultMain $ testGroup "All" [ testProperty "head" $ \(Blind (xs :: Infinite Int)) -> I.head xs === L.head (trim xs) , testProperty "tail" $ \(Blind (xs :: Infinite Int)) -> trim (I.tail xs) === L.tail (trim1 xs) , testProperty "uncons" $ \(Blind (xs :: Infinite Int)) -> Just (fmap trim (I.uncons xs)) === L.uncons (trim1 xs) , testProperty "map" $ \(applyFun -> f :: Int -> Word) (Blind (xs :: Infinite Int)) -> trim (I.map f xs) === L.map f (trim xs) , testProperty "fmap" $ \(applyFun -> f :: Int -> Int) (Blind (xs :: Infinite Int)) -> trim (fmap f xs) === fmap f (trim xs) , testProperty "<$" $ \(x :: Word) (Blind (xs :: Infinite Int)) -> trim (x <$ xs) === trim (fmap (const x) xs) , testProperty "pure" $ \(applyFun -> f :: Int -> Word) (x :: Int) -> trim (pure f <*> pure x) === trim (pure (f x)) , testProperty "*>" $ \(Blind (xs :: Infinite Int)) (Blind (ys :: Infinite Word)) -> trim (xs *> ys) === trim ((id <$ xs) <*> ys) , testProperty "<*" $ \(Blind (xs :: Infinite Int)) (Blind (ys :: Infinite Word)) -> trim (xs <* ys) === trim (liftA2 const xs ys) , testProperty ">>= 1" $ \x ((I.cycle .) . applyFun -> k :: Int -> Infinite Word) -> trim (return x >>= k) === trim (k x) , testProperty ">>= 2" $ \(Blind (xs :: Infinite Int)) -> trim (xs >>= return) === trim xs , testProperty ">>= 3" $ \(Blind xs) ((I.cycle .) . applyFun -> k :: Int -> Infinite Word) ((I.cycle .) . applyFun -> h :: Word -> Infinite Char) -> trim (xs >>= (k >=> h)) === trim ((xs >>= k) >>= h) , testProperty ">>" $ \(Blind (xs :: Infinite Int)) (Blind (ys :: Infinite Word)) -> trim (xs >> ys) === trim ys , testProperty "concat" $ \(Blind (xs :: Infinite (NonEmpty Int))) -> trim (I.concat xs) === L.take 10 (L.concatMap NE.toList (I.toList xs)) , testProperty "concatMap" $ \(applyFun -> f :: Int -> NonEmpty Word) (Blind xs) -> trim (I.concatMap f xs) === L.take 10 (L.concatMap (NE.toList . f) (I.toList xs)) , testProperty "intersperse" $ \(x :: Int) (Blind xs) -> I.take 19 (I.intersperse x xs) === L.intersperse x (trim xs) , testProperty "intersperse laziness 1" $ I.head (I.intersperse undefined ('q' :< undefined)) === 'q' , testProperty "intersperse laziness 2" $ I.take 2 (I.intersperse 'w' ('q' :< undefined)) === "qw" , testProperty "intercalate" $ \(x :: NonEmpty Int) (Blind xs) -> I.take (sum (map length (trim xs)) + 9 * length x) (I.intercalate x xs) === L.intercalate (NE.toList x) (trim xs) , testProperty "intercalate laziness 1" $ I.take 3 (I.intercalate undefined ("foo" :< undefined)) === "foo" , testProperty "intercalate laziness 2" $ I.take 6 (I.intercalate (NE.fromList "bar") ("foo" :< undefined)) === "foobar" , testProperty "interleave 1" $ \(Blind (xs :: Infinite Int)) (Blind ys) -> trim (I.map snd (I.filter fst (I.zip (I.cycle (True :| [False])) (I.interleave xs ys)))) === trim xs , testProperty "interleave 2" $ \(Blind (xs :: Infinite Int)) (Blind ys) -> trim (I.map snd (I.filter fst (I.zip (I.cycle (False :| [True])) (I.interleave xs ys)))) === trim ys , testProperty "interleave laziness" $ I.head (I.interleave ('a' :< undefined) undefined) === 'a' , testProperty "transpose []" $ \(fmap getBlind -> xss :: [Infinite Int]) -> not (null xss) ==> trim (I.transpose xss) === L.transpose (map trim xss) , testProperty "transpose NE" $ \(fmap getBlind -> xss :: NonEmpty (Infinite Int)) -> NE.fromList (trim (I.transpose xss)) === NE.transpose (NE.map (NE.fromList . trim) xss) , testProperty "transpose laziness 1" $ I.head (I.transpose ['a' :< undefined, 'b' :< undefined]) === "ab" , testProperty "transpose laziness 2" $ I.head (I.transpose (('a' :< undefined) :| ['b' :< undefined])) === 'a' :| "b" , testProperty "subsequences" $ \(Blind (xs :: Infinite Int)) -> I.take 16 (I.subsequences xs) === L.subsequences (I.take 4 xs) , testProperty "subsequences laziness 1" $ I.head (I.subsequences undefined) === "" , testProperty "subsequences laziness 2" $ I.take 2 (I.subsequences ('q' :< undefined)) === ["", "q"] , testProperty "permutations" $ \(Blind (xs :: Infinite Int)) -> map (I.take 4) (I.take 24 (I.permutations xs)) === L.permutations (I.take 4 xs) , testProperty "permutations laziness" $ I.take 6 (I.map (I.take 3) (I.permutations ('q' :< 'w' :< 'e' :< undefined))) === ["qwe","wqe","ewq","weq","eqw","qew"] , testProperty "... Bool" $ \(x :: Bool) -> trim (x I....) === L.take 10 (L.cycle [x..]) , testProperty "... Int" $ \(x :: Int) -> trim (x I....) === L.take 10 (L.cycle [x..]) , testProperty "... Int maxBound" $ \(NonNegative (x' :: Int)) -> let x = maxBound - x' in trim (x I....) === L.take 10 (L.cycle [x..]) , testProperty "... Word" $ \(x :: Word) -> trim (x I....) === L.take 10 (L.cycle [x..]) , testProperty "... Word maxBound" $ \(NonNegative (x' :: Word)) -> let x = maxBound - x' in trim (x I....) === L.take 10 (L.cycle [x..]) , testProperty "... Integer" $ \(x :: Integer) -> trim (x I....) === L.take 10 (L.cycle [x..]) , testProperty "... Natural" $ \(NonNegative (x' :: Integer)) -> let x = fromInteger x' :: Natural in trim (x I....) === L.take 10 (L.cycle [x..]) , testProperty ".... Bool" $ \(x :: Bool) y -> trim ((x, y) I.....) === L.take 10 (L.cycle [x, y..]) , testProperty ".... Int" $ \(x :: Int) y -> trim ((x, y) I.....) === L.take 10 (L.cycle [x, y..]) .&&. trim ((maxBound + x, y) I.....) === L.take 10 (L.cycle [maxBound + x, y..]) .&&. trim ((x, maxBound + y) I.....) === L.take 10 (L.cycle [x, maxBound + y..]) .&&. trim ((maxBound + x, maxBound + y) I.....) === L.take 10 (L.cycle [maxBound + x, maxBound + y..]) , testProperty ".... Word" $ \(x :: Word) y -> trim ((x, y) I.....) === L.take 10 (L.cycle [x, y..]) .&&. trim ((maxBound + x, y) I.....) === L.take 10 (L.cycle [maxBound + x, y..]) .&&. trim ((x, maxBound + y) I.....) === L.take 10 (L.cycle [x, maxBound + y..]) .&&. trim ((maxBound + x, maxBound + y) I.....) === L.take 10 (L.cycle [maxBound + x, maxBound + y..]) , testProperty ".... Integer" $ \(x :: Integer) y -> trim ((x, y) I.....) === L.take 10 (L.cycle [x, y..]) , testProperty ".... Natural" $ \(NonNegative (x' :: Integer)) (NonNegative (y' :: Integer)) -> let x = fromInteger x' :: Natural in let y = fromInteger y' in trim ((x, y) I.....) === L.take 10 (L.cycle [x, y..]) , testProperty "toList" $ \(Blind (xs :: Infinite Int)) -> L.take 10 (I.toList xs) === trim xs , testProperty "scanl" $ \(curry . applyFun -> f :: Word -> Int -> Word) s (Blind xs) -> trim1 (I.scanl f s xs) === L.scanl f s (trim xs) , testProperty "scanl laziness" $ I.head (I.scanl undefined 'q' undefined) === 'q' , testProperty "scanl'" $ \(curry . applyFun -> f :: Word -> Int -> Word) s (Blind xs) -> trim1 (I.scanl' f s xs) === L.scanl' f s (trim xs) , testProperty "scanl' laziness" $ I.head (I.scanl' undefined 'q' undefined) === 'q' , testProperty "scanl1" $ \(curry . applyFun -> f :: Int -> Int -> Int) (Blind xs) -> trim (I.scanl1 f xs) === L.scanl1 f (trim xs) , testProperty "scanl1 laziness" $ I.head (I.scanl1 undefined ('q' :< undefined)) === 'q' , testProperty "mapAccumL" $ \(curry . applyFun -> f :: Bool -> Int -> (Bool, Word)) (Blind xs) -> trim (I.mapAccumL f False xs) === snd (L.mapAccumL f False (trim xs)) , testProperty "mapAccumL laziness" $ I.head (I.mapAccumL (\_ x -> (undefined, x)) undefined ('q' :< undefined)) === 'q' , testProperty "iterate" $ \(applyFun -> f :: Int -> Int) s -> trim (I.iterate f s) === L.take 10 (L.iterate f s) , testProperty "iterate laziness" $ I.head (I.iterate undefined 'q') === 'q' , testProperty "iterate'" $ \(applyFun -> f :: Int -> Int) s -> trim (I.iterate' f s) === L.take 10 (L.iterate f s) , testProperty "iterate' laziness" $ I.head (I.iterate' undefined 'q') === 'q' , testProperty "repeat" $ \(s :: Int) -> trim (I.repeat s) === L.replicate 10 s , testProperty "cycle" $ \(xs :: NonEmpty Int) -> trim (I.cycle xs) === L.take 10 (L.cycle (NE.toList xs)) , testProperty "cycle laziness" $ I.head (I.cycle ('q' :| undefined)) === 'q' , testProperty "unfoldr" $ \(applyFun -> f :: Word -> (Int, Word)) s -> trim (I.unfoldr f s) === L.take 10 (L.unfoldr (Just . f) s) , testProperty "unfoldr laziness" $ I.head (I.unfoldr (, undefined) 'q') === 'q' , testProperty "take" $ \n (Blind (xs :: Infinite Int)) -> L.take 10 (I.take n xs) === L.take n (trim xs) , testProperty "take laziness 1" $ I.take 0 undefined === "" , testProperty "take laziness 2" $ I.take 1 ('q' :< undefined) === "q" , testProperty "drop" $ \n (Blind (xs :: Infinite Int)) -> trim (I.drop n xs) === L.drop n (I.take (max n 0 + 10) xs) , testProperty "drop laziness" $ I.head (I.drop 0 ('q' :< undefined)) === 'q' , testProperty "splitAt" $ \n (Blind (xs :: Infinite Int)) -> bimap (L.take 10) trim (I.splitAt n xs) === first (L.take 10) (L.splitAt n (I.take (max n 0 + 10) xs)) , testProperty "splitAt laziness 1" $ fst (I.splitAt 0 undefined) === "" , testProperty "splitAt laziness 2" $ fst (I.splitAt 1 ('q' :< undefined)) === "q" , testProperty "takeWhile" $ \(applyFun -> f :: Ordering -> Bool) (Blind xs) -> L.take 10 (L.takeWhile f (I.foldr (:) xs)) === L.take 10 (I.takeWhile f xs) , testProperty "takeWhile laziness 1" $ L.null (I.takeWhile (const False) ('q' :< undefined)) , testProperty "takeWhile laziness 2" $ L.head (I.takeWhile (const True) ('q' :< undefined)) === 'q' , testProperty "fst . span" $ \(applyFun -> f :: Ordering -> Bool) (Blind xs) -> let ys = L.take 10 (fst (I.span f xs)) in L.take 10 (L.takeWhile f (I.take (length ys + 10) xs)) === L.take 10 (fst (I.span f xs)) , testProperty "fst . break" $ \(applyFun -> f :: Ordering -> Bool) (Blind xs) -> let ys = L.take 10 (fst (I.break f xs)) in L.take 10 (L.takeWhile (not . f) (I.take (length ys + 10) xs)) === L.take 10 (fst (I.break f xs)) , testProperty "dropWhile" $ \(applyFun -> f :: Ordering -> Bool) (Blind xs) -> trim (L.foldr (:<) (I.dropWhile f xs) (I.takeWhile f xs)) === trim xs , testProperty "snd . span" $ \(applyFun -> f :: Ordering -> Bool) (Blind xs) -> trim (L.foldr (:<) (snd (I.span f xs)) (I.takeWhile f xs)) === trim xs , testProperty "snd . break" $ \(applyFun -> f :: Ordering -> Bool) (Blind xs) -> trim (L.foldr (:<) (snd (I.break f xs)) (I.takeWhile (not . f) xs)) === trim xs , testProperty "span laziness" $ L.head (fst (I.span (/= '\n') ('q' :< undefined))) === 'q' , testProperty "break laziness" $ L.head (fst (I.break (== '\n') ('q' :< undefined))) === 'q' , testProperty "stripPrefix" $ \(xs :: [Int]) (Blind (ys :: Infinite Int)) -> fmap trim (I.stripPrefix xs ys) === fmap (L.take 10) (L.stripPrefix xs (I.take (length xs + 10) ys)) , testProperty "stripPrefix laziness 1" $ isNothing (I.stripPrefix ('q' : undefined) ('w' :< undefined)) , testProperty "stripPrefix laziness 2" $ isJust (I.stripPrefix "foo" ('f' :< 'o' :< 'o' :< undefined)) , testProperty "isPrefixOf" $ \(xs :: [Int]) (Blind (ys :: Infinite Int)) -> I.isPrefixOf xs ys === L.isPrefixOf xs (I.take (length xs + 10) ys) , testProperty "isPrefixOf laziness 1" $ I.isPrefixOf "" undefined , testProperty "isPrefixOf laziness 2" $ not (I.isPrefixOf ('q' : undefined) ('w' :< undefined)) , testProperty "isPrefixOf laziness 3" $ I.isPrefixOf "foo" ('f' :< 'o' :< 'o' :< undefined) , testProperty "zip" $ \(Blind (xs1 :: Infinite Int)) (Blind (xs2 :: Infinite Word)) -> trim (I.zip xs1 xs2) === L.zip (trim xs1) (trim xs2) , testProperty "zip3" $ \(Blind (xs1 :: Infinite Int)) (Blind (xs2 :: Infinite Word)) (Blind (xs3 :: Infinite Bool)) -> trim (I.zip3 xs1 xs2 xs3) === L.zip3 (trim xs1) (trim xs2) (trim xs3) , testProperty "zip4" $ \(Blind (xs1 :: Infinite Int)) (Blind (xs2 :: Infinite Word)) (Blind (xs3 :: Infinite Bool)) (Blind (xs4 :: Infinite Char)) -> trim (I.zip4 xs1 xs2 xs3 xs4) === L.zip4 (trim xs1) (trim xs2) (trim xs3) (trim xs4) , testProperty "zip5" $ \(Blind (xs1 :: Infinite Int)) (Blind (xs2 :: Infinite Word)) (Blind (xs3 :: Infinite Bool)) (Blind (xs4 :: Infinite Char)) (Blind (xs5 :: Infinite Ordering)) -> trim (I.zip5 xs1 xs2 xs3 xs4 xs5) === L.zip5 (trim xs1) (trim xs2) (trim xs3) (trim xs4) (trim xs5) , testProperty "zip6" $ \(Blind (xs1 :: Infinite Int)) (Blind (xs2 :: Infinite Word)) (Blind (xs3 :: Infinite Bool)) (Blind (xs4 :: Infinite Char)) (Blind (xs5 :: Infinite Ordering)) (Blind (xs6 :: Infinite String)) -> trim (I.zip6 xs1 xs2 xs3 xs4 xs5 xs6) === L.zip6 (trim xs1) (trim xs2) (trim xs3) (trim xs4) (trim xs5) (trim xs6) , testProperty "zip7" $ \(Blind (xs1 :: Infinite Int)) (Blind (xs2 :: Infinite Word)) (Blind (xs3 :: Infinite Bool)) (Blind (xs4 :: Infinite Char)) (Blind (xs5 :: Infinite Ordering)) (Blind (xs6 :: Infinite String)) (Blind (xs7 :: Infinite Integer)) -> trim (I.zip7 xs1 xs2 xs3 xs4 xs5 xs6 xs7) === L.zip7 (trim xs1) (trim xs2) (trim xs3) (trim xs4) (trim xs5) (trim xs6) (trim xs7) , testProperty "unzip" $ \(Blind (xs :: Infinite (Int, Word))) -> bimap trim trim (I.unzip xs) === L.unzip (trim xs) , testProperty "unzip3" $ \(Blind (xs :: Infinite (Int, Word, Bool))) -> (\(xs1, xs2, xs3) -> (trim xs1, trim xs2, trim xs3)) (I.unzip3 xs) === L.unzip3 (trim xs) , testProperty "unzip4" $ \(Blind (xs :: Infinite (Int, Word, Bool, Char))) -> (\(xs1, xs2, xs3, xs4) -> (trim xs1, trim xs2, trim xs3, trim xs4)) (I.unzip4 xs) === L.unzip4 (trim xs) , testProperty "unzip5" $ \(Blind (xs :: Infinite (Int, Word, Bool, Char, Ordering))) -> (\(xs1, xs2, xs3, xs4, xs5) -> (trim xs1, trim xs2, trim xs3, trim xs4, trim xs5)) (I.unzip5 xs) === L.unzip5 (trim xs) , testProperty "unzip6" $ \(Blind (xs :: Infinite (Int, Word, Bool, Char, Ordering, String))) -> (\(xs1, xs2, xs3, xs4, xs5, xs6) -> (trim xs1, trim xs2, trim xs3, trim xs4, trim xs5, trim xs6)) (I.unzip6 xs) === L.unzip6 (trim xs) , testProperty "unzip7" $ \(Blind (xs :: Infinite (Int, Word, Bool, Char, Ordering, String, Integer))) -> (\(xs1, xs2, xs3, xs4, xs5, xs6, xs7) -> (trim xs1, trim xs2, trim xs3, trim xs4, trim xs5, trim xs6, trim xs7)) (I.unzip7 xs) === L.unzip7 (trim xs) , testProperty "lines" $ \(Blind (xs :: Infinite Char)) -> I.take 3 (I.lines xs) === L.take 3 (L.lines (I.foldr (:) xs)) , testProperty "lines laziness 1" $ L.head (I.head (I.lines ('q' :< undefined))) === 'q' , testProperty "lines laziness 2" $ L.null (I.head (I.lines ('\n' :< undefined))) , testProperty "words" $ \(Blind (xs :: Infinite Char)) -> I.take 3 (I.map NE.toList (I.words xs)) === L.take 3 (L.words (I.foldr (:) xs)) , testProperty "words laziness" $ NE.head (I.head (I.words ('q' :< undefined))) === 'q' , testProperty "unlines" $ \(Blind (xs :: Infinite [Char])) -> trim (I.unlines xs) === L.take 10 (L.unlines (trim xs)) , testProperty "unlines laziness" $ I.take 2 (I.unlines ("q" :< undefined)) === "q\n" , testProperty "unwords" $ \(Blind (xs :: Infinite (NonEmpty Char))) -> trim (I.unwords xs) === L.take 10 (L.unwords (L.map NE.toList (I.foldr (:) xs))) , testProperty "unwords laziness" $ I.take 2 (I.unwords (('q' :| []) :< undefined)) === "q " , testProperty "unlines . lines" $ \(Blind (xs :: Infinite Char)) -> I.take 100 xs === I.take 100 (I.unlines (I.lines xs)) , testProperty "group" $ \(Blind (ys :: Infinite Ordering)) -> trim (I.group ys) === L.take 10 (NE.group (I.foldr (:) ys)) , testProperty "groupBy" $ \(curry . applyFun -> f :: Ordering -> Ordering -> Bool) (Blind ys) -> all (\x -> not $ all (f x) [minBound..maxBound]) [minBound..maxBound] ==> trim (I.groupBy f ys) === L.take 10 (NE.groupBy f (I.foldr (:) ys)) , testProperty "group laziness" $ NE.head (I.head (I.group ('q' :< undefined))) === 'q' , testProperty "nub" $ \(Blind (ys :: Infinite (Large Int))) -> fmap getLarge (I.take 3 (I.nub ys)) === fmap getLarge (L.take 3 (L.nub (I.foldr (:) ys))) , testProperty "nub laziness" $ I.head (I.nub ('q' :< undefined)) === 'q' , testProperty "delete" $ \(x :: Ordering) (Blind xs) -> trim (I.delete x xs) === L.take 10 (L.delete x (I.foldr (:) xs)) , testProperty "delete laziness" $ I.head (I.delete 'q' ('w' :< undefined)) === 'w' , testProperty "insert" $ \(x :: Int) (Blind xs) -> trim (I.insert x xs) === L.take 10 (L.insert x (I.foldr (:) xs)) , testProperty "insert laziness" $ I.take 2 (I.insert 'q' ('w' :< undefined)) === "qw" , testProperty "\\\\" $ \(Blind (xs :: Infinite Ordering)) ys -> trim (xs I.\\ ys) === L.take 10 (I.foldr (:) xs L.\\ ys) , testProperty "\\\\ laziness" $ I.head (('q' :< undefined) I.\\ []) === 'q' , testProperty "union" $ \xs (Blind (ys :: Infinite Ordering)) -> I.take 3 (I.union xs ys) === L.take 3 (xs `L.union` I.foldr (:) ys) , testProperty "union laziness" $ I.head (I.union ('q' : undefined) undefined) === 'q' , testProperty "intersect" $ \(Blind (xs :: Infinite Ordering)) ys -> not (null ys) ==> I.head (I.intersect xs ys) === L.head (I.foldr (:) xs `L.intersect` ys) , testProperty "intersect laziness" $ I.head (I.intersect ('q' :< undefined) ('q' : undefined)) === 'q' , testProperty "inits" $ \(Blind (xs :: Infinite Int)) -> I.take 21 (I.inits xs) === L.inits (I.take 20 xs) , testProperty "inits laziness 1" $ L.null (I.head (I.inits undefined)) , testProperty "inits laziness 2" $ I.take 2 (I.inits ('q' :< undefined)) === ["", "q"] , testProperty "inits1" $ \(Blind (xs :: Infinite Int)) -> map NE.toList (trim (I.inits1 xs)) === L.tail (L.inits (trim xs)) , testProperty "tails" $ \(Blind (xs :: Infinite Int)) -> map trim (trim (I.tails xs)) === map (L.take 10) (L.take 10 (L.tails (I.take 20 xs))) , testProperty "tails laziness" $ I.head (I.head (I.tails ('q' :< undefined))) === 'q' , testProperty "lookup" $ \(xs :: [(Int, Word)]) y zs -> let pairs = NE.fromList (xs ++ (y : zs)) in Just (I.lookup (fst y) (I.cycle pairs)) === L.lookup (fst y) (NE.toList pairs) , testProperty "lookup laziness" $ I.lookup True ((True, 'q') :< undefined) === 'q' , testProperty "find" $ \(xs :: [(Int, Word)]) y zs -> let pairs = NE.fromList (xs ++ (y : zs)) in Just (I.find ((== snd y) . snd) (I.cycle pairs)) === L.find ((== snd y) . snd) (NE.toList pairs) , testProperty "find laziness" $ I.find odd (1 :< undefined) === (1 :: Int) , testProperty "filter" $ \(applyFun -> f :: Int -> Bool) xs (Blind ys) -> let us = L.filter f xs in us === I.take (length us) (I.filter f (I.prependList xs ys)) , testProperty "mapMaybe" $ \(applyFun -> f :: Int -> Maybe Word) xs (Blind ys) -> let us = mapMaybe f xs in us === I.take (length us) (I.mapMaybe f (I.prependList xs ys)) , testProperty "catMaybes" $ \(xs :: [Maybe Word]) (Blind ys) -> let us = catMaybes xs in us === I.take (length us) (I.catMaybes (I.prependList xs ys)) , testProperty "partition" $ \(applyFun -> f :: Int -> Bool) xs (Blind ys) -> let (us, vs) = L.partition f xs in let (us', vs') = I.partition f (I.prependList xs ys) in us === I.take (length us) us' .&&. vs === I.take (length vs) vs' , testProperty "mapEither" $ \(applyFun -> f :: Int -> Either Word Char) xs (Blind ys) -> let (us, vs) = mapEither f xs in let (us', vs') = I.mapEither f (I.prependList xs ys) in us === I.take (length us) us' .&&. vs === I.take (length vs) vs' , testProperty "partitionEithers" $ \(xs :: [Either Word Char]) (Blind ys) -> let (us, vs) = partitionEithers xs in let (us', vs') = I.partitionEithers (I.prependList xs ys) in us === I.take (length us) us' .&&. vs === I.take (length vs) vs' , testProperty "!!" $ \(Blind (xs :: Infinite Int)) n -> xs I.!! n === I.foldr (:) xs L.!! fromIntegral n , testProperty "tabulate" $ \(applyFun -> f :: Word -> Char) n -> I.tabulate f I.!! n === f n , testProperty "elemIndex" $ \xs (x :: Int) (Blind ys) -> let zs = I.prependList xs (x :< ys) in Just (fromIntegral (I.elemIndex x zs)) === L.elemIndex x (I.foldr (:) zs) , testProperty "elemIndices" $ \xs (x :: Ordering) (Blind ys) -> let zs = I.prependList xs (x :< ys) in let is = L.elemIndices x (xs ++ [x]) in map fromIntegral (I.take (length is) (I.elemIndices x zs)) === is , testProperty ">>= 32bit" $ let ix = maxBound :: Word32 in finiteBitSize (0 :: Word) /= 32 || I.head (I.tail (I.genericDrop ix (I.repeat () >>= const (False :< I.repeat True)))) ]