packages feed

infinite-list (empty) → 0.1

raw patch · 10 files changed

+2460/−0 lines, 10 filesdep +QuickCheckdep +basedep +ghc-prim

Dependencies added: QuickCheck, base, ghc-prim, infinite-list, tasty, tasty-bench, tasty-expected-failure, tasty-inspection-testing, tasty-quickcheck

Files

+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# 0.1++* Initial release.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (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.
+ README.md view
@@ -0,0 +1,66 @@+# 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.
+ bench/Bench.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE PostfixOperators #-}++module Main where++-- import qualified Data.List.Infinite as Inf+import Test.Tasty.Bench++main :: IO ()+main = defaultMain+  [+  ]
+ infinite-list.cabal view
@@ -0,0 +1,93 @@+cabal-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
+ src/Data/List/Infinite.hs view
@@ -0,0 +1,1099 @@+{-# 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+-- <https://hackage.haskell.org/package/adjunctions/docs/Data-Functor-Rep.html#t:Representable Representable>,+-- 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+-- <https://hackage.haskell.org/package/distributive/docs/Data-Distributive.html#t:Distributive 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 (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+-- <https://hackage.haskell.org/package/adjunctions/docs/Data-Functor-Rep.html#t:Representable 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++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+-- <https://hackage.haskell.org/package/adjunctions/docs/Data-Functor-Rep.html#t:Representable Representable>+-- 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 (:<))
+ src/Data/List/Infinite/Internal.hs view
@@ -0,0 +1,18 @@+{-# 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 #-}
+ src/Data/List/Infinite/Zip.hs view
@@ -0,0 +1,336 @@+-- |+-- 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+  #-}
+ test/Fusion.hs view
@@ -0,0 +1,332 @@+-- |+-- 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 = "" }
+ test/Properties.hs view
@@ -0,0 +1,472 @@+-- |+-- 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+  ]