infinite-list-0.1/0000755000000000000000000000000007346545000012321 5ustar0000000000000000infinite-list-0.1/CHANGELOG.md0000644000000000000000000000003207346545000014125 0ustar0000000000000000# 0.1 * Initial release. infinite-list-0.1/LICENSE0000644000000000000000000000275207346545000013334 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/README.md0000644000000000000000000001052707346545000013605 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 ``` 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/bench/0000755000000000000000000000000007346545000013400 5ustar0000000000000000infinite-list-0.1/bench/Bench.hs0000644000000000000000000000024607346545000014755 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/infinite-list.cabal0000644000000000000000000000451707346545000016072 0ustar0000000000000000cabal-version: 1.18 name: infinite-list version: 0.1 license: BSD3 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.5 ghc ==9.4.3 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 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-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 infinite-list-0.1/src/Data/List/0000755000000000000000000000000007346545000014674 5ustar0000000000000000infinite-list-0.1/src/Data/List/Infinite.hs0000644000000000000000000007641707346545000017014 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# 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 lookup, find, filter, partition, -- * 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.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.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 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) 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) #-} -- | Convert to a list. Use 'cycle' to go in another 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 infinite sequences, 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] (...) :: Enum a => a -> Infinite a (...) = unsafeCycle . enumFrom {-# INLINE [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 infinite sequences, 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] (....) :: Enum a => (a, a) -> Infinite a (....) = unsafeCycle . uncurry enumFromThen {-# INLINE [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 -- , -- can. Namely, 'Control.Monad.join' -- picks up a diagonal of an infinite matrix of 'Infinite' ('Infinite' @a@). -- This is mostly useful for parallel list comprehensions once -- @{\-# LANGUAGE MonadComprehensions #-\}@ is enabled. instance Monad Infinite where xs >>= f = go 0 xs where go n (y :< ys) = f y !! n :< go (n + 1) ys (>>) = (*>) -- | 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. 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'. 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. 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 -- -- 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 (x :< xs) = (x :| []) :< foldr f (subsequences1 xs) 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 -- | -- > 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 = go where go z ~(x :< xs) = z :< go (f z x) xs 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 = go where go !z ~(x :< xs) = z :< go (f z x) xs 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) #-} -- | -- > 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 -- | If you are looking how to traverse with a state, look no further: -- -- > mapAccumL f acc0 (x1 :< x2 :< ...) = -- > let (acc1, y1) = f acc0 x1 in -- > let (acc2, y2) = f acc1 x2 in -- > ... -- > y1 :< y2 :< ... mapAccumL :: (acc -> x -> (acc, y)) -> acc -> Infinite x -> Infinite y mapAccumL f = go where go s (x :< xs) = y :< go s' xs where (s', y) = f s x 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. 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. 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 -- . 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 takeFB :: (elt -> lst -> lst) -> lst -> elt -> (Int -> lst) -> Int -> lst takeFB cons nil x xs = \m -> if m <= 1 then x `cons` nil else x `cons` xs (m - 1) {-# INLINE [1] take #-} {-# INLINE [0] takeFB #-} {-# RULES "take" [~1] forall n xs. take n xs = GHC.Exts.build ( \cons nil -> if n >= 1 then foldr (takeFB cons nil) xs n else nil ) "takeList" [1] forall n xs. foldr (takeFB (:) []) xs n = take n xs #-} -- | Take a prefix of given length. genericTake :: Integral i => i -> Infinite a -> [a] genericTake n | n < 1 = const [] | otherwise = unsafeTake n where unsafeTake 1 (x :< _) = [x] unsafeTake m (x :< xs) = x : unsafeTake (m - 1) xs -- | Drop a prefix of given length. drop :: Int -> Infinite a -> Infinite a drop = GHC.Exts.inline genericDrop dropFB :: (elt -> lst -> lst) -> elt -> (Int -> lst) -> Int -> lst dropFB cons x xs = \m -> if m < 1 then x `cons` xs m else xs (m - 1) {-# INLINE [1] drop #-} {-# INLINE [0] dropFB #-} {-# RULES "drop" [~1] forall n xs. drop n xs = build ( \cons -> if n >= 1 then foldr (dropFB cons) xs n else foldr cons xs ) "dropList" [1] forall n xs. foldr (dropFB (:<)) xs n = drop n xs #-} -- | Drop a prefix of given length. genericDrop :: Integral i => i -> Infinite a -> Infinite a genericDrop n | n < 1 = id | otherwise = unsafeDrop n where unsafeDrop 1 (_ :< xs) = xs unsafeDrop m (_ :< xs) = unsafeDrop (m - 1) xs -- | 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 = unsafeSplitAt n where unsafeSplitAt 1 (x :< xs) = ([x], xs) unsafeSplitAt m (x :< xs) = first (x :) (unsafeSplitAt (m - 1) xs) -- | Take the longest prefix satisfying a predicate. takeWhile :: (a -> Bool) -> Infinite a -> [a] takeWhile p = go where go (x :< xs) | p x = x : go xs | otherwise = [] 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 = go where go xxs@(x :< xs) | p x = go xs | otherwise = xxs dropWhileFB :: (elt -> Bool) -> (elt -> lst -> lst) -> elt -> (Bool -> lst) -> (Bool -> lst) dropWhileFB p cons = \x r drp -> if drp && p x then r True else x `cons` r False {-# NOINLINE [1] dropWhile #-} {-# INLINE [0] dropWhileFB #-} {-# RULES "dropWhile" [~1] forall p xs. dropWhile p xs = build (\cons -> foldr (dropWhileFB p cons) xs True) "dropWhileList" [1] forall p xs. foldr (dropWhileFB p (:<)) xs True = dropWhile p 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 = go where go xxs@(x :< xs) | p x = first (x :) (go xs) | otherwise = ([], xxs) -- | 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 [] ys = Just ys stripPrefix (x : xs) (y :< ys) | x == y = stripPrefix xs 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) 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 [] _ = True isPrefixOf (x : xs) (y :< ys) | x == y = isPrefixOf xs ys | otherwise = False -- | 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. 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 -- -- type class in disguise. (!!) :: Infinite a -> Word -> a (!!) = flip go where go 0 (x :< _) = x go !m (_ :< ys) = go (m - 1) ys 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 = go 0 where go !n (x :< xs) | f x = n | otherwise = go (n + 1) xs -- | 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 = go 0 where go !n (x :< xs) = (if f x then (n :<) else id) (go (n + 1) xs) -- | 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@. lines :: Infinite Char -> Infinite [Char] lines xs = l :< lines xs' where (l, ~(_ :< xs')) = break (== '\n') xs -- | Concatenate lines together with @\\n@. unlines :: Infinite [Char] -> Infinite Char unlines = foldr (\l xs -> l `prependList` ('\n' :< xs)) -- | Split an infinite string into words, by any 'isSpace' symbol. words :: Infinite Char -> Infinite (NonEmpty Char) words xs = (u :| us) :< words vs where u :< ys = dropWhile isSpace xs (us, vs) = break isSpace ys wordsFB :: (NonEmpty Char -> lst -> lst) -> Infinite Char -> lst wordsFB cons = go where go xs = (u :| us) `cons` go vs where u :< ys = dropWhile isSpace xs (us, vs) = break isSpace ys {-# 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. 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 = go [] where go seen (x :< xs) | elemBy x seen = go seen xs | otherwise = x :< go (x : seen) xs elemBy _ [] = False elemBy y (x : xs) = eq x y || elemBy y xs -- | 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 = go where go (y :< ys) | eq x y = ys | otherwise = y :< go ys -- | 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 = go where go yys@(y :< ys) = case cmp x y of GT -> y :< go ys _ -> x :< yys -- | 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 (:<)) infinite-list-0.1/src/Data/List/Infinite/0000755000000000000000000000000007346545000016441 5ustar0000000000000000infinite-list-0.1/src/Data/List/Infinite/Internal.hs0000644000000000000000000000053007346545000020547 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} -- | -- Copyright: (c) 2022 Bodigrim -- License: BSD3 module Data.List.Infinite.Internal ( Infinite (..), build, ) where -- | Type of infinite lists. 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/src/Data/List/Infinite/Zip.hs0000644000000000000000000004165607346545000017553 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/test/0000755000000000000000000000000007346545000013300 5ustar0000000000000000infinite-list-0.1/test/Fusion.hs0000644000000000000000000003416607346545000015111 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) takeDropRepeat :: Int -> [Int] takeDropRepeat x = I.take x (I.drop x (I.repeat x)) takeWhileIterate :: Int -> [Int] takeWhileIterate x = I.takeWhile (< 10) (I.iterate (+ 1) x) takeWhileDropWhileIterate :: Int -> [Int] takeWhileDropWhileIterate x = I.takeWhile (< 20) $ I.dropWhile (< 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 $ 'takeDropRepeat `hasNoType` ''Infinite) , $(inspectTest $ 'takeWhileIterate `hasNoType` ''Infinite) , $(inspectTest $ 'takeWhileDropWhileIterate `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/test/Properties.hs0000644000000000000000000005110107346545000015766 0ustar0000000000000000-- | -- Copyright: (c) 2022 Bodigrim -- Licence: BSD3 {-# LANGUAGE PostfixOperators #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# 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 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 Numeric.Natural 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) 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 "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) -> let ys = L.take 10 (I.takeWhile f xs) in L.take 10 (L.takeWhile f (I.take (length ys + 10) 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" $ not (I.isPrefixOf ('q' : undefined) ('w' :< undefined)) , testProperty "isPrefixOf laziness 2" $ 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 (trim xs))) , testProperty "unwords laziness" $ I.take 2 (I.unwords (('q' :| []) :< undefined)) == "q " , testProperty "group" $ \(Blind (ys :: Infinite Ordering)) -> trim (I.group ys) == L.take 10 (NE.group (I.foldr (:) ys)) , testProperty "group laziness" $ NE.head (I.head (I.group ('q' :< undefined))) == 'q' , testProperty "nub" $ \(Blind (ys :: Infinite (Large Int))) -> I.take 3 (I.nub ys) == 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 "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 "!!" $ \(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 ]