streams 3.0.0.1 → 3.0.1

raw patch · 15 files changed

+1901/−1911 lines, 15 filesdep ~basedep ~comonaddep ~distributive

Dependency ranges changed: base, comonad, distributive, semigroupoids, semigroups

Files

• .travis.yml +7/−0
• Data/Stream/Future.hs +0/−148
• Data/Stream/Future/Skew.hs +0/−426
• Data/Stream/Infinite.hs +0/−455
• Data/Stream/Infinite/Functional/Zipper.hs +0/−334
• Data/Stream/Infinite/Skew.hs +0/−348
• Data/Stream/Supply.hs +0/−174
• README +1/−1
• src/Data/Stream/Future.hs +148/−0
• src/Data/Stream/Future/Skew.hs +426/−0
• src/Data/Stream/Infinite.hs +455/−0
• src/Data/Stream/Infinite/Functional/Zipper.hs +334/−0
• src/Data/Stream/Infinite/Skew.hs +348/−0
• src/Data/Stream/Supply.hs +174/−0
• streams.cabal +8/−25

@@ -1,1 +1,8 @@ language: haskell+notifications:+  irc:+    channels:+      - "irc.freenode.org#haskell-lens"+    skip_join: true+    template:+      - "\x0313streams\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"

@@ -1,148 +0,0 @@-{-# LANGUAGE BangPatterns #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Stream.Future--- Copyright   :  (C) 2011 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  portable----------------------------------------------------------------------------------module Data.Stream.Future-  ( Future(..)-  , cons, (<|)-  , head-  , tail-  , length-  , tails-  , map-  , index-  ) where--import Prelude hiding (head, tail, map, length)-import Control.Applicative-import Control.Comonad-import Data.Foldable-import Data.Functor.Alt-import Data.Functor.Extend-import Data.Traversable-import Data.Semigroup hiding (Last)-import Data.Semigroup.Foldable-import Data.Semigroup.Traversable-#ifdef LANGUAGE_DeriveDataTypeable-import Data.Data-#endif--infixr 5 :<, <|--data Future a = Last a | a :< Future a deriving-  ( Eq, Ord, Show, Read-#ifdef LANGUAGE_DeriveDataTypeable-  , Data, Typeable-#endif-  )--(<|) :: a -> Future a -> Future a-(<|) = (:<)-{-# INLINE (<|) #-}--cons :: a -> Future a -> Future a-cons = (:<)-{-# INLINE cons #-}--head :: Future a -> a-head (Last a) = a-head (a :< _) = a-{-# INLINE head #-}--length :: Future a -> Int-length = go 1-  where-    go !n (Last _)  = n-    go !n (_ :< as) = go (n + 1) as-{-# INLINE length #-}--tail :: Future a -> Maybe (Future a)-tail (Last _) = Nothing-tail (_ :< as) = Just as-{-# INLINE tail #-}--tails :: Future a -> Future (Future a)-tails w@(_ :< as) = w :< tails as-tails w@(Last _)  = Last w-{-# INLINE tails #-}--map :: (a -> b) -> Future a -> Future b-map f (a :< as) = f a :< map f as-map f (Last a)  = Last (f a)-{-# INLINE map #-}--index :: Int -> Future a -> a-index n aas-  | n < 0 = error "index: negative index"-  | n == 0 = extract aas-  | otherwise = case aas of-    Last _ -> error "index: out of range"-    _ :< as -> index (n - 1) as--instance Functor Future where-  fmap = map-  b <$ (_ :< as) = b :< (b <$ as)-  b <$ _         = Last b--instance Foldable Future where-  foldMap = foldMapDefault--instance Traversable Future where-  traverse f (Last a)  = Last <$> f a-  traverse f (a :< as) = (:<) <$> f a <*> traverse f as--instance Foldable1 Future--instance Traversable1 Future where-  traverse1 f (Last a)  = Last <$> f a-  traverse1 f (a :< as) = (:<) <$> f a <.> traverse1 f as--instance Extend Future where-  extended = extend--instance Comonad Future where-  extract = head-  duplicate = tails-  extend f w@(_ :< as) = f w :< extend f as-  extend f w@(Last _)  = Last (f w)--instance Apply Future where-  Last f    <.> Last a    = Last (f a)-  (f :< _)  <.> Last a    = Last (f a)-  Last f    <.> (a :< _ ) = Last (f a)-  (f :< fs) <.> (a :< as) = f a :< (fs <.> as)--  Last a    <. _         = Last a-  (a :< _ ) <. Last _    = Last a-  (a :< as) <. (_ :< bs) = a :< (as <. bs)--  _          .> Last b   = Last b-  Last _     .> (b :< _) = Last b-  (_ :< as)  .> (b :< bs) = b :< (as .> bs)--instance ComonadApply Future where-  (<@>) = (<.>)--instance Alt Future where-  Last a    <!> bs = a :< bs-  (a :< as) <!> bs = a :< (as <!> bs)--instance Semigroup (Future a) where-  (<>) = (<!>)--instance Applicative Future where-  pure = Last-  (<*>) = (<.>)-  (<* ) = (<. )-  ( *>) = ( .>)--

@@ -1,426 +0,0 @@-{-# LANGUAGE PatternGuards, BangPatterns #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Stream.Future.Skew--- Copyright   :  (C) 2008-2011 Edward Kmett,---                (C) 2004 Dave Menendez--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  portable------ Anticausal streams implemented as non-empty skew binary random access lists------ The Applicative zips streams, but since these are potentially infinite--- this is stricter than would be desired. You almost always want----------------------------------------------------------------------------------module Data.Stream.Future.Skew-    ( Future(..)-    , (<|)      -- O(1)-    , cons-    , length    -- O(log n)-    , head      -- O(1)-    , tail      -- O(1)-    , tails-    , last      -- O(log n)-    , uncons    -- O(1)-    , index     -- O(log n)-    , drop      -- O(log n)-    , dropWhile -- O(n)-    , indexed-    , from-    , break-    , span-    , split     -- O(log n)-    , splitW    -- O(log n)-    , repeat-    , replicate -- O(log n)-    , insert    -- O(n)-    , insertBy-    , update-    , adjust    -- O(log n)-    , fromList-    , toFuture-    ) where--import Control.Applicative hiding (empty)-import Control.Comonad-import Data.Functor.Alt-import Data.Functor.Extend-import Data.Foldable hiding (toList)-import Data.Traversable (Traversable, traverse)-import Data.Semigroup hiding (Last)-import Data.Semigroup.Foldable-import Data.Semigroup.Traversable-import Prelude hiding (null, head, tail, drop, dropWhile, length, foldr, last, span, repeat, replicate, break)--infixr 5 :<, <|--data Complete a-    = Tip a-    | Bin {-# UNPACK #-} !Int a !(Complete a) !(Complete a)-    deriving Show--instance Functor Complete where-  fmap f (Tip a) = Tip (f a)-  fmap f (Bin w a l r) = Bin w (f a) (fmap f l) (fmap f r)--instance Extend Complete where-  extended = extend--instance Comonad Complete where-  extend f w@Tip {} = Tip (f w)-  extend f w@(Bin n _ l r) = Bin n (f w) (extend f l) (extend f r)-  extract (Tip a) = a-  extract (Bin _ a _ _) = a--instance Foldable Complete where-  foldMap f (Tip a) = f a-  foldMap f (Bin _ a l r) = f a `mappend` foldMap f l `mappend` foldMap f r-  foldr f z (Tip a) = f a z-  foldr f z (Bin _ a l r) = f a (foldr f (foldr f z r) l)--instance Foldable1 Complete where-  foldMap1 f (Tip a) = f a-  foldMap1 f (Bin _ a l r) = f a <> foldMap1 f l <> foldMap1 f r--instance Traversable Complete where-  traverse f (Tip a) = Tip <$> f a-  traverse f (Bin n a l r) = Bin n <$> f a <*> traverse f l <*> traverse f r--instance Traversable1 Complete where-  traverse1 f (Tip a) = Tip <$> f a-  traverse1 f (Bin n a l r) = Bin n <$> f a <.> traverse1 f l <.> traverse1 f r--bin :: a -> Complete a -> Complete a -> Complete a-bin a l r = Bin (1 + weight l + weight r) a l r-{-# INLINE bin #-}--weight :: Complete a -> Int-weight Tip{} = 1-weight (Bin w _ _ _) = w-{-# INLINE weight #-}---- A future is a non-empty skew binary random access list of nodes.--- The last node, however, is allowed to contain fewer values.-data Future a-  = Last !(Complete a)-  | !(Complete a) :< Future a---  deriving Show---instance Show a => Show (Future a) where-  showsPrec d as = showParen (d >= 10) $-    showString "fromList " . showsPrec 11 (toList as)--instance Functor Future where-  fmap f (t :< ts) = fmap f t :< fmap f ts-  fmap f (Last t) = Last (fmap f t)--instance Extend Future where-  extended = extend--instance Comonad Future where-  extend g (Last t)  = Last (extendTree g t Last)-  extend g (t :< ts) = extendTree g t (:< ts) :< extend g ts-  extract = head--extendTree :: (Future a -> b) -> Complete a -> (Complete a -> Future a) -> Complete b-extendTree g w@Tip{}         f = Tip (g (f w))-extendTree g w@(Bin n _ l r) f = Bin n (g (f w)) (extendTree g l (:< f r))  (extendTree g r f)--instance Apply Future where-  Last (Tip f)         <.> as                   = singleton (f (extract as))-  fs                   <.> Last (Tip a)         = singleton (extract fs a)-  Last (Bin _ f lf rf) <.> Last (Bin _ a la ra) = f a <| (lf :< Last rf  <.> la :< Last ra )-  Last (Bin _ f lf rf) <.> Bin _ a la ra :< as  = f a <| (lf :< Last rf  <.> la :< ra :< as)-  Last (Bin _ f lf rf) <.> Tip a :< as          = f a <| (lf :< Last rf  <.> as            )-  Bin _ f lf rf :< fs  <.> Last (Bin _ a la ra) = f a <| (lf :< rf :< fs <.> la :< Last ra )-  Bin _ f lf rf :< fs  <.> Tip a :< as          = f a <| (lf :< rf :< fs <.> as            )-  Bin _ f lf rf :< fs  <.> Bin _ a la ra :< as  = f a <| (lf :< rf :< fs <.> la :< ra :< as)-  Tip f :< fs          <.> Tip a :< as          = f a <| (fs             <.> as            )-  Tip f :< fs          <.> Bin _ a la ra :< as  = f a <| (fs             <.> la :< ra :< as)-  Tip f :< fs          <.> Last (Bin _ a la ra) = f a <| (fs             <.> la :< Last ra )--instance ComonadApply Future where-  (<@>) = (<.>)--instance Applicative Future where-  pure = repeat-  (<*>) = (<.>)--instance Alt Future where-  as <!> bs = foldr (<|) bs as--instance Foldable Future where-  foldMap f (t :< ts) = foldMap f t `mappend` foldMap f ts-  foldMap f (Last t) = foldMap f t-  foldr f z (t :< ts) = foldr f (foldr f z ts) t-  foldr f z (Last t) = foldr f z t--toList :: Future a -> [a]-toList = foldr (:) []--instance Foldable1 Future where-  foldMap1 f (t :< ts) = foldMap1 f t <> foldMap1 f ts-  foldMap1 f (Last t) = foldMap1 f t--instance Traversable Future where-  traverse f (t :< ts) = (:<) <$> traverse f t <*> traverse f ts-  traverse f (Last t) = Last <$> traverse f t--instance Traversable1 Future where-  traverse1 f (t :< ts) = (:<) <$> traverse1 f t <.> traverse1 f ts-  traverse1 f (Last t) = Last <$> traverse1 f t--repeat :: a -> Future a-repeat a0 = go a0 (Tip a0)-    where-      go :: a -> Complete a -> Future a-      go a as | ass <- bin a as as = as :< go a ass-{-# INLINE repeat #-}---- | /O(log n)/-replicate :: Int -> a -> Future a-replicate n a-  | n <= 0    = error "replicate: non-positive argument"-  | otherwise = go 1 n a (Tip a) (\ _ r -> r)-  where-  -- invariants:-  -- tb is a complete tree of i nodes all equal to b-  -- 1 <= i = 2^m-1 <= j-  -- k accepts r such that 0 <= r < i-  go :: Int -> Int -> b -> Complete b -> (Int -> Future b -> r) -> r-  go !i !j b tb k-    | j >= i2p1 = go i2p1 j b (Bin i2p1 b tb tb) k'-    | j >= i2   = k (j - i2) (tb :< Last tb)-    | otherwise = k (j - i) (Last tb)-    where-      i2 = i * 2-      i2p1 = i2 + 1-      k' r xs-        | r >= i2   = k (r - i2) (tb :< tb :< xs)-        | r >= i    = k (r - i) (tb :< xs)-        | otherwise = k r xs-{-# INLINE replicate #-}--mapWithIndex :: (Int -> a -> b) -> Future a -> Future b-mapWithIndex f0 as0 = spine f0 0 as0-  where-    spine f m (Last as) = Last (tree f m as)-    spine f m (a :< as) = tree f m a :< spine f (m + weight a) as-    tree f m (Tip a) = Tip (f m a)-    tree f m (Bin n a l r) = Bin n (f m a) (tree f (m + 1) l) (tree f (m + 1 + weight l) r)--indexed :: Future a -> Future (Int, a)-indexed = mapWithIndex (,)-{-# INLINE indexed #-}--from :: Num a => a -> Future a-from a = mapWithIndex ((+) . fromIntegral) (pure a)-{-# INLINE from #-}---- | /O(1)/-singleton :: a -> Future a-singleton a = Last (Tip a)-{-# INLINE singleton #-}---- | /O(log n)/.-length :: Future a -> Int-length (Last t) = weight t-length (t :< ts) = weight t + length ts---- | /O(1)/ cons-(<|) :: a -> Future a -> Future a-a <| (l :< Last r)-  | weight l == weight r = Last (bin a l r)-a <| (l :< r :< as)-  | weight l == weight r = bin a l r :< as-a <| as = Tip a :< as-{-# INLINE (<|) #-}---cons :: a -> Future a -> Future a-cons = (<|)-{-# INLINE cons #-}---- | /O(1)/-head :: Future a -> a-head (a :< _) = extract a-head (Last a) = extract a-{-# INLINE head #-}---- | /O(1)/.-tail :: Future a -> Maybe (Future a)-tail (Tip{} :< ts) = Just ts-tail (Bin _ _ l r :< ts) = Just (l :< r :< ts)-tail (Last Tip{}) = Nothing-tail (Last (Bin _ _ l r)) = Just (l :< Last r)-{-# INLINE tail #-}--tails :: Future a -> Future (Future a)-tails = duplicate-{-# INLINE tails #-}---- | /O(log n)/.-last :: Future a -> a-last (_ :< as) = last as-last (Last as) = go as-  where go (Tip a) = a-        go (Bin _ _ _ r) = go r---- | /O(1)/.-uncons :: Future a -> (a, Maybe (Future a))-uncons (Last (Tip a))       = (a, Nothing)-uncons (Last (Bin _ a l r)) = (a, Just (l :< Last r))-uncons (Tip a       :< as)  = (a, Just as)-uncons (Bin _ a l r :< as)  = (a, Just (l :< r :< as))-{-# INLINE uncons #-}---- | /O(log n)/.-index :: Int -> Future a -> a-index i (Last t)-  | i < weight t = indexComplete i t-  | otherwise    = error "index: out of range"-index i (t :< ts)-  | i < w     = indexComplete i t-  | otherwise = index (i - w) ts-  where w = weight t--indexComplete :: Int -> Complete a -> a-indexComplete 0 (Tip a) = a-indexComplete i (Bin w a l r)-  | i == 0    = a-  | i <= w'   = indexComplete (i-1) l-  | otherwise = indexComplete (i-1-w') r-  where w' = div w 2-indexComplete _ _ = error "index: index out of range"---- | /O(log n)/.-drop :: Int -> Future a -> Maybe (Future a)-drop 0 ts = Just ts-drop i (t :< ts) = case compare i w of-  LT -> Just (dropComplete i t (:< ts))-  EQ -> Just ts-  GT -> drop (i - w) ts-  where w = weight t-drop i (Last t)-  | i < w     = Just (dropComplete i t Last)-  | otherwise = Nothing-  where w = weight t--dropComplete :: Int -> Complete a -> (Complete a -> Future a) -> Future a-dropComplete 0 t f             = f t-dropComplete 1 (Bin _ _ l r) f = l :< f r-dropComplete i (Bin w _ l r) f = case compare (i - 1) w' of-  LT -> dropComplete (i-1) l (:< f r)-  EQ -> f r-  GT -> dropComplete (i-1-w') r f-  where w' = div w 2-dropComplete _ _ _ = error "drop: index out of range"---- /O(n)/.-dropWhile :: (a -> Bool) -> Future a -> Maybe (Future a)-dropWhile p as-  | p (head as) = tail as >>= dropWhile p-  | otherwise = Just as---- /O(n)/-span :: (a -> Bool) -> Future a -> ([a], Maybe (Future a))-span p aas = case uncons aas of-  (a, Just as) | p a, (ts, fs) <- span p as -> (a:ts, fs)-  (a, Nothing) | p a                        -> ([a], Nothing)-  (_, _)                                    -> ([], Just aas)---- /O(n)/-break :: (a -> Bool) -> Future a -> ([a], Maybe (Future a))-break p = span (not . p)---- /(O(n), O(log n))/ split at _some_ edge where function goes from False to True.--- best used with a monotonic function-split :: (a -> Bool) -> Future a -> ([a], Maybe (Future a))-split p l@(Last a)-  | p (extract a)  = ([], Just l)-  | otherwise      = splitComplete p a Last-split p (a :< as)-  | p (extract as) = splitComplete p a (:< as)-  | (ts, fs) <- split p as = (foldr (:) ts a, fs)---- for use when we know the split occurs within a given tree-splitComplete :: (a -> Bool) -> Complete a -> (Complete a -> Future a) -> ([a], Maybe (Future a))-splitComplete p t@(Tip a) f-  | p a       = ([], Just (f t))-  | otherwise = ([a], Nothing)-splitComplete p t@(Bin _ a l r) f-  | p a                                               = ([], Just (f t))-  | p (extract r), (ts, fs) <- splitComplete p l (:< f r) = (a:ts, fs)-  |                (ts, fs) <- splitComplete p r f        = (a:foldr (:) ts l, fs)---- /(O(n), O(log n))/ split at _some_ edge where function goes from False to True.--- best used with a monotonic function------ > splitW p xs = (map extract &&& fmap (fmap extract)) . split p . duplicate-splitW :: (Future a -> Bool) -> Future a -> ([a], Maybe (Future a))-splitW p l@(Last a)-  | p l       = ([], Just l)-  | otherwise = splitCompleteW p a Last-splitW p (a :< as)-  | p as                    = splitCompleteW p a (:< as)-  | (ts, fs) <- splitW p as = (foldr (:) ts a, fs)---- for use when we know the split occurs within a given tree-splitCompleteW :: (Future a -> Bool) -> Complete a -> (Complete a -> Future a) -> ([a], Maybe (Future a))-splitCompleteW p t@(Tip a) f-  | w <- f t, p w = ([], Just w)-  | otherwise = ([a], Nothing)-splitCompleteW p t@(Bin _ a l r) f-  | w <- f t, p w                                    = ([], Just w)-  | w <- f r, p w, (ts, fs) <- splitCompleteW p l (:< w) = (a:ts, fs)-  |                (ts, fs) <- splitCompleteW p r f      = (a:foldr (:) ts l, fs)--fromList :: [a] -> Future a-fromList [] = error "fromList: empty list"-fromList (x:xs) = go x xs-  where go a [] = singleton a-        go a (b:bs) = a <| go b bs--toFuture :: [a] -> Maybe (Future a)-toFuture [] = Nothing-toFuture xs = Just (fromList xs)---- /O(n)/-insert :: Ord a => a -> Future a -> Future a-insert a as = case split (a<=) as of-    (_, Nothing)  -> foldr (<|) (singleton a) as-    (ts, Just as') -> foldr (<|) (a <| as') ts---- /O(n)/. Finds the split in O(log n), but then has to recons-insertBy :: (a -> a -> Ordering) -> a -> Future a -> Future a-insertBy cmp a as = case split (\b -> cmp a b <= EQ) as of-    (_, Nothing)  -> foldr (<|) (singleton a) as-    (ts, Just as') -> foldr (<|) (a <| as') ts---- /O(log n)/ Change the value of the nth entry in the future-adjust :: Int -> (a -> a) -> Future a -> Future a-adjust !n f d@(Last a)-  | n < weight a = Last (adjustComplete n f a)-  | otherwise = d-adjust !n f (a :< as)-  | n < w = adjustComplete n f a :< as-  | otherwise = a :< adjust (n - w) f as-  where w = weight a--adjustComplete :: Int -> (a -> a) -> Complete a -> Complete a-adjustComplete 0 f (Tip a) = Tip (f a)-adjustComplete _ _ t@Tip{} = t-adjustComplete n f (Bin m a l r)-  | n == 0 = Bin m (f a) l r-  | n < w = Bin m a (adjustComplete (n - 1) f l) r-  | otherwise = Bin m a l (adjustComplete (n - 1 - w) f r)-  where w = weight l--update :: Int -> a -> Future a -> Future a-update n = adjust n . const

@@ -1,455 +0,0 @@-{-# LANGUAGE PatternGuards #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Stream.Infinite--- Copyright   :  (C) 2011 Edward Kmett,---                (C) 2007-2010 Wouter Swierstra, Bas van Dijk--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  portable (Haskell 2010)---------------------------------------------------------------------------------module Data.Stream.Infinite (-   -- * The type of streams-     Stream(..)-   -- * Basic functions-   , head   -- :: Stream a -> a-   , tail   -- :: Stream a -> Stream a-   , inits  -- :: Stream a -> Stream [a]-   , tails  -- :: Stream a -> Stream (Stream a)-   -- * Stream transformations-   , map         -- :: (a -> b) -> Stream a -> Stream b-   , intersperse -- :: a -> Stream a -> Stream-   , interleave  -- :: Stream a -> Stream a -> Stream a-   , scanl       -- :: (b -> a -> b) -> b -> Stream a -> Stream b-   , scanl'      -- :: (b -> a -> b) -> b -> Stream a -> Stream b-   , scanl1      -- :: (a -> a -> a) -> Stream a -> Stream a-   , scanl1'     -- :: (a -> a -> a) -> Stream a -> Stream a-   , transpose   -- :: Stream (Stream a) -> Stream (Stream a)-   -- * Building streams-   , iterate     -- :: (a -> a) -> a -> Stream a-   , repeat      -- :: a -> Stream a-   , cycle       -- :: NonEmpty a -> Stream a-   , unfold      -- :: (a -> (b, a)) -> a -> Stream b-   -- * Extracting sublists-   , take        -- :: Int -> Stream a -> [a]-   , drop        -- :: Int -> Stream a -> Stream a-   , splitAt     -- :: Int -> Stream a -> ([a],Stream a)-   , takeWhile   -- :: (a -> Bool) -> Stream a -> [a]-   , dropWhile   -- :: (a -> Bool) -> Stream a -> Stream a-   , span        -- :: (a -> Bool) -> Stream a -> ([a], Stream a)-   , break       -- :: (a -> Bool) -> Stream a -> ([a], Stream a)-   , filter      -- :: (a -> Bool) -> Stream a -> Stream a-   , partition   -- :: (a -> Bool) -> Stream a -> (Stream a, Stream a)-   , group       -- :: (a -> Bool) -> Stream a -> Stream (NonEmpty a)-   , groupBy     -- :: (a -> a -> Bool) -> Stream a -> Stream (NonEmpty a)-   -- * Sublist predicates-   , isPrefixOf  -- :: [a] -> Stream a -> Bool-   -- * Indexing streams -   , (!!)        -- :: Int -> Stream a -> a-   , elemIndex   -- :: Eq a => a -> Stream a -> Int-   , elemIndices -- :: Eq a => a -> Stream a -> Stream Int-   , findIndex   -- :: (a -> Bool) -> Stream a -> Int-   , findIndices -- :: (a -> Bool) -> Stream a -> Stream Int-   -- * Zipping and unzipping streams-   , zip         -- :: Stream a -> Stream b -> Stream (a, b)-   , zipWith     -- :: (a -> b -> c) -> Stream a -> Stream b -> Stream c-   , unzip       -- :: Functor f => f (a, b) -> (f a, f b)-   -- * Functions on streams of characters-   , words       -- :: Stream Char -> Stream String-   , unwords     -- :: Stream String -> Stream Char-   , lines       -- :: Stream Char -> Stream String-   , unlines     -- :: Stream String -> Stream Char-   -- * Converting to and from an infinite list-   , fromList    -- :: [a] -> Stream a-   ) where--import Prelude hiding -  ( head, tail, map, scanr, scanr1, scanl, scanl1-  , iterate, take, drop, takeWhile-  , dropWhile, repeat, cycle, filter-  , (!!), zip, unzip, zipWith, words-  , unwords, lines, unlines, break, span-  , splitAt, foldr-  )--import Control.Applicative-import Control.Comonad-import Data.Char (isSpace)-import Data.Data-import Data.Functor.Apply-import Data.Functor.Extend-import Data.Semigroup-import Data.Foldable-import Data.Traversable-import Data.Distributive-import Data.Semigroup.Traversable-import Data.Semigroup.Foldable-import Data.List.NonEmpty (NonEmpty(..))--data Stream a = a :> Stream a deriving -  ( Show-#ifdef LANGUAGE_DeriveDataTypeable-  , Data, Typeable-#endif-  )--infixr 5 :>---- | Map a pure function over a stream-map :: (a -> b) -> Stream a -> Stream b-map f (a :> as) = f a :> map f as--instance Functor Stream where-  fmap = map-  b <$ _ = repeat b--instance Distributive Stream where-  distribute w = fmap head w :> distribute (fmap tail w)---- | Extract the first element of the sequence.-head :: Stream a -> a-head (a :> _) = a-{-# INLINE head #-}---- | Extract the sequence following the head of the stream.-tail :: Stream a -> Stream a-tail (_ :> as) = as-{-# INLINE tail #-}---- | The 'tails' function takes a stream @xs@ and returns all the--- suffixes of @xs@.-tails :: Stream a -> Stream (Stream a)-tails w = w :> tails (tail w)--instance Extend Stream where-  duplicated = tails-  extended f w = f w :> extended f (tail w)--instance Comonad Stream where-  duplicate = tails-  extend f w = f w :> extend f (tail w)-  extract = head--instance Apply Stream where-  (f :> fs) <.> (a :> as) = f a :> (fs <.> as)-  as        <.  _         = as-  _          .> bs        = bs--instance ComonadApply Stream where-  (f :> fs) <@> (a :> as) = f a :> (fs <@> as)-  as        <@  _         = as-  _          @> bs        = bs---- | 'repeat' @x@ returns a constant stream, where all elements are--- equal to @x@.-repeat :: a -> Stream a-repeat a = as where as = a :> as--instance Applicative Stream where-  pure = repeat-  (<*>) = (<.>)-  (<* ) = (<. )-  ( *>) = ( .>)--instance Foldable Stream where-  fold (m :> ms) = m `mappend` fold ms-  foldMap f (a :> as) = f a `mappend` foldMap f as-  foldr f0 _ = go f0 where go f (a :> as) = f a (go f as)--instance Traversable Stream where-  traverse f ~(a :> as) = (:>) <$> f a <*> traverse f as--instance Foldable1 Stream--instance Traversable1 Stream where-  traverse1 f ~(a :> as) = (:>) <$> f a <.> traverse1 f as-  sequence1 ~(a :> as) = (:>) <$> a <.> sequence1 as---- | The unfold function is similar to the unfold for lists. Note--- there is no base case: all streams must be infinite.-unfold :: (a -> (b, a)) -> a -> Stream b-unfold f c | (x, d) <- f c = x :> unfold f d--instance Monad Stream where-  return = repeat-  m >>= f = unfold (\(bs :> bss) -> (head bs, tail <$> bss)) (fmap f m)-  _ >> bs = bs---- | Interleave two Streams @xs@ and @ys@, alternating elements--- from each list.------ > [x1,x2,...] `interleave` [y1,y2,...] == [x1,y1,x2,y2,...]-interleave :: Stream a -> Stream a -> Stream a-interleave ~(x :> xs) ys = x :> interleave ys xs--instance Semigroup (Stream a) where-  (<>) = interleave---- | The 'inits' function takes a stream @xs@ and returns all the--- finite prefixes of @xs@.------ Note that this 'inits' is lazier then @Data.List.inits@:------ > inits _|_ = [] ::: _|_------ while for @Data.List.inits@:------ > inits _|_ = _|_-inits :: Stream a -> Stream [a]-inits xs = [] :> ((head xs :) <$> inits (tail xs))---- | @'intersperse' y xs@ creates an alternating stream of--- elements from @xs@ and @y@.-intersperse :: a -> Stream a -> Stream a-intersperse y ~(x :> xs) = x :> y :> intersperse y xs---- | 'scanl' yields a stream of successive reduced values from:------ > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]-scanl :: (a -> b -> a) -> a -> Stream b -> Stream a-scanl f z ~(x :> xs) = z :> scanl f (f z x) xs---- | 'scanl' yields a stream of successive reduced values from:------ > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]-scanl' :: (a -> b -> a) -> a -> Stream b -> Stream a-scanl' f z ~(x :> xs) = z :> (scanl' f $! f z x) xs---- | 'scanl1' is a variant of 'scanl' that has no starting value argument:------ > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]-scanl1 :: (a -> a -> a) -> Stream a -> Stream a-scanl1 f ~(x :> xs) = scanl f x xs---- | @scanl1'@ is a strict 'scanl' that has no starting value.-scanl1' :: (a -> a -> a) -> Stream a -> Stream a-scanl1' f ~(x :> xs) = scanl' f x xs---- | 'transpose' computes the transposition of a stream of streams.-transpose :: Stream (Stream a) -> Stream (Stream a)-transpose ~((x :> xs) :> yss) =-  (x :> (head <$> yss)) :> transpose (xs :> (tail <$> yss))---- | @'iterate' f x@ produces the infinite sequence--- of repeated applications of @f@ to @x@.------ > iterate f x = [x, f x, f (f x), ..]-iterate :: (a -> a) -> a -> Stream a-iterate f x = x :> iterate f (f x)---- | @'cycle' xs@ returns the infinite repetition of @xs@:------ > cycle [1,2,3] = Cons 1 (Cons 2 (Cons 3 (Cons 1 (Cons 2 ...-cycle :: NonEmpty a -> Stream a-cycle xs = ys where ys = foldr (:>) ys xs---- | @'take' n xs@ returns the first @n@ elements of @xs@.------ /Beware/: passing a negative integer as the first argument will--- cause an error.-take :: Int -> Stream a -> [a]-take n ~(x :> xs)-  | n == 0 = []-  | n > 0 = x : take (n - 1) xs-  | otherwise = error "Stream.take: negative argument"---- | @'drop' n xs@ drops the first @n@ elements off the front of--- the sequence @xs@.------ /Beware/: passing a negative integer as the first argument will--- cause an error.-drop :: Int -> Stream a -> Stream a-drop n xs-  | n == 0 = xs-  | n > 0 = drop (n - 1) (tail xs)-  | otherwise = error "Stream.drop: negative argument"---- | @'splitAt' n xs@ returns a pair consisting of the prefix of --- @xs@ of length @n@ and the remaining stream immediately following --- this prefix.------ /Beware/: passing a negative integer as the first argument will--- cause an error.-splitAt :: Int -> Stream a -> ([a],Stream a)-splitAt n xs-  | n == 0 = ([],xs)-  | n > 0, (prefix, rest) <- splitAt (n - 1) (tail xs) = (head xs : prefix, rest)-  | otherwise = error "Stream.splitAt: negative argument"---- | @'takeWhile' p xs@ returns the longest prefix of the stream--- @xs@ for which the predicate @p@ holds.-takeWhile :: (a -> Bool) -> Stream a -> [a]-takeWhile p (x :> xs) -  | p x = x : takeWhile p xs-  | otherwise = []---- | @'dropWhile' p xs@ returns the suffix remaining after--- @'takeWhile' p xs@.------ /Beware/: this function may diverge if every element of @xs@--- satisfies @p@, e.g.  @dropWhile even (repeat 0)@ will loop.-dropWhile :: (a -> Bool) -> Stream a -> Stream a-dropWhile p ~(x :> xs)-  | p x = dropWhile p xs-  | otherwise = x :> xs---- | @'span' p xs@ returns the longest prefix of @xs@ that satisfies--- @p@, together with the remainder of the stream.-span :: (a -> Bool) -> Stream a -> ([a], Stream a)-span p xxs@(x :> xs)-  | p x, (ts, fs) <- span p xs = (x : ts, fs)-  | otherwise = ([], xxs)---- | The 'break' @p@ function is equivalent to 'span' @not . p@.-break :: (a -> Bool) -> Stream a -> ([a], Stream a)-break p = span (not . p)---- | @'filter' p xs@, removes any elements from @xs@ that do not satisfy @p@.------ /Beware/: this function may diverge if there is no element of--- @xs@ that satisfies @p@, e.g.  @filter odd (repeat 0)@ will loop.-filter :: (a -> Bool) -> Stream a -> Stream a-filter p ~(x :> xs) -  | p x       = x :> filter p xs-  | otherwise = filter p xs---- | The 'partition' function takes a predicate @p@ and a stream--- @xs@, and returns a pair of streams. The first stream corresponds--- to the elements of @xs@ for which @p@ holds; the second stream--- corresponds to the elements of @xs@ for which @p@ does not hold.------ /Beware/: One of the elements of the tuple may be undefined. For--- example, @fst (partition even (repeat 0)) == repeat 0@; on the--- other hand @snd (partition even (repeat 0))@ is undefined.-partition :: (a -> Bool) -> Stream a -> (Stream a, Stream a)-partition p ~(x :> xs)-  | p x = (x :> ts, fs)-  | otherwise = (ts, x :> fs)-  where (ts, fs) = partition p xs---- | The 'group' function takes a stream and returns a stream of--- lists such that flattening the resulting stream is equal to the--- argument.  Moreover, each sublist in the resulting stream--- contains only equal elements.  For example,------ > group $ cycle "Mississippi" = "M" ::: "i" ::: "ss" ::: "i" ::: "ss" ::: "i" ::: "pp" ::: "i" ::: "M" ::: "i" ::: ...-group :: Eq a => Stream a -> Stream (NonEmpty a)-group = groupBy (==)--groupBy :: (a -> a -> Bool) -> Stream a -> Stream (NonEmpty a)-groupBy eq ~(x :> ys) -  | (xs, zs) <- span (eq x) ys -  = (x :| xs) :> groupBy eq zs---- | The 'isPrefix' function returns @True@ if the first argument is--- a prefix of the second.-isPrefixOf :: Eq a => [a] -> Stream a -> Bool-isPrefixOf [] _ = True-isPrefixOf (y:ys) (x :> xs)-  | y == x    = isPrefixOf ys xs-  | otherwise = False---- | @xs !! n@ returns the element of the stream @xs@ at index--- @n@. Note that the head of the stream has index 0.------ /Beware/: passing a negative integer as the first argument will cause--- an error.-(!!) :: Stream a -> Int -> a-(!!) (x :> xs) n-  | n == 0    = x-  | n > 0     = xs !! (n - 1)-  | otherwise = error "Stream.!! negative argument"---- | The 'elemIndex' function returns the index of the first element--- in the given stream which is equal (by '==') to the query element,------ /Beware/: @'elemIndex' x xs@ will diverge if none of the elements--- of @xs@ equal @x@.-elemIndex :: Eq a => a -> Stream a -> Int-elemIndex x = findIndex (\y -> x == y)---- | The 'elemIndices' function extends 'elemIndex', by returning the--- indices of all elements equal to the query element, in ascending order.------ /Beware/: 'elemIndices' @x@ @xs@ will diverge if any suffix of--- @xs@ does not contain @x@.-elemIndices :: Eq a => a -> Stream a -> Stream Int-elemIndices x = findIndices (x==)---- | The 'findIndex' function takes a predicate and a stream and returns--- the index of the first element in the stream that satisfies the predicate,------ /Beware/: 'findIndex' @p@ @xs@ will diverge if none of the elements of--- @xs@ satisfy @p@.-findIndex :: (a -> Bool) -> Stream a -> Int-findIndex p = indexFrom 0-    where-    indexFrom ix (x :> xs) -      | p x       = ix-      | otherwise = (indexFrom $! (ix + 1)) xs---- | The 'findIndices' function extends 'findIndex', by returning the--- indices of all elements satisfying the predicate, in ascending--- order.------ /Beware/: 'findIndices' @p@ @xs@ will diverge if all the elements--- of any suffix of @xs@ fails to satisfy @p@.-findIndices :: (a -> Bool) -> Stream a -> Stream Int-findIndices p = indicesFrom 0 where-  indicesFrom ix (x :> xs) -    | p x = ix :> ixs -    | otherwise = ixs-    where ixs = (indicesFrom $! (ix+1)) xs---- | The 'zip' function takes two streams and returns a list of--- corresponding pairs.-zip :: Stream a -> Stream b -> Stream (a,b)-zip ~(x :> xs) ~(y :> ys) = (x,y) :> zip xs ys---- | The 'zipWith' function generalizes 'zip'. Rather than tupling--- the functions, the elements are combined using the function--- passed as the first argument to 'zipWith'.-zipWith :: (a -> b -> c) -> Stream a -> Stream b -> Stream c-zipWith f ~(x :> xs) ~(y :> ys) = f x y :> zipWith f xs ys---- | The 'unzip' function is the inverse of the 'zip' function.-unzip :: Stream (a,b) -> (Stream a, Stream b)-unzip xs = (fst <$> xs, snd <$> xs)---- | The 'words' function breaks a stream of characters into a--- stream of words, which were delimited by white space.------ /Beware/: if the stream of characters @xs@ does not contain white--- space, accessing the tail of @words xs@ will loop.-words :: Stream Char -> Stream String-words xs | (w, ys) <- break isSpace xs = w :> words ys---- | The 'unwords' function is an inverse operation to 'words'. It--- joins words with separating spaces.-unwords :: Stream String -> Stream Char-unwords ~(x :> xs) = foldr (:>) (' ' :> unwords xs) x---- | The 'lines' function breaks a stream of characters into a list--- of strings at newline characters. The resulting strings do not--- contain newlines.------ /Beware/: if the stream of characters @xs@ does not contain--- newline characters, accessing the tail of @lines xs@ will loop.-lines :: Stream Char -> Stream String-lines xs | (l, ys) <- break (== '\n') xs = l :> lines (tail ys)---- | The 'unlines' function is an inverse operation to 'lines'. It--- joins lines, after appending a terminating newline to each.-unlines :: Stream String -> Stream Char-unlines ~(x :> xs) = foldr (:>) ('\n' :> unlines xs) x---- | The 'fromList' converts an infinite list to a--- stream.------ /Beware/: Passing a finite list, will cause an error.-fromList :: [a] -> Stream a-fromList (x:xs) = x :> fromList xs-fromList []     = error "Stream.listToStream applied to finite list"

@@ -1,334 +0,0 @@-{-# LANGUAGE CPP, PatternGuards, BangPatterns #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Zipper.Infinite.Functional.Zipper--- Copyright   :  (C) 2011 Edward Kmett,--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  portable------ This is an infinite bidirectional zipper------------------------------------------------------------------------------module Data.Stream.Infinite.Functional.Zipper (-   -- * The type of streams-     Zipper(..)-   , tail   -- :: Zipper a -> Zipper a-   , untail -- :: Zipper a -> Zipper a -   , intersperse -- :: a -> Zipper a -> Zipper a-   , interleave  -- :: Zipper a -> Zipper a -> Zipper a-   , transpose   -- :: Zipper (Zipper a) -> Zipper (Zipper a)-   , take        -- :: Integer -> Zipper a -> [a]-   , drop        -- :: Integer -> Zipper a -> Zipper a -- you can drop a negative number-   , splitAt     -- :: Integer -> Zipper a -> ([a],Zipper a)-   , reverse     -- :: Zipper a -> Zipper a-   , (!!)        -- :: Int -> Zipper a -> a-   , unzip       -- :: Functor f => f (a, b) -> (f a, f b)-   , toSequence  -- :: (Integer -> a) -> Zipper a-   , head-   , (<|)-   , uncons-   , takeWhile-   , dropWhile-   , span-   , break-   , isPrefixOf-   , findIndex-   , elemIndex-   , zip-   , zipWith-   ) where--import Prelude hiding -  ( head, tail, map, scanr, scanr1, scanl, scanl1-  , iterate, take, drop, takeWhile-  , dropWhile, repeat, cycle, filter-  , (!!), zip, unzip, zipWith, words-  , unwords, lines, unlines, break, span-  , splitAt, foldr-  )--import Control.Applicative-import Control.Comonad--- import Data.Char (isSpace)-#ifdef LANGUAGE_DeriveDataTypeable-import Data.Data-#endif-import Data.Functor.Extend-import Data.Functor.Apply--- import Data.Monoid-import Data.Semigroup--- import Data.Foldable--- import Data.Traversable--- import Data.Semigroup.Traversable--- import Data.Semigroup.Foldable--- import Data.Zipper.NonEmpty (NonEmpty(..))--data Zipper a = !Integer :~ !(Integer -> a)-#ifdef LANGUAGE_DeriveDataTypeable-  deriving Typeable-#endif--toSequence :: (Integer -> a) -> Zipper a-toSequence = (0 :~) --infixr 0 :~--instance Functor Zipper where-  fmap g (n :~ f) = n :~ g . f-  b <$ _ = 0 :~ const b---- | Extract the focused element-head :: Zipper a -> a-head (n :~ f) = f n---- | Move the head of the zipper to the right-tail :: Zipper a -> Zipper a-tail (n :~ f) = n + 1 :~ f---- | Move the head of the zipper to the left-untail :: Zipper a -> Zipper a-untail (n :~ f) = n - 1 :~ f---- | Cons before the head of the zipper. The head now points to the new element-(<|) :: a -> Zipper a -> Zipper a-a <| (n :~ f) = n :~ \z -> case compare z n of-  LT -> f n-  EQ -> a-  GT -> f (n - 1)---- | Move the head of the zipper one step to the right, returning the value we move over.-uncons :: Zipper a -> (a, Zipper a)-uncons (n :~ f) = (f n, n + 1 :~ f)--instance Extend Zipper where-  duplicated (n :~ f) = n :~ (:~ f)--instance Comonad Zipper where-  duplicate (n :~ f) = n :~ (:~ f)-  extract (n :~ f) = f n--instance Apply Zipper where-  (nf :~ f) <.> (na :~ a) -    | dn <- na - nf-    = nf :~ \n -> f n (a (n + dn))-  as        <.  _         = as-  _          .> bs        = bs--instance ComonadApply Zipper where-  (<@>) = (<.>)-  (<@) = (<.)-  (@>) = (.>)---instance Applicative Zipper where-  pure = repeat-  (<*>) = (<.>)-  as <* _ = as-  _ *> bs = bs--instance Monad Zipper where-  return = repeat-  (z :~ ma) >>= f = z :~ \ na -> case f (ma na) of-    nb :~ mb -> mb (nb + na - z)--repeat :: a -> Zipper a-repeat a = 0 :~ const a---- | Interleave two Zippers @xs@ and @ys@, alternating elements--- from each list.------ > [x1,x2,...] `interleave` [y1,y2,...] == [x1,y1,x2,y2,...]--- > interleave = (<>) -interleave :: Zipper a -> Zipper a -> Zipper a-interleave = (<>) -instance Semigroup (Zipper a) where-  (n :~ a) <> (m :~ b) = 0 :~ \p -> case quotRem p 2 of -    (q, 0) -> a (n + q)-    (q, _) -> b (m + q)---- | @'intersperse' y xs@ creates an alternating stream of--- elements from @xs@ and @y@.-intersperse :: a -> Zipper a -> Zipper a-intersperse y z = z <> repeat y---- | 'transpose' computes the transposition of a stream of streams.-transpose :: Zipper (Zipper a) -> Zipper (Zipper a)-transpose (n :~ f) = 0 :~ \z -> n :~ \n' -> let m :~ g = f n' in g (m + z)--take :: Integer -> Zipper a -> [a]-take n0 (m0 :~ f0)-  | n0 < 0 = error "Zipper.take: negative argument"-  | otherwise = go n0 m0 f0-  where-    go 0 !_ !_ = []-    go n  m  f = f m : go (n - 1) (m + 1) f-  --- | @'drop' n xs@ drops the first @n@ elements off the front of--- the sequence @xs@.-drop :: Integer -> Zipper a -> Zipper a-drop m (n :~ f) = m + n :~ f---- | @'splitAt' n xs@ returns a pair consisting of the prefix of --- @xs@ of length @n@ and the remaining stream immediately following --- this prefix.------ /Beware/: passing a negative integer as the first argument will--- cause an error if you access the taken portion-splitAt :: Integer -> Zipper a -> ([a],Zipper a)-splitAt n xs = (take n xs, drop n xs)---- | @'takeWhile' p xs@ returns the longest prefix of the stream--- @xs@ for which the predicate @p@ holds.-takeWhile :: (a -> Bool) -> Zipper a -> [a]-takeWhile p0 (n0 :~ f0) = go p0 n0 f0 where -  go !p !n !f -    | x <- f n, p x = x : go p (n + 1) f-    | otherwise = []---- | @'dropWhile' p xs@ returns the suffix remaining after--- @'takeWhile' p xs@.------ /Beware/: this function may diverge if every element of @xs@--- satisfies @p@, e.g.  @dropWhile even (repeat 0)@ will loop.-dropWhile :: (a -> Bool) -> Zipper a -> Zipper a-dropWhile p xs@(_ :~ f) = findIndex' p xs :~ f---- | @'span' p xs@ returns the longest prefix of @xs@ that satisfies--- @p@, together with the remainder of the stream.-span :: (a -> Bool) -> Zipper a -> ([a], Zipper a)-span p0 (n0 :~ f0) -  | (ts, n') <- go p0 n0 f0 = (ts, n' :~ f0) where-  go !p !n !f-    | x <- f n, p x, (ts, fs) <- go p (n + 1) f = (x:ts, fs)-    | otherwise = ([], n)---- | The 'break' @p@ function is equivalent to 'span' @not . p@.-break :: (a -> Bool) -> Zipper a -> ([a], Zipper a)-break p = span (not . p)---- | The 'isPrefix' function returns @True@ if the first argument is--- a prefix of the second.-isPrefixOf :: Eq a => [a] -> Zipper a -> Bool-isPrefixOf xs0 (n0 :~ f0) = go xs0 n0 f0 where-  go [] !_ !_ = True-  go (y:ys) n f = y == f n && go ys (n + 1) f---- | @xs !! n@ returns the element of the stream @xs@ at index--- @n@. Note that the head of the stream has index 0.------ /Beware/: passing a negative integer as the first argument will cause--- an error.-(!!) :: Zipper a -> Integer -> a-(!!) (n :~ f) m = f (n + m)---- | The 'findIndex' function takes a predicate and a stream and returns--- the index of the first element in the stream that satisfies the predicate,------ /Beware/: 'findIndex' @p@ @xs@ will diverge if none of the elements of--- @xs@ satisfy @p@.-findIndex :: (a -> Bool) -> Zipper a -> Integer-findIndex p0 (n0 :~ f0) = go p0 n0 f0 - n0 where-  go !p !n !f -    | x <- f n, p x = n-    | otherwise = go p (n + 1) f---- | Internal helper, used to find an index in the -findIndex' :: (a -> Bool) -> Zipper a -> Integer-findIndex' p0 (n0 :~ f0) = go p0 n0 f0 where-  go !p !n !f -    | x <- f n, p x = n-    | otherwise = go p (n + 1) f---- | The 'elemIndex' function returns the index of the first element--- in the given stream which is equal (by '==') to the query element,------ /Beware/: @'elemIndex' x xs@ will diverge if none of the elements--- of @xs@ equal @x@.-elemIndex :: Eq a => a -> Zipper a -> Integer-elemIndex = findIndex . (==)--{---- | The 'elemIndices' function extends 'elemIndex', by returning the--- indices of all elements equal to the query element, in ascending order.------ /Beware/: 'elemIndices' @x@ @xs@ will diverge if any suffix of--- @xs@ does not contain @x@.-elemIndices :: Eq a => a -> Zipper a -> Zipper Int-elemIndices x = findIndices (x==)--}---- | The 'zip' function takes two streams and returns a list of--- corresponding pairs.------ > zip = liftA2 (,)-zip :: Zipper a -> Zipper b -> Zipper (a,b)-zip = liftA2 (,)---- | The 'zipWith' function generalizes 'zip'. Rather than tupling--- the functions, the elements are combined using the function--- passed as the first argument to 'zipWith'.------ > zipWith = liftA2-zipWith :: (a -> b -> c) -> Zipper a -> Zipper b -> Zipper c-zipWith = liftA2---- | The 'unzip' function is the inverse of the 'zip' function.-unzip :: Zipper (a,b) -> (Zipper a, Zipper b)-unzip xs = (fst <$> xs, snd <$> xs)----{----- | The 'findIndices' function extends 'findIndex', by returning the--- indices of all elements satisfying the predicate, in ascending--- order.------ /Beware/: 'findIndices' @p@ @xs@ will diverge if all the elements--- of any suffix of @xs@ fails to satisfy @p@.-findIndices :: (a -> Bool) -> Zipper a -> Zipper Int-findIndices p = indicesFrom 0 where-  indicesFrom ix (x :< xs) -    | p x = ix :< ixs -    | otherwise = ixs-    where ixs = (indicesFrom $! (ix+1)) xs----- | The 'words' function breaks a stream of characters into a--- stream of words, which were delimited by white space.------ /Beware/: if the stream of characters @xs@ does not contain white--- space, accessing the tail of @words xs@ will loop.-words :: Zipper Char -> Zipper String-words xs | (w, ys) <- break isSpace xs = w :< words ys---- | The 'unwords' function is an inverse operation to 'words'. It--- joins words with separating spaces.-unwords :: Zipper String -> Zipper Char-unwords ~(x :< xs) = foldr (:<) (' ' :< unwords xs) x---- | The 'lines' function breaks a stream of characters into a list--- of strings at newline characters. The resulting strings do not--- contain newlines.------ /Beware/: if the stream of characters @xs@ does not contain--- newline characters, accessing the tail of @lines xs@ will loop.-lines :: Zipper Char -> Zipper String-lines xs | (l, ys) <- break (== '\n') xs = l :< lines (tail ys)---- | The 'unlines' function is an inverse operation to 'lines'. It--- joins lines, after appending a terminating newline to each.-unlines :: Zipper String -> Zipper Char-unlines ~(x :< xs) = foldr (:<) ('\n' :< unlines xs) x---- | The 'fromList' converts an infinite list to a--- stream.------ /Beware/: Passing a finite list, will cause an error.-fromList :: [a] -> Zipper a-fromList (x:xs) = x :< fromList xs-fromList []     = error "Zipper.listToZipper applied to finite list"---}

@@ -1,348 +0,0 @@-{-# LANGUAGE PatternGuards, BangPatterns #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Stream.Infinite.Skew--- Copyright   :  (C) 2011 Edward Kmett,--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  portable------ Anticausal streams implemented as non-empty skew binary random access lists--- --- The Applicative zips streams, the monad diagonalizes----------------------------------------------------------------------------------module Data.Stream.Infinite.Skew -    ( Stream-    , (<|)      -- O(1)-    , (!!)-    , head      -- O(1)-    , tail      -- O(1)-    , tails-    , uncons    -- O(1)-    , index     -- O(log n)-    , drop      -- O(log n)-    , dropWhile -- O(n)-    , span-    , break-    , split-    , splitW-    , repeat   -    , insert    -- O(n)-    , insertBy-    , adjust    -- O(log n)-    , update    -- O(log n)-    , fromList-    , from-    , indexed-    , interleave-    , tabulate-    ) where --import Control.Arrow (first)-import Control.Applicative hiding (empty)-import Control.Comonad-import Data.Distributive-import Data.Functor.Alt-import Data.Functor.Extend-import Data.Foldable hiding (toList)-import Data.Traversable-import Data.Semigroup hiding (Last)-import Data.Semigroup.Foldable-import Data.Semigroup.Traversable-import Prelude hiding (null, head, tail, drop, dropWhile, length, foldr, last, span, repeat, replicate, (!!), break)--infixr 5 :<, <|--data Complete a -    = Tip a-    | Bin !Integer a !(Complete a) !(Complete a)-    deriving Show--instance Functor Complete where-  fmap f (Tip a) = Tip (f a)-  fmap f (Bin w a l r) = Bin w (f a) (fmap f l) (fmap f r)--instance Extend Complete where-  extended f w@Tip {} = Tip (f w)-  extended f w@(Bin n _ l r) = Bin n (f w) (extended f l) (extended f r)--instance Comonad Complete where-  extend f w@Tip {} = Tip (f w)-  extend f w@(Bin n _ l r) = Bin n (f w) (extend f l) (extend f r)-  extract (Tip a) = a-  extract (Bin _ a _ _) = a--instance Foldable Complete where-  foldMap f (Tip a) = f a -  foldMap f (Bin _ a l r) = f a `mappend` foldMap f l `mappend` foldMap f r-  foldr f z (Tip a) = f a z-  foldr f z (Bin _ a l r) = f a (foldr f (foldr f z r) l)--instance Foldable1 Complete where-  foldMap1 f (Tip a) = f a-  foldMap1 f (Bin _ a l r) = f a <> foldMap1 f l <> foldMap1 f r--instance Traversable Complete where-  traverse f (Tip a) = Tip <$> f a -  traverse f (Bin n a l r) = Bin n <$> f a <*> traverse f l <*> traverse f r--instance Traversable1 Complete where-  traverse1 f (Tip a) = Tip <$> f a -  traverse1 f (Bin n a l r) = Bin n <$> f a <.> traverse1 f l <.> traverse1 f r--bin :: a -> Complete a -> Complete a -> Complete a -bin a l r = Bin (1 + weight l + weight r) a l r-{-# INLINE bin #-}--weight :: Complete a -> Integer-weight Tip{} = 1-weight (Bin w _ _ _) = w-{-# INLINE weight #-}---- A future is a non-empty skew binary random access list of nodes.--- The last node, however, is allowed to contain fewer values. -data Stream a = !(Complete a) :< Stream a---  deriving Show--instance Show a => Show (Stream a) where-  showsPrec d as = showParen (d >= 10) $ -    showString "fromList " . showsPrec 11 (toList as)--instance Functor Stream where-  fmap f (t :< ts) = fmap f t :< fmap f ts--instance Extend Stream where-  extended = extend--instance Comonad Stream where-  extend g0 (t :< ts) = go g0 t (:< ts) :< extend g0 ts-    where-      go :: (Stream a -> b) -> Complete a -> (Complete a -> Stream a) -> Complete b-      go g w@Tip{}         f = Tip (g (f w))-      go g w@(Bin n _ l r) f = Bin n (g (f w)) (go g l (:< f r))  (go g r f)-  extract = head--instance Apply Stream where-  fs <.> as = mapWithIndex (\n f -> f (as !! n)) fs-  as <.  _  = as-  _   .> bs = bs--instance ComonadApply Stream where-  (<@>) = (<.>)-  (<@) = (<.)-  (@>) = (.>)--instance Applicative Stream where-  pure = repeat-  (<*>) = (<.>)-  (<* ) = (<. )-  ( *>) = ( .>)--instance Alt Stream where-  as <!> bs = tabulate $ \i -> case quotRem i 2 of -    (q,0) -> as !! q-    (q,_) -> bs !! q---instance Foldable Stream where-  foldMap f (t :< ts) = foldMap f t `mappend` foldMap f ts-  foldr f z (t :< ts) = foldr f (foldr f z ts) t--toList :: Stream a -> [a]-toList = foldr (:) []--instance Foldable1 Stream where-  foldMap1 f (t :< ts) = foldMap1 f t <> foldMap1 f ts--instance Traversable Stream where-  traverse f (t :< ts) = (:<) <$> traverse f t <*> traverse f ts--instance Traversable1 Stream where-  traverse1 f (t :< ts) = (:<) <$> traverse1 f t <.> traverse1 f ts--instance Distributive Stream where-  distribute w = tabulate (\i -> fmap (!! i) w)--instance Semigroup (Stream a) where-  (<>) = (<!>)--instance Monad Stream where-  return = pure-  as >>= f = mapWithIndex (\i a -> f a !! i) as--interleave :: Stream a -> Stream a -> Stream a-interleave = (<!>) -      -repeat :: a -> Stream a -repeat b = go b (Tip b) -    where -      go :: a -> Complete a -> Stream a -      go a as | ass <- bin a as as = as :< go a ass--mapWithIndex :: (Integer -> a -> b) -> Stream a -> Stream b-mapWithIndex f0 as0 = spine f0 0 as0-  where -    spine f m (a :< as) = tree f m a :< spine f (m + weight a) as-    tree f m (Tip a) = Tip (f m a)-    tree f m (Bin n a l r) = Bin n (f m a) (tree f (m + 1) l) (tree f (m + 1 + weight l) r)--tabulate :: (Integer -> a) -> Stream a-tabulate f = mapWithIndex (const . f) (pure ())---indexed :: Stream a -> Stream (Integer, a)-indexed = mapWithIndex (,)--from :: Num a => a -> Stream a-from a = mapWithIndex ((+) . fromIntegral) (pure a)---- | /O(1)/ cons-(<|) :: a -> Stream a -> Stream a-a <| (l :< r :< as) -  | weight l == weight r = bin a l r :< as-a <| as = Tip a :< as-{-# INLINE (<|) #-}---- | /O(1)/-head :: Stream a -> a-head (a :< _) = extract a-{-# INLINE head #-}---- | /O(1)/.-tail :: Stream a -> Stream a-tail (Tip{} :< ts) = ts-tail (Bin _ _ l r :< ts) = l :< r :< ts-{-# INLINE tail #-}--tails :: Stream a -> Stream (Stream a)-tails = duplicate-{-# INLINE tails #-}---- | /O(1)/.-uncons :: Stream a -> (a, Stream a)-uncons (Tip a       :< as)  = (a, as)-uncons (Bin _ a l r :< as)  = (a, l :< r :< as)-{-# INLINE uncons #-}---- | /O(log n)/.-index :: Integer -> Stream a -> a-index i (t :< ts) -  | i < 0     = error "index: negative index"-  | i < w     = indexComplete i t-  | otherwise = index (i - w) ts-  where w = weight t--indexComplete :: Integer -> Complete a -> a-indexComplete 0 (Tip a) = a-indexComplete 0 (Bin _ a _ _) = a-indexComplete i (Bin w _ l r) -  | i <= w'   = indexComplete (i-1) l-  | otherwise = indexComplete (i-1-w') r-  where w' = div w 2-indexComplete _ _ = error "indexComplete"---- | /O(log n)/.-(!!) :: Stream a -> Integer -> a-(!!) = flip index ---- | /O(log n)/.-drop :: Integer -> Stream a -> Stream a-drop 0 ts = ts-drop i (t :< ts) = case compare i w of-  LT -> dropComplete i t (:< ts)-  EQ -> ts-  GT -> drop (i - w) ts-  where w = weight t--dropComplete :: Integer -> Complete a -> (Complete a -> Stream a) -> Stream a -dropComplete 0 t f             = f t-dropComplete 1 (Bin _ _ l r) f = l :< f r-dropComplete i (Bin w _ l r) f = case compare (i - 1) w' of-    LT -> dropComplete (i-1) l (:< f r)-    EQ -> f r-    GT -> dropComplete (i-1-w') r f-    where w' = div w 2-dropComplete _ _ _ = error "dropComplete"---- /O(n)/.-dropWhile :: (a -> Bool) -> Stream a -> Stream a-dropWhile p as -  | p (head as) = dropWhile p (tail as)-  | otherwise   = as---- /O(n)/-span :: (a -> Bool) -> Stream a -> ([a], Stream a)-span p as-  | a <- head as, p a = first (a:) $ span p (tail as)-  | otherwise = ([], as)---- /O(n)/-break :: (a -> Bool) -> Stream a -> ([a], Stream a)-break p = span (not . p)---- /(O(n), O(log n))/ split at _some_ edge where function goes from False to True.--- best used with a monotonic function-split :: (a -> Bool) -> Stream a -> ([a], Stream a)-split p (a :< as)-  | p (extract as) = splitComplete p a (:< as)-  | (ts, fs) <- split p as = (foldr (:) ts a, fs)---- for use when we know the split occurs within a given tree-splitComplete :: (a -> Bool) -> Complete a -> (Complete a -> Stream a) -> ([a], Stream a)-splitComplete _ t@Tip{} f = ([], f t)-splitComplete p t@(Bin _ a l r) f-  | p a                                                   = ([], f t)-  | p (extract r), (ts, fs) <- splitComplete p l (:< f r) = (a:ts, fs)-  |                (ts, fs) <- splitComplete p r f        = (a:foldr (:) ts l, fs)---- /(O(n), O(log n))/ split at _some_ edge where function goes from False to True.--- best used with a monotonic function------ > splitW p xs = (map extract &&& fmap (fmap extract)) . split p . duplicate-splitW :: (Stream a -> Bool) -> Stream a -> ([a], Stream a)-splitW p (a :< as) -  | p as                    = splitCompleteW p a (:< as)-  | (ts, fs) <- splitW p as = (foldr (:) ts a, fs)---- for use when we know the split occurs within a given tree-splitCompleteW :: (Stream a -> Bool) -> Complete a -> (Complete a -> Stream a) -> ([a], Stream a)-splitCompleteW _ t@Tip{} f = ([], f t)-splitCompleteW p t@(Bin _ a l r) f-  | w <- f t, p w                                        = ([], w)-  | w <- f r, p w, (ts, fs) <- splitCompleteW p l (:< w) = (a:ts, fs)-  |                (ts, fs) <- splitCompleteW p r f      = (a:foldr (:) ts l, fs)--fromList :: [a] -> Stream a-fromList = foldr (<|) (error "fromList: finite list")---- /O(n)/-insert :: Ord a => a -> Stream a -> Stream a-insert a as | (ts, as') <- split (a<=) as = foldr (<|) (a <| as') ts---- /O(n)/. Finds the split in O(log n), but then has to recons-insertBy :: (a -> a -> Ordering) -> a -> Stream a -> Stream a-insertBy cmp a as | (ts, as') <- split (\b -> cmp a b <= EQ) as = foldr (<|) (a <| as') ts---- /O(log n)/ Change the value of the nth entry in the future-adjust :: Integer -> (a -> a) -> Stream a -> Stream a-adjust !n f (a :< as) -  | n < w = adjustComplete n f a :< as-  | otherwise = a :< adjust (n - w) f as-  where w = weight a--adjustComplete :: Integer -> (a -> a) -> Complete a -> Complete a-adjustComplete 0 f (Tip a) = Tip (f a)-adjustComplete _ _ t@Tip{} = t-adjustComplete n f (Bin m a l r) -  | n == 0 = Bin m (f a) l r-  | n < w = Bin m a (adjustComplete (n - 1) f l) r-  | otherwise = Bin m a l (adjustComplete (n - 1 - w) f r)-  where w = weight l--update :: Integer -> a -> Stream a -> Stream a-update n = adjust n . const-

@@ -1,174 +0,0 @@-{-# LANGUAGE CPP, FlexibleContexts #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Stream.Supply--- Copyright   :  (C) 2008-2011 Edward Kmett,---                (C) 2008 Iavor S. Diatchki--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  portable------ This library can be used to generate values (for example, new names)--- without the need to thread state.  This means that functions that--- need to generate new values only need a supply object as an argument,--- and they do not need to return a new supply object as a result.--- This decreases the number of data-dependencies in a program, which--- makes it easier to exploit parallelism.------ The technique for generating new values is based on the paper--- ''On Generating Unique Names'' by Lennart Augustsson, Mikael Rittri, --- and Dan Synek.------------------------------------------------------------------------------module Data.Stream.Supply-  ( Supply-  , newSupply-  , newEnumSupply-  , newNumSupply-  , newDupableSupply-  , newDupableEnumSupply-  , newDupableNumSupply-  , leftSupply-  , rightSupply-  , split-  , splits-  , splitSkew-  , split2-  , split3-  , split4-  ) where--import Control.Applicative-import Control.Comonad-import Data.Functor.Apply-import Data.Functor.Extend-import Data.Foldable-import Data.IORef(newIORef, atomicModifyIORef)-import Data.Traversable-import Data.Semigroup-import Data.Semigroup.Foldable-import Data.Semigroup.Traversable-import System.IO.Unsafe (unsafeInterleaveIO)-import Data.Stream.Infinite-import qualified Data.Stream.Infinite.Skew as Skew--#ifdef LANGUAGE_DeriveDataTypeable-import Data.Data-#endif--#ifdef __GLASGOW_HASKELL__ >= 608 -import GHC.IO(unsafeDupableInterleaveIO)-#else-unsafeDupableInterleaveIO :: IO a -> IO a-unsafeDupableInterleaveIO = unsafeInterleaveIO-#endif--data Supply a = Supply a (Supply a) (Supply a) deriving -  ( Show, Read, Eq, Ord-#ifdef LANGUAGE_DeriveDataTypeable-  , Data, Typeable-#endif-  )--instance Functor Supply where-  fmap f (Supply a l r) = Supply (f a) (fmap f l) (fmap f r)-  a <$ _ = pure a--instance Extend Supply where-  extended f s@(Supply _ l r) = Supply (f s) (extended f l) (extended f r)-  duplicated s@(Supply _ l r) = Supply s (duplicated l) (duplicated r)--instance Comonad Supply where-  extend f s@(Supply _ l r) = Supply (f s) (extend f l) (extend f r)-  duplicate s@(Supply _ l r) = Supply s (duplicate l) (duplicate r)-  extract (Supply a _ _) = a--instance Apply Supply where-  Supply f fl fr <.> Supply a al ar = Supply (f a) (fl <.> al) (fr <.> ar)-  a <. _ = a-  _ .> a = a--instance Applicative Supply where-  pure a = as where as = Supply a as as-  Supply f fl fr <*> Supply a al ar = Supply (f a) (fl <*> al) (fr <*> ar)-  a <* _ = a-  _ *> a = a--instance Foldable Supply where-  foldMap f (Supply a l r) = f a `mappend` foldMap f l `mappend` foldMap f r--instance Foldable1 Supply where-  foldMap1 f (Supply a l r) = f a <> foldMap1 f l <> foldMap1 f r--instance Traversable Supply where-  traverse f (Supply a l r) = Supply <$> f a <*> traverse f l <*> traverse f r--instance Traversable1 Supply where-  traverse1 f (Supply a l r) = Supply <$> f a <.> traverse1 f l <.> traverse1 f r-  -leftSupply :: Supply a -> Supply a-leftSupply (Supply _ l _) = l--rightSupply :: Supply a -> Supply a-rightSupply (Supply _ _ r) = r---- unfoldsW :: (Comonad w, Functor f) => (w a -> (b, f a)) -> w a -> StreamT f w b-newSupply :: (a -> a) -> a -> IO (Supply a)-newSupply f x = gen =<< newIORef x-  where gen r = unsafeInterleaveIO $-          Supply <$> unsafeInterleaveIO (atomicModifyIORef r update) -                 <*> gen r -                 <*> gen r-        update a = b `seq` (b, a) where b = f a-{-# INLINE newSupply #-}--newDupableSupply :: (a -> a) -> a -> IO (Supply a)-newDupableSupply f x = gen =<< newIORef x-  where gen r = unsafeDupableInterleaveIO $-          Supply <$> unsafeDupableInterleaveIO (atomicModifyIORef r update)-                 <*> gen r-                 <*> gen r-        update a = b `seq` (b, a) where b = f a-{-# INLINE newDupableSupply #-}--newEnumSupply :: Enum a => IO (Supply a)-newEnumSupply = newSupply succ (toEnum 0)-{-# SPECIALIZE newEnumSupply :: IO (Supply Int) #-}--newNumSupply :: Num a => IO (Supply a)-newNumSupply = newSupply (1+) 0-{-# SPECIALIZE newNumSupply :: IO (Supply Int) #-}--newDupableEnumSupply :: Enum a => IO (Supply a)-newDupableEnumSupply = newSupply succ (toEnum 0)-{-# SPECIALIZE newEnumSupply :: IO (Supply Int) #-}--newDupableNumSupply :: Num a => IO (Supply a)-newDupableNumSupply = newSupply (1+) 0-{-# SPECIALIZE newNumSupply :: IO (Supply Int) #-}--split :: Supply a -> Stream (Supply a)-split (Supply _ l r) = l :> split r--splits :: Integral b => Supply a -> b -> Supply a-splits (Supply _ l r) n = case n `quotRem` 2 of-  (0,0)  -> leftSupply l-  (q,-1) -> splits (rightSupply l) q-  (q,0)  -> splits (leftSupply r) q-  (q,1)  -> splits (rightSupply r) q-  (_,_)  -> error "quotRem: impossible result"-{-# SPECIALIZE splits :: Supply a -> Int -> Supply a #-}-{-# SPECIALIZE splits :: Supply a -> Integer -> Supply a #-}--splitSkew :: Supply a -> Skew.Stream (Supply a)-splitSkew = Skew.tabulate . splits--split2 :: Supply a -> (Supply a, Supply a)-split2 (Supply _ l r) = (l, r)--split3 :: Supply a -> (Supply a, Supply a, Supply a)-split3 (Supply _ a (Supply _ b c)) = (a, b, c)--split4 :: Supply a -> (Supply a, Supply a, Supply a, Supply a)-split4 (Supply _ (Supply _ a b) (Supply _ c d)) = (a, b, c, d)

@@ -34,7 +34,7 @@ Data.Stream.Infinite.Functional.Causal           data Causal a = Causal !(Integer -> a) !Integer -- decrement only  Data.Sequence.Future        data Future a = Future !(Int# -> a)      Int# Int#-Data.Sequence.Causal        data Causal a = Causal !(Int# -> a) Int# Int#     +Data.Sequence.Causal        data Causal a = Causal !(Int# -> a) Int# Int# Data.Sequence.Zipper        data Zipper a = Zipper !(Int# -> a) Int# Int# Int#  Data.Tensors          data Tensors f a = Last a | a :-   Tensors f (f a)

@@ -0,0 +1,148 @@+{-# LANGUAGE BangPatterns #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Stream.Future+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------++module Data.Stream.Future+  ( Future(..)+  , cons, (<|)+  , head+  , tail+  , length+  , tails+  , map+  , index+  ) where++import Prelude hiding (head, tail, map, length)+import Control.Applicative+import Control.Comonad+import Data.Foldable+import Data.Functor.Alt+import Data.Functor.Extend+import Data.Traversable+import Data.Semigroup hiding (Last)+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+#ifdef LANGUAGE_DeriveDataTypeable+import Data.Data+#endif++infixr 5 :<, <|++data Future a = Last a | a :< Future a deriving+  ( Eq, Ord, Show, Read+#ifdef LANGUAGE_DeriveDataTypeable+  , Data, Typeable+#endif+  )++(<|) :: a -> Future a -> Future a+(<|) = (:<)+{-# INLINE (<|) #-}++cons :: a -> Future a -> Future a+cons = (:<)+{-# INLINE cons #-}++head :: Future a -> a+head (Last a) = a+head (a :< _) = a+{-# INLINE head #-}++length :: Future a -> Int+length = go 1+  where+    go !n (Last _)  = n+    go !n (_ :< as) = go (n + 1) as+{-# INLINE length #-}++tail :: Future a -> Maybe (Future a)+tail (Last _) = Nothing+tail (_ :< as) = Just as+{-# INLINE tail #-}++tails :: Future a -> Future (Future a)+tails w@(_ :< as) = w :< tails as+tails w@(Last _)  = Last w+{-# INLINE tails #-}++map :: (a -> b) -> Future a -> Future b+map f (a :< as) = f a :< map f as+map f (Last a)  = Last (f a)+{-# INLINE map #-}++index :: Int -> Future a -> a+index n aas+  | n < 0 = error "index: negative index"+  | n == 0 = extract aas+  | otherwise = case aas of+    Last _ -> error "index: out of range"+    _ :< as -> index (n - 1) as++instance Functor Future where+  fmap = map+  b <$ (_ :< as) = b :< (b <$ as)+  b <$ _         = Last b++instance Foldable Future where+  foldMap = foldMapDefault++instance Traversable Future where+  traverse f (Last a)  = Last <$> f a+  traverse f (a :< as) = (:<) <$> f a <*> traverse f as++instance Foldable1 Future++instance Traversable1 Future where+  traverse1 f (Last a)  = Last <$> f a+  traverse1 f (a :< as) = (:<) <$> f a <.> traverse1 f as++instance Extend Future where+  extended = extend++instance Comonad Future where+  extract = head+  duplicate = tails+  extend f w@(_ :< as) = f w :< extend f as+  extend f w@(Last _)  = Last (f w)++instance Apply Future where+  Last f    <.> Last a    = Last (f a)+  (f :< _)  <.> Last a    = Last (f a)+  Last f    <.> (a :< _ ) = Last (f a)+  (f :< fs) <.> (a :< as) = f a :< (fs <.> as)++  Last a    <. _         = Last a+  (a :< _ ) <. Last _    = Last a+  (a :< as) <. (_ :< bs) = a :< (as <. bs)++  _          .> Last b   = Last b+  Last _     .> (b :< _) = Last b+  (_ :< as)  .> (b :< bs) = b :< (as .> bs)++instance ComonadApply Future where+  (<@>) = (<.>)++instance Alt Future where+  Last a    <!> bs = a :< bs+  (a :< as) <!> bs = a :< (as <!> bs)++instance Semigroup (Future a) where+  (<>) = (<!>)++instance Applicative Future where+  pure = Last+  (<*>) = (<.>)+  (<* ) = (<. )+  ( *>) = ( .>)++

@@ -0,0 +1,426 @@+{-# LANGUAGE PatternGuards, BangPatterns #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Stream.Future.Skew+-- Copyright   :  (C) 2008-2011 Edward Kmett,+--                (C) 2004 Dave Menendez+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- Anticausal streams implemented as non-empty skew binary random access lists+--+-- The Applicative zips streams, but since these are potentially infinite+-- this is stricter than would be desired. You almost always want+------------------------------------------------------------------------------+++module Data.Stream.Future.Skew+    ( Future(..)+    , (<|)      -- O(1)+    , cons+    , length    -- O(log n)+    , head      -- O(1)+    , tail      -- O(1)+    , tails+    , last      -- O(log n)+    , uncons    -- O(1)+    , index     -- O(log n)+    , drop      -- O(log n)+    , dropWhile -- O(n)+    , indexed+    , from+    , break+    , span+    , split     -- O(log n)+    , splitW    -- O(log n)+    , repeat+    , replicate -- O(log n)+    , insert    -- O(n)+    , insertBy+    , update+    , adjust    -- O(log n)+    , fromList+    , toFuture+    ) where++import Control.Applicative hiding (empty)+import Control.Comonad+import Data.Functor.Alt+import Data.Functor.Extend+import Data.Foldable hiding (toList)+import Data.Traversable (Traversable, traverse)+import Data.Semigroup hiding (Last)+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+import Prelude hiding (null, head, tail, drop, dropWhile, length, foldr, last, span, repeat, replicate, break)++infixr 5 :<, <|++data Complete a+    = Tip a+    | Bin {-# UNPACK #-} !Int a !(Complete a) !(Complete a)+    deriving Show++instance Functor Complete where+  fmap f (Tip a) = Tip (f a)+  fmap f (Bin w a l r) = Bin w (f a) (fmap f l) (fmap f r)++instance Extend Complete where+  extended = extend++instance Comonad Complete where+  extend f w@Tip {} = Tip (f w)+  extend f w@(Bin n _ l r) = Bin n (f w) (extend f l) (extend f r)+  extract (Tip a) = a+  extract (Bin _ a _ _) = a++instance Foldable Complete where+  foldMap f (Tip a) = f a+  foldMap f (Bin _ a l r) = f a `mappend` foldMap f l `mappend` foldMap f r+  foldr f z (Tip a) = f a z+  foldr f z (Bin _ a l r) = f a (foldr f (foldr f z r) l)++instance Foldable1 Complete where+  foldMap1 f (Tip a) = f a+  foldMap1 f (Bin _ a l r) = f a <> foldMap1 f l <> foldMap1 f r++instance Traversable Complete where+  traverse f (Tip a) = Tip <$> f a+  traverse f (Bin n a l r) = Bin n <$> f a <*> traverse f l <*> traverse f r++instance Traversable1 Complete where+  traverse1 f (Tip a) = Tip <$> f a+  traverse1 f (Bin n a l r) = Bin n <$> f a <.> traverse1 f l <.> traverse1 f r++bin :: a -> Complete a -> Complete a -> Complete a+bin a l r = Bin (1 + weight l + weight r) a l r+{-# INLINE bin #-}++weight :: Complete a -> Int+weight Tip{} = 1+weight (Bin w _ _ _) = w+{-# INLINE weight #-}++-- A future is a non-empty skew binary random access list of nodes.+-- The last node, however, is allowed to contain fewer values.+data Future a+  = Last !(Complete a)+  | !(Complete a) :< Future a+--  deriving Show+++instance Show a => Show (Future a) where+  showsPrec d as = showParen (d >= 10) $+    showString "fromList " . showsPrec 11 (toList as)++instance Functor Future where+  fmap f (t :< ts) = fmap f t :< fmap f ts+  fmap f (Last t) = Last (fmap f t)++instance Extend Future where+  extended = extend++instance Comonad Future where+  extend g (Last t)  = Last (extendTree g t Last)+  extend g (t :< ts) = extendTree g t (:< ts) :< extend g ts+  extract = head++extendTree :: (Future a -> b) -> Complete a -> (Complete a -> Future a) -> Complete b+extendTree g w@Tip{}         f = Tip (g (f w))+extendTree g w@(Bin n _ l r) f = Bin n (g (f w)) (extendTree g l (:< f r))  (extendTree g r f)++instance Apply Future where+  Last (Tip f)         <.> as                   = singleton (f (extract as))+  fs                   <.> Last (Tip a)         = singleton (extract fs a)+  Last (Bin _ f lf rf) <.> Last (Bin _ a la ra) = f a <| (lf :< Last rf  <.> la :< Last ra )+  Last (Bin _ f lf rf) <.> Bin _ a la ra :< as  = f a <| (lf :< Last rf  <.> la :< ra :< as)+  Last (Bin _ f lf rf) <.> Tip a :< as          = f a <| (lf :< Last rf  <.> as            )+  Bin _ f lf rf :< fs  <.> Last (Bin _ a la ra) = f a <| (lf :< rf :< fs <.> la :< Last ra )+  Bin _ f lf rf :< fs  <.> Tip a :< as          = f a <| (lf :< rf :< fs <.> as            )+  Bin _ f lf rf :< fs  <.> Bin _ a la ra :< as  = f a <| (lf :< rf :< fs <.> la :< ra :< as)+  Tip f :< fs          <.> Tip a :< as          = f a <| (fs             <.> as            )+  Tip f :< fs          <.> Bin _ a la ra :< as  = f a <| (fs             <.> la :< ra :< as)+  Tip f :< fs          <.> Last (Bin _ a la ra) = f a <| (fs             <.> la :< Last ra )++instance ComonadApply Future where+  (<@>) = (<.>)++instance Applicative Future where+  pure = repeat+  (<*>) = (<.>)++instance Alt Future where+  as <!> bs = foldr (<|) bs as++instance Foldable Future where+  foldMap f (t :< ts) = foldMap f t `mappend` foldMap f ts+  foldMap f (Last t) = foldMap f t+  foldr f z (t :< ts) = foldr f (foldr f z ts) t+  foldr f z (Last t) = foldr f z t++toList :: Future a -> [a]+toList = foldr (:) []++instance Foldable1 Future where+  foldMap1 f (t :< ts) = foldMap1 f t <> foldMap1 f ts+  foldMap1 f (Last t) = foldMap1 f t++instance Traversable Future where+  traverse f (t :< ts) = (:<) <$> traverse f t <*> traverse f ts+  traverse f (Last t) = Last <$> traverse f t++instance Traversable1 Future where+  traverse1 f (t :< ts) = (:<) <$> traverse1 f t <.> traverse1 f ts+  traverse1 f (Last t) = Last <$> traverse1 f t++repeat :: a -> Future a+repeat a0 = go a0 (Tip a0)+    where+      go :: a -> Complete a -> Future a+      go a as | ass <- bin a as as = as :< go a ass+{-# INLINE repeat #-}++-- | /O(log n)/+replicate :: Int -> a -> Future a+replicate n a+  | n <= 0    = error "replicate: non-positive argument"+  | otherwise = go 1 n a (Tip a) (\ _ r -> r)+  where+  -- invariants:+  -- tb is a complete tree of i nodes all equal to b+  -- 1 <= i = 2^m-1 <= j+  -- k accepts r such that 0 <= r < i+  go :: Int -> Int -> b -> Complete b -> (Int -> Future b -> r) -> r+  go !i !j b tb k+    | j >= i2p1 = go i2p1 j b (Bin i2p1 b tb tb) k'+    | j >= i2   = k (j - i2) (tb :< Last tb)+    | otherwise = k (j - i) (Last tb)+    where+      i2 = i * 2+      i2p1 = i2 + 1+      k' r xs+        | r >= i2   = k (r - i2) (tb :< tb :< xs)+        | r >= i    = k (r - i) (tb :< xs)+        | otherwise = k r xs+{-# INLINE replicate #-}++mapWithIndex :: (Int -> a -> b) -> Future a -> Future b+mapWithIndex f0 as0 = spine f0 0 as0+  where+    spine f m (Last as) = Last (tree f m as)+    spine f m (a :< as) = tree f m a :< spine f (m + weight a) as+    tree f m (Tip a) = Tip (f m a)+    tree f m (Bin n a l r) = Bin n (f m a) (tree f (m + 1) l) (tree f (m + 1 + weight l) r)++indexed :: Future a -> Future (Int, a)+indexed = mapWithIndex (,)+{-# INLINE indexed #-}++from :: Num a => a -> Future a+from a = mapWithIndex ((+) . fromIntegral) (pure a)+{-# INLINE from #-}++-- | /O(1)/+singleton :: a -> Future a+singleton a = Last (Tip a)+{-# INLINE singleton #-}++-- | /O(log n)/.+length :: Future a -> Int+length (Last t) = weight t+length (t :< ts) = weight t + length ts++-- | /O(1)/ cons+(<|) :: a -> Future a -> Future a+a <| (l :< Last r)+  | weight l == weight r = Last (bin a l r)+a <| (l :< r :< as)+  | weight l == weight r = bin a l r :< as+a <| as = Tip a :< as+{-# INLINE (<|) #-}+++cons :: a -> Future a -> Future a+cons = (<|)+{-# INLINE cons #-}++-- | /O(1)/+head :: Future a -> a+head (a :< _) = extract a+head (Last a) = extract a+{-# INLINE head #-}++-- | /O(1)/.+tail :: Future a -> Maybe (Future a)+tail (Tip{} :< ts) = Just ts+tail (Bin _ _ l r :< ts) = Just (l :< r :< ts)+tail (Last Tip{}) = Nothing+tail (Last (Bin _ _ l r)) = Just (l :< Last r)+{-# INLINE tail #-}++tails :: Future a -> Future (Future a)+tails = duplicate+{-# INLINE tails #-}++-- | /O(log n)/.+last :: Future a -> a+last (_ :< as) = last as+last (Last as) = go as+  where go (Tip a) = a+        go (Bin _ _ _ r) = go r++-- | /O(1)/.+uncons :: Future a -> (a, Maybe (Future a))+uncons (Last (Tip a))       = (a, Nothing)+uncons (Last (Bin _ a l r)) = (a, Just (l :< Last r))+uncons (Tip a       :< as)  = (a, Just as)+uncons (Bin _ a l r :< as)  = (a, Just (l :< r :< as))+{-# INLINE uncons #-}++-- | /O(log n)/.+index :: Int -> Future a -> a+index i (Last t)+  | i < weight t = indexComplete i t+  | otherwise    = error "index: out of range"+index i (t :< ts)+  | i < w     = indexComplete i t+  | otherwise = index (i - w) ts+  where w = weight t++indexComplete :: Int -> Complete a -> a+indexComplete 0 (Tip a) = a+indexComplete i (Bin w a l r)+  | i == 0    = a+  | i <= w'   = indexComplete (i-1) l+  | otherwise = indexComplete (i-1-w') r+  where w' = div w 2+indexComplete _ _ = error "index: index out of range"++-- | /O(log n)/.+drop :: Int -> Future a -> Maybe (Future a)+drop 0 ts = Just ts+drop i (t :< ts) = case compare i w of+  LT -> Just (dropComplete i t (:< ts))+  EQ -> Just ts+  GT -> drop (i - w) ts+  where w = weight t+drop i (Last t)+  | i < w     = Just (dropComplete i t Last)+  | otherwise = Nothing+  where w = weight t++dropComplete :: Int -> Complete a -> (Complete a -> Future a) -> Future a+dropComplete 0 t f             = f t+dropComplete 1 (Bin _ _ l r) f = l :< f r+dropComplete i (Bin w _ l r) f = case compare (i - 1) w' of+  LT -> dropComplete (i-1) l (:< f r)+  EQ -> f r+  GT -> dropComplete (i-1-w') r f+  where w' = div w 2+dropComplete _ _ _ = error "drop: index out of range"++-- /O(n)/.+dropWhile :: (a -> Bool) -> Future a -> Maybe (Future a)+dropWhile p as+  | p (head as) = tail as >>= dropWhile p+  | otherwise = Just as++-- /O(n)/+span :: (a -> Bool) -> Future a -> ([a], Maybe (Future a))+span p aas = case uncons aas of+  (a, Just as) | p a, (ts, fs) <- span p as -> (a:ts, fs)+  (a, Nothing) | p a                        -> ([a], Nothing)+  (_, _)                                    -> ([], Just aas)++-- /O(n)/+break :: (a -> Bool) -> Future a -> ([a], Maybe (Future a))+break p = span (not . p)++-- /(O(n), O(log n))/ split at _some_ edge where function goes from False to True.+-- best used with a monotonic function+split :: (a -> Bool) -> Future a -> ([a], Maybe (Future a))+split p l@(Last a)+  | p (extract a)  = ([], Just l)+  | otherwise      = splitComplete p a Last+split p (a :< as)+  | p (extract as) = splitComplete p a (:< as)+  | (ts, fs) <- split p as = (foldr (:) ts a, fs)++-- for use when we know the split occurs within a given tree+splitComplete :: (a -> Bool) -> Complete a -> (Complete a -> Future a) -> ([a], Maybe (Future a))+splitComplete p t@(Tip a) f+  | p a       = ([], Just (f t))+  | otherwise = ([a], Nothing)+splitComplete p t@(Bin _ a l r) f+  | p a                                               = ([], Just (f t))+  | p (extract r), (ts, fs) <- splitComplete p l (:< f r) = (a:ts, fs)+  |                (ts, fs) <- splitComplete p r f        = (a:foldr (:) ts l, fs)++-- /(O(n), O(log n))/ split at _some_ edge where function goes from False to True.+-- best used with a monotonic function+--+-- > splitW p xs = (map extract &&& fmap (fmap extract)) . split p . duplicate+splitW :: (Future a -> Bool) -> Future a -> ([a], Maybe (Future a))+splitW p l@(Last a)+  | p l       = ([], Just l)+  | otherwise = splitCompleteW p a Last+splitW p (a :< as)+  | p as                    = splitCompleteW p a (:< as)+  | (ts, fs) <- splitW p as = (foldr (:) ts a, fs)++-- for use when we know the split occurs within a given tree+splitCompleteW :: (Future a -> Bool) -> Complete a -> (Complete a -> Future a) -> ([a], Maybe (Future a))+splitCompleteW p t@(Tip a) f+  | w <- f t, p w = ([], Just w)+  | otherwise = ([a], Nothing)+splitCompleteW p t@(Bin _ a l r) f+  | w <- f t, p w                                    = ([], Just w)+  | w <- f r, p w, (ts, fs) <- splitCompleteW p l (:< w) = (a:ts, fs)+  |                (ts, fs) <- splitCompleteW p r f      = (a:foldr (:) ts l, fs)++fromList :: [a] -> Future a+fromList [] = error "fromList: empty list"+fromList (x:xs) = go x xs+  where go a [] = singleton a+        go a (b:bs) = a <| go b bs++toFuture :: [a] -> Maybe (Future a)+toFuture [] = Nothing+toFuture xs = Just (fromList xs)++-- /O(n)/+insert :: Ord a => a -> Future a -> Future a+insert a as = case split (a<=) as of+    (_, Nothing)  -> foldr (<|) (singleton a) as+    (ts, Just as') -> foldr (<|) (a <| as') ts++-- /O(n)/. Finds the split in O(log n), but then has to recons+insertBy :: (a -> a -> Ordering) -> a -> Future a -> Future a+insertBy cmp a as = case split (\b -> cmp a b <= EQ) as of+    (_, Nothing)  -> foldr (<|) (singleton a) as+    (ts, Just as') -> foldr (<|) (a <| as') ts++-- /O(log n)/ Change the value of the nth entry in the future+adjust :: Int -> (a -> a) -> Future a -> Future a+adjust !n f d@(Last a)+  | n < weight a = Last (adjustComplete n f a)+  | otherwise = d+adjust !n f (a :< as)+  | n < w = adjustComplete n f a :< as+  | otherwise = a :< adjust (n - w) f as+  where w = weight a++adjustComplete :: Int -> (a -> a) -> Complete a -> Complete a+adjustComplete 0 f (Tip a) = Tip (f a)+adjustComplete _ _ t@Tip{} = t+adjustComplete n f (Bin m a l r)+  | n == 0 = Bin m (f a) l r+  | n < w = Bin m a (adjustComplete (n - 1) f l) r+  | otherwise = Bin m a l (adjustComplete (n - 1 - w) f r)+  where w = weight l++update :: Int -> a -> Future a -> Future a+update n = adjust n . const

@@ -0,0 +1,455 @@+{-# LANGUAGE PatternGuards #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Stream.Infinite+-- Copyright   :  (C) 2011 Edward Kmett,+--                (C) 2007-2010 Wouter Swierstra, Bas van Dijk+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable (Haskell 2010)+--+----------------------------------------------------------------------------+module Data.Stream.Infinite (+   -- * The type of streams+     Stream(..)+   -- * Basic functions+   , head   -- :: Stream a -> a+   , tail   -- :: Stream a -> Stream a+   , inits  -- :: Stream a -> Stream [a]+   , tails  -- :: Stream a -> Stream (Stream a)+   -- * Stream transformations+   , map         -- :: (a -> b) -> Stream a -> Stream b+   , intersperse -- :: a -> Stream a -> Stream+   , interleave  -- :: Stream a -> Stream a -> Stream a+   , scanl       -- :: (b -> a -> b) -> b -> Stream a -> Stream b+   , scanl'      -- :: (b -> a -> b) -> b -> Stream a -> Stream b+   , scanl1      -- :: (a -> a -> a) -> Stream a -> Stream a+   , scanl1'     -- :: (a -> a -> a) -> Stream a -> Stream a+   , transpose   -- :: Stream (Stream a) -> Stream (Stream a)+   -- * Building streams+   , iterate     -- :: (a -> a) -> a -> Stream a+   , repeat      -- :: a -> Stream a+   , cycle       -- :: NonEmpty a -> Stream a+   , unfold      -- :: (a -> (b, a)) -> a -> Stream b+   -- * Extracting sublists+   , take        -- :: Int -> Stream a -> [a]+   , drop        -- :: Int -> Stream a -> Stream a+   , splitAt     -- :: Int -> Stream a -> ([a],Stream a)+   , takeWhile   -- :: (a -> Bool) -> Stream a -> [a]+   , dropWhile   -- :: (a -> Bool) -> Stream a -> Stream a+   , span        -- :: (a -> Bool) -> Stream a -> ([a], Stream a)+   , break       -- :: (a -> Bool) -> Stream a -> ([a], Stream a)+   , filter      -- :: (a -> Bool) -> Stream a -> Stream a+   , partition   -- :: (a -> Bool) -> Stream a -> (Stream a, Stream a)+   , group       -- :: (a -> Bool) -> Stream a -> Stream (NonEmpty a)+   , groupBy     -- :: (a -> a -> Bool) -> Stream a -> Stream (NonEmpty a)+   -- * Sublist predicates+   , isPrefixOf  -- :: [a] -> Stream a -> Bool+   -- * Indexing streams +   , (!!)        -- :: Int -> Stream a -> a+   , elemIndex   -- :: Eq a => a -> Stream a -> Int+   , elemIndices -- :: Eq a => a -> Stream a -> Stream Int+   , findIndex   -- :: (a -> Bool) -> Stream a -> Int+   , findIndices -- :: (a -> Bool) -> Stream a -> Stream Int+   -- * Zipping and unzipping streams+   , zip         -- :: Stream a -> Stream b -> Stream (a, b)+   , zipWith     -- :: (a -> b -> c) -> Stream a -> Stream b -> Stream c+   , unzip       -- :: Functor f => f (a, b) -> (f a, f b)+   -- * Functions on streams of characters+   , words       -- :: Stream Char -> Stream String+   , unwords     -- :: Stream String -> Stream Char+   , lines       -- :: Stream Char -> Stream String+   , unlines     -- :: Stream String -> Stream Char+   -- * Converting to and from an infinite list+   , fromList    -- :: [a] -> Stream a+   ) where++import Prelude hiding +  ( head, tail, map, scanr, scanr1, scanl, scanl1+  , iterate, take, drop, takeWhile+  , dropWhile, repeat, cycle, filter+  , (!!), zip, unzip, zipWith, words+  , unwords, lines, unlines, break, span+  , splitAt, foldr+  )++import Control.Applicative+import Control.Comonad+import Data.Char (isSpace)+import Data.Data+import Data.Functor.Apply+import Data.Functor.Extend+import Data.Semigroup+import Data.Foldable+import Data.Traversable+import Data.Distributive+import Data.Semigroup.Traversable+import Data.Semigroup.Foldable+import Data.List.NonEmpty (NonEmpty(..))++data Stream a = a :> Stream a deriving +  ( Show+#ifdef LANGUAGE_DeriveDataTypeable+  , Data, Typeable+#endif+  )++infixr 5 :>++-- | Map a pure function over a stream+map :: (a -> b) -> Stream a -> Stream b+map f (a :> as) = f a :> map f as++instance Functor Stream where+  fmap = map+  b <$ _ = repeat b++instance Distributive Stream where+  distribute w = fmap head w :> distribute (fmap tail w)++-- | Extract the first element of the sequence.+head :: Stream a -> a+head (a :> _) = a+{-# INLINE head #-}++-- | Extract the sequence following the head of the stream.+tail :: Stream a -> Stream a+tail (_ :> as) = as+{-# INLINE tail #-}++-- | The 'tails' function takes a stream @xs@ and returns all the+-- suffixes of @xs@.+tails :: Stream a -> Stream (Stream a)+tails w = w :> tails (tail w)++instance Extend Stream where+  duplicated = tails+  extended f w = f w :> extended f (tail w)++instance Comonad Stream where+  duplicate = tails+  extend f w = f w :> extend f (tail w)+  extract = head++instance Apply Stream where+  (f :> fs) <.> (a :> as) = f a :> (fs <.> as)+  as        <.  _         = as+  _          .> bs        = bs++instance ComonadApply Stream where+  (f :> fs) <@> (a :> as) = f a :> (fs <@> as)+  as        <@  _         = as+  _          @> bs        = bs++-- | 'repeat' @x@ returns a constant stream, where all elements are+-- equal to @x@.+repeat :: a -> Stream a+repeat a = as where as = a :> as++instance Applicative Stream where+  pure = repeat+  (<*>) = (<.>)+  (<* ) = (<. )+  ( *>) = ( .>)++instance Foldable Stream where+  fold (m :> ms) = m `mappend` fold ms+  foldMap f (a :> as) = f a `mappend` foldMap f as+  foldr f0 _ = go f0 where go f (a :> as) = f a (go f as)++instance Traversable Stream where+  traverse f ~(a :> as) = (:>) <$> f a <*> traverse f as++instance Foldable1 Stream++instance Traversable1 Stream where+  traverse1 f ~(a :> as) = (:>) <$> f a <.> traverse1 f as+  sequence1 ~(a :> as) = (:>) <$> a <.> sequence1 as++-- | The unfold function is similar to the unfold for lists. Note+-- there is no base case: all streams must be infinite.+unfold :: (a -> (b, a)) -> a -> Stream b+unfold f c | (x, d) <- f c = x :> unfold f d++instance Monad Stream where+  return = repeat+  m >>= f = unfold (\(bs :> bss) -> (head bs, tail <$> bss)) (fmap f m)+  _ >> bs = bs++-- | Interleave two Streams @xs@ and @ys@, alternating elements+-- from each list.+--+-- > [x1,x2,...] `interleave` [y1,y2,...] == [x1,y1,x2,y2,...]+interleave :: Stream a -> Stream a -> Stream a+interleave ~(x :> xs) ys = x :> interleave ys xs++instance Semigroup (Stream a) where+  (<>) = interleave++-- | The 'inits' function takes a stream @xs@ and returns all the+-- finite prefixes of @xs@.+--+-- Note that this 'inits' is lazier then @Data.List.inits@:+--+-- > inits _|_ = [] ::: _|_+--+-- while for @Data.List.inits@:+--+-- > inits _|_ = _|_+inits :: Stream a -> Stream [a]+inits xs = [] :> ((head xs :) <$> inits (tail xs))++-- | @'intersperse' y xs@ creates an alternating stream of+-- elements from @xs@ and @y@.+intersperse :: a -> Stream a -> Stream a+intersperse y ~(x :> xs) = x :> y :> intersperse y xs++-- | 'scanl' yields a stream of successive reduced values from:+--+-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]+scanl :: (a -> b -> a) -> a -> Stream b -> Stream a+scanl f z ~(x :> xs) = z :> scanl f (f z x) xs++-- | 'scanl' yields a stream of successive reduced values from:+--+-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]+scanl' :: (a -> b -> a) -> a -> Stream b -> Stream a+scanl' f z ~(x :> xs) = z :> (scanl' f $! f z x) xs++-- | 'scanl1' is a variant of 'scanl' that has no starting value argument:+--+-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]+scanl1 :: (a -> a -> a) -> Stream a -> Stream a+scanl1 f ~(x :> xs) = scanl f x xs++-- | @scanl1'@ is a strict 'scanl' that has no starting value.+scanl1' :: (a -> a -> a) -> Stream a -> Stream a+scanl1' f ~(x :> xs) = scanl' f x xs++-- | 'transpose' computes the transposition of a stream of streams.+transpose :: Stream (Stream a) -> Stream (Stream a)+transpose ~((x :> xs) :> yss) =+  (x :> (head <$> yss)) :> transpose (xs :> (tail <$> yss))++-- | @'iterate' f x@ produces the infinite sequence+-- of repeated applications of @f@ to @x@.+--+-- > iterate f x = [x, f x, f (f x), ..]+iterate :: (a -> a) -> a -> Stream a+iterate f x = x :> iterate f (f x)++-- | @'cycle' xs@ returns the infinite repetition of @xs@:+--+-- > cycle [1,2,3] = Cons 1 (Cons 2 (Cons 3 (Cons 1 (Cons 2 ...+cycle :: NonEmpty a -> Stream a+cycle xs = ys where ys = foldr (:>) ys xs++-- | @'take' n xs@ returns the first @n@ elements of @xs@.+--+-- /Beware/: passing a negative integer as the first argument will+-- cause an error.+take :: Int -> Stream a -> [a]+take n ~(x :> xs)+  | n == 0 = []+  | n > 0 = x : take (n - 1) xs+  | otherwise = error "Stream.take: negative argument"++-- | @'drop' n xs@ drops the first @n@ elements off the front of+-- the sequence @xs@.+--+-- /Beware/: passing a negative integer as the first argument will+-- cause an error.+drop :: Int -> Stream a -> Stream a+drop n xs+  | n == 0 = xs+  | n > 0 = drop (n - 1) (tail xs)+  | otherwise = error "Stream.drop: negative argument"++-- | @'splitAt' n xs@ returns a pair consisting of the prefix of +-- @xs@ of length @n@ and the remaining stream immediately following +-- this prefix.+--+-- /Beware/: passing a negative integer as the first argument will+-- cause an error.+splitAt :: Int -> Stream a -> ([a],Stream a)+splitAt n xs+  | n == 0 = ([],xs)+  | n > 0, (prefix, rest) <- splitAt (n - 1) (tail xs) = (head xs : prefix, rest)+  | otherwise = error "Stream.splitAt: negative argument"++-- | @'takeWhile' p xs@ returns the longest prefix of the stream+-- @xs@ for which the predicate @p@ holds.+takeWhile :: (a -> Bool) -> Stream a -> [a]+takeWhile p (x :> xs) +  | p x = x : takeWhile p xs+  | otherwise = []++-- | @'dropWhile' p xs@ returns the suffix remaining after+-- @'takeWhile' p xs@.+--+-- /Beware/: this function may diverge if every element of @xs@+-- satisfies @p@, e.g.  @dropWhile even (repeat 0)@ will loop.+dropWhile :: (a -> Bool) -> Stream a -> Stream a+dropWhile p ~(x :> xs)+  | p x = dropWhile p xs+  | otherwise = x :> xs++-- | @'span' p xs@ returns the longest prefix of @xs@ that satisfies+-- @p@, together with the remainder of the stream.+span :: (a -> Bool) -> Stream a -> ([a], Stream a)+span p xxs@(x :> xs)+  | p x, (ts, fs) <- span p xs = (x : ts, fs)+  | otherwise = ([], xxs)++-- | The 'break' @p@ function is equivalent to 'span' @not . p@.+break :: (a -> Bool) -> Stream a -> ([a], Stream a)+break p = span (not . p)++-- | @'filter' p xs@, removes any elements from @xs@ that do not satisfy @p@.+--+-- /Beware/: this function may diverge if there is no element of+-- @xs@ that satisfies @p@, e.g.  @filter odd (repeat 0)@ will loop.+filter :: (a -> Bool) -> Stream a -> Stream a+filter p ~(x :> xs) +  | p x       = x :> filter p xs+  | otherwise = filter p xs++-- | The 'partition' function takes a predicate @p@ and a stream+-- @xs@, and returns a pair of streams. The first stream corresponds+-- to the elements of @xs@ for which @p@ holds; the second stream+-- corresponds to the elements of @xs@ for which @p@ does not hold.+--+-- /Beware/: One of the elements of the tuple may be undefined. For+-- example, @fst (partition even (repeat 0)) == repeat 0@; on the+-- other hand @snd (partition even (repeat 0))@ is undefined.+partition :: (a -> Bool) -> Stream a -> (Stream a, Stream a)+partition p ~(x :> xs)+  | p x = (x :> ts, fs)+  | otherwise = (ts, x :> fs)+  where (ts, fs) = partition p xs++-- | The 'group' function takes a stream and returns a stream of+-- lists such that flattening the resulting stream is equal to the+-- argument.  Moreover, each sublist in the resulting stream+-- contains only equal elements.  For example,+--+-- > group $ cycle "Mississippi" = "M" ::: "i" ::: "ss" ::: "i" ::: "ss" ::: "i" ::: "pp" ::: "i" ::: "M" ::: "i" ::: ...+group :: Eq a => Stream a -> Stream (NonEmpty a)+group = groupBy (==)++groupBy :: (a -> a -> Bool) -> Stream a -> Stream (NonEmpty a)+groupBy eq ~(x :> ys) +  | (xs, zs) <- span (eq x) ys +  = (x :| xs) :> groupBy eq zs++-- | The 'isPrefix' function returns @True@ if the first argument is+-- a prefix of the second.+isPrefixOf :: Eq a => [a] -> Stream a -> Bool+isPrefixOf [] _ = True+isPrefixOf (y:ys) (x :> xs)+  | y == x    = isPrefixOf ys xs+  | otherwise = False++-- | @xs !! n@ returns the element of the stream @xs@ at index+-- @n@. Note that the head of the stream has index 0.+--+-- /Beware/: passing a negative integer as the first argument will cause+-- an error.+(!!) :: Stream a -> Int -> a+(!!) (x :> xs) n+  | n == 0    = x+  | n > 0     = xs !! (n - 1)+  | otherwise = error "Stream.!! negative argument"++-- | The 'elemIndex' function returns the index of the first element+-- in the given stream which is equal (by '==') to the query element,+--+-- /Beware/: @'elemIndex' x xs@ will diverge if none of the elements+-- of @xs@ equal @x@.+elemIndex :: Eq a => a -> Stream a -> Int+elemIndex x = findIndex (\y -> x == y)++-- | The 'elemIndices' function extends 'elemIndex', by returning the+-- indices of all elements equal to the query element, in ascending order.+--+-- /Beware/: 'elemIndices' @x@ @xs@ will diverge if any suffix of+-- @xs@ does not contain @x@.+elemIndices :: Eq a => a -> Stream a -> Stream Int+elemIndices x = findIndices (x==)++-- | The 'findIndex' function takes a predicate and a stream and returns+-- the index of the first element in the stream that satisfies the predicate,+--+-- /Beware/: 'findIndex' @p@ @xs@ will diverge if none of the elements of+-- @xs@ satisfy @p@.+findIndex :: (a -> Bool) -> Stream a -> Int+findIndex p = indexFrom 0+    where+    indexFrom ix (x :> xs) +      | p x       = ix+      | otherwise = (indexFrom $! (ix + 1)) xs++-- | The 'findIndices' function extends 'findIndex', by returning the+-- indices of all elements satisfying the predicate, in ascending+-- order.+--+-- /Beware/: 'findIndices' @p@ @xs@ will diverge if all the elements+-- of any suffix of @xs@ fails to satisfy @p@.+findIndices :: (a -> Bool) -> Stream a -> Stream Int+findIndices p = indicesFrom 0 where+  indicesFrom ix (x :> xs) +    | p x = ix :> ixs +    | otherwise = ixs+    where ixs = (indicesFrom $! (ix+1)) xs++-- | The 'zip' function takes two streams and returns a list of+-- corresponding pairs.+zip :: Stream a -> Stream b -> Stream (a,b)+zip ~(x :> xs) ~(y :> ys) = (x,y) :> zip xs ys++-- | The 'zipWith' function generalizes 'zip'. Rather than tupling+-- the functions, the elements are combined using the function+-- passed as the first argument to 'zipWith'.+zipWith :: (a -> b -> c) -> Stream a -> Stream b -> Stream c+zipWith f ~(x :> xs) ~(y :> ys) = f x y :> zipWith f xs ys++-- | The 'unzip' function is the inverse of the 'zip' function.+unzip :: Stream (a,b) -> (Stream a, Stream b)+unzip xs = (fst <$> xs, snd <$> xs)++-- | The 'words' function breaks a stream of characters into a+-- stream of words, which were delimited by white space.+--+-- /Beware/: if the stream of characters @xs@ does not contain white+-- space, accessing the tail of @words xs@ will loop.+words :: Stream Char -> Stream String+words xs | (w, ys) <- break isSpace xs = w :> words ys++-- | The 'unwords' function is an inverse operation to 'words'. It+-- joins words with separating spaces.+unwords :: Stream String -> Stream Char+unwords ~(x :> xs) = foldr (:>) (' ' :> unwords xs) x++-- | The 'lines' function breaks a stream of characters into a list+-- of strings at newline characters. The resulting strings do not+-- contain newlines.+--+-- /Beware/: if the stream of characters @xs@ does not contain+-- newline characters, accessing the tail of @lines xs@ will loop.+lines :: Stream Char -> Stream String+lines xs | (l, ys) <- break (== '\n') xs = l :> lines (tail ys)++-- | The 'unlines' function is an inverse operation to 'lines'. It+-- joins lines, after appending a terminating newline to each.+unlines :: Stream String -> Stream Char+unlines ~(x :> xs) = foldr (:>) ('\n' :> unlines xs) x++-- | The 'fromList' converts an infinite list to a+-- stream.+--+-- /Beware/: Passing a finite list, will cause an error.+fromList :: [a] -> Stream a+fromList (x:xs) = x :> fromList xs+fromList []     = error "Stream.listToStream applied to finite list"

@@ -0,0 +1,334 @@+{-# LANGUAGE CPP, PatternGuards, BangPatterns #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Zipper.Infinite.Functional.Zipper+-- Copyright   :  (C) 2011 Edward Kmett,+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- This is an infinite bidirectional zipper+----------------------------------------------------------------------------+module Data.Stream.Infinite.Functional.Zipper (+   -- * The type of streams+     Zipper(..)+   , tail   -- :: Zipper a -> Zipper a+   , untail -- :: Zipper a -> Zipper a +   , intersperse -- :: a -> Zipper a -> Zipper a+   , interleave  -- :: Zipper a -> Zipper a -> Zipper a+   , transpose   -- :: Zipper (Zipper a) -> Zipper (Zipper a)+   , take        -- :: Integer -> Zipper a -> [a]+   , drop        -- :: Integer -> Zipper a -> Zipper a -- you can drop a negative number+   , splitAt     -- :: Integer -> Zipper a -> ([a],Zipper a)+   , reverse     -- :: Zipper a -> Zipper a+   , (!!)        -- :: Int -> Zipper a -> a+   , unzip       -- :: Functor f => f (a, b) -> (f a, f b)+   , toSequence  -- :: (Integer -> a) -> Zipper a+   , head+   , (<|)+   , uncons+   , takeWhile+   , dropWhile+   , span+   , break+   , isPrefixOf+   , findIndex+   , elemIndex+   , zip+   , zipWith+   ) where++import Prelude hiding +  ( head, tail, map, scanr, scanr1, scanl, scanl1+  , iterate, take, drop, takeWhile+  , dropWhile, repeat, cycle, filter+  , (!!), zip, unzip, zipWith, words+  , unwords, lines, unlines, break, span+  , splitAt, foldr+  )++import Control.Applicative+import Control.Comonad+-- import Data.Char (isSpace)+#ifdef LANGUAGE_DeriveDataTypeable+import Data.Data+#endif+import Data.Functor.Extend+import Data.Functor.Apply+-- import Data.Monoid+import Data.Semigroup+-- import Data.Foldable+-- import Data.Traversable+-- import Data.Semigroup.Traversable+-- import Data.Semigroup.Foldable+-- import Data.Zipper.NonEmpty (NonEmpty(..))++data Zipper a = !Integer :~ !(Integer -> a)+#ifdef LANGUAGE_DeriveDataTypeable+  deriving Typeable+#endif++toSequence :: (Integer -> a) -> Zipper a+toSequence = (0 :~) ++infixr 0 :~++instance Functor Zipper where+  fmap g (n :~ f) = n :~ g . f+  b <$ _ = 0 :~ const b++-- | Extract the focused element+head :: Zipper a -> a+head (n :~ f) = f n++-- | Move the head of the zipper to the right+tail :: Zipper a -> Zipper a+tail (n :~ f) = n + 1 :~ f++-- | Move the head of the zipper to the left+untail :: Zipper a -> Zipper a+untail (n :~ f) = n - 1 :~ f++-- | Cons before the head of the zipper. The head now points to the new element+(<|) :: a -> Zipper a -> Zipper a+a <| (n :~ f) = n :~ \z -> case compare z n of+  LT -> f n+  EQ -> a+  GT -> f (n - 1)++-- | Move the head of the zipper one step to the right, returning the value we move over.+uncons :: Zipper a -> (a, Zipper a)+uncons (n :~ f) = (f n, n + 1 :~ f)++instance Extend Zipper where+  duplicated (n :~ f) = n :~ (:~ f)++instance Comonad Zipper where+  duplicate (n :~ f) = n :~ (:~ f)+  extract (n :~ f) = f n++instance Apply Zipper where+  (nf :~ f) <.> (na :~ a) +    | dn <- na - nf+    = nf :~ \n -> f n (a (n + dn))+  as        <.  _         = as+  _          .> bs        = bs++instance ComonadApply Zipper where+  (<@>) = (<.>)+  (<@) = (<.)+  (@>) = (.>)+++instance Applicative Zipper where+  pure = repeat+  (<*>) = (<.>)+  as <* _ = as+  _ *> bs = bs++instance Monad Zipper where+  return = repeat+  (z :~ ma) >>= f = z :~ \ na -> case f (ma na) of+    nb :~ mb -> mb (nb + na - z)++repeat :: a -> Zipper a+repeat a = 0 :~ const a++-- | Interleave two Zippers @xs@ and @ys@, alternating elements+-- from each list.+--+-- > [x1,x2,...] `interleave` [y1,y2,...] == [x1,y1,x2,y2,...]+-- > interleave = (<>) +interleave :: Zipper a -> Zipper a -> Zipper a+interleave = (<>) +instance Semigroup (Zipper a) where+  (n :~ a) <> (m :~ b) = 0 :~ \p -> case quotRem p 2 of +    (q, 0) -> a (n + q)+    (q, _) -> b (m + q)++-- | @'intersperse' y xs@ creates an alternating stream of+-- elements from @xs@ and @y@.+intersperse :: a -> Zipper a -> Zipper a+intersperse y z = z <> repeat y++-- | 'transpose' computes the transposition of a stream of streams.+transpose :: Zipper (Zipper a) -> Zipper (Zipper a)+transpose (n :~ f) = 0 :~ \z -> n :~ \n' -> let m :~ g = f n' in g (m + z)++take :: Integer -> Zipper a -> [a]+take n0 (m0 :~ f0)+  | n0 < 0 = error "Zipper.take: negative argument"+  | otherwise = go n0 m0 f0+  where+    go 0 !_ !_ = []+    go n  m  f = f m : go (n - 1) (m + 1) f+  +-- | @'drop' n xs@ drops the first @n@ elements off the front of+-- the sequence @xs@.+drop :: Integer -> Zipper a -> Zipper a+drop m (n :~ f) = m + n :~ f++-- | @'splitAt' n xs@ returns a pair consisting of the prefix of +-- @xs@ of length @n@ and the remaining stream immediately following +-- this prefix.+--+-- /Beware/: passing a negative integer as the first argument will+-- cause an error if you access the taken portion+splitAt :: Integer -> Zipper a -> ([a],Zipper a)+splitAt n xs = (take n xs, drop n xs)++-- | @'takeWhile' p xs@ returns the longest prefix of the stream+-- @xs@ for which the predicate @p@ holds.+takeWhile :: (a -> Bool) -> Zipper a -> [a]+takeWhile p0 (n0 :~ f0) = go p0 n0 f0 where +  go !p !n !f +    | x <- f n, p x = x : go p (n + 1) f+    | otherwise = []++-- | @'dropWhile' p xs@ returns the suffix remaining after+-- @'takeWhile' p xs@.+--+-- /Beware/: this function may diverge if every element of @xs@+-- satisfies @p@, e.g.  @dropWhile even (repeat 0)@ will loop.+dropWhile :: (a -> Bool) -> Zipper a -> Zipper a+dropWhile p xs@(_ :~ f) = findIndex' p xs :~ f++-- | @'span' p xs@ returns the longest prefix of @xs@ that satisfies+-- @p@, together with the remainder of the stream.+span :: (a -> Bool) -> Zipper a -> ([a], Zipper a)+span p0 (n0 :~ f0) +  | (ts, n') <- go p0 n0 f0 = (ts, n' :~ f0) where+  go !p !n !f+    | x <- f n, p x, (ts, fs) <- go p (n + 1) f = (x:ts, fs)+    | otherwise = ([], n)++-- | The 'break' @p@ function is equivalent to 'span' @not . p@.+break :: (a -> Bool) -> Zipper a -> ([a], Zipper a)+break p = span (not . p)++-- | The 'isPrefix' function returns @True@ if the first argument is+-- a prefix of the second.+isPrefixOf :: Eq a => [a] -> Zipper a -> Bool+isPrefixOf xs0 (n0 :~ f0) = go xs0 n0 f0 where+  go [] !_ !_ = True+  go (y:ys) n f = y == f n && go ys (n + 1) f++-- | @xs !! n@ returns the element of the stream @xs@ at index+-- @n@. Note that the head of the stream has index 0.+--+-- /Beware/: passing a negative integer as the first argument will cause+-- an error.+(!!) :: Zipper a -> Integer -> a+(!!) (n :~ f) m = f (n + m)++-- | The 'findIndex' function takes a predicate and a stream and returns+-- the index of the first element in the stream that satisfies the predicate,+--+-- /Beware/: 'findIndex' @p@ @xs@ will diverge if none of the elements of+-- @xs@ satisfy @p@.+findIndex :: (a -> Bool) -> Zipper a -> Integer+findIndex p0 (n0 :~ f0) = go p0 n0 f0 - n0 where+  go !p !n !f +    | x <- f n, p x = n+    | otherwise = go p (n + 1) f++-- | Internal helper, used to find an index in the +findIndex' :: (a -> Bool) -> Zipper a -> Integer+findIndex' p0 (n0 :~ f0) = go p0 n0 f0 where+  go !p !n !f +    | x <- f n, p x = n+    | otherwise = go p (n + 1) f++-- | The 'elemIndex' function returns the index of the first element+-- in the given stream which is equal (by '==') to the query element,+--+-- /Beware/: @'elemIndex' x xs@ will diverge if none of the elements+-- of @xs@ equal @x@.+elemIndex :: Eq a => a -> Zipper a -> Integer+elemIndex = findIndex . (==)++{-+-- | The 'elemIndices' function extends 'elemIndex', by returning the+-- indices of all elements equal to the query element, in ascending order.+--+-- /Beware/: 'elemIndices' @x@ @xs@ will diverge if any suffix of+-- @xs@ does not contain @x@.+elemIndices :: Eq a => a -> Zipper a -> Zipper Int+elemIndices x = findIndices (x==)+-}++-- | The 'zip' function takes two streams and returns a list of+-- corresponding pairs.+--+-- > zip = liftA2 (,)+zip :: Zipper a -> Zipper b -> Zipper (a,b)+zip = liftA2 (,)++-- | The 'zipWith' function generalizes 'zip'. Rather than tupling+-- the functions, the elements are combined using the function+-- passed as the first argument to 'zipWith'.+--+-- > zipWith = liftA2+zipWith :: (a -> b -> c) -> Zipper a -> Zipper b -> Zipper c+zipWith = liftA2++-- | The 'unzip' function is the inverse of the 'zip' function.+unzip :: Zipper (a,b) -> (Zipper a, Zipper b)+unzip xs = (fst <$> xs, snd <$> xs)++++{-++-- | The 'findIndices' function extends 'findIndex', by returning the+-- indices of all elements satisfying the predicate, in ascending+-- order.+--+-- /Beware/: 'findIndices' @p@ @xs@ will diverge if all the elements+-- of any suffix of @xs@ fails to satisfy @p@.+findIndices :: (a -> Bool) -> Zipper a -> Zipper Int+findIndices p = indicesFrom 0 where+  indicesFrom ix (x :< xs) +    | p x = ix :< ixs +    | otherwise = ixs+    where ixs = (indicesFrom $! (ix+1)) xs+++-- | The 'words' function breaks a stream of characters into a+-- stream of words, which were delimited by white space.+--+-- /Beware/: if the stream of characters @xs@ does not contain white+-- space, accessing the tail of @words xs@ will loop.+words :: Zipper Char -> Zipper String+words xs | (w, ys) <- break isSpace xs = w :< words ys++-- | The 'unwords' function is an inverse operation to 'words'. It+-- joins words with separating spaces.+unwords :: Zipper String -> Zipper Char+unwords ~(x :< xs) = foldr (:<) (' ' :< unwords xs) x++-- | The 'lines' function breaks a stream of characters into a list+-- of strings at newline characters. The resulting strings do not+-- contain newlines.+--+-- /Beware/: if the stream of characters @xs@ does not contain+-- newline characters, accessing the tail of @lines xs@ will loop.+lines :: Zipper Char -> Zipper String+lines xs | (l, ys) <- break (== '\n') xs = l :< lines (tail ys)++-- | The 'unlines' function is an inverse operation to 'lines'. It+-- joins lines, after appending a terminating newline to each.+unlines :: Zipper String -> Zipper Char+unlines ~(x :< xs) = foldr (:<) ('\n' :< unlines xs) x++-- | The 'fromList' converts an infinite list to a+-- stream.+--+-- /Beware/: Passing a finite list, will cause an error.+fromList :: [a] -> Zipper a+fromList (x:xs) = x :< fromList xs+fromList []     = error "Zipper.listToZipper applied to finite list"++-}

@@ -0,0 +1,348 @@+{-# LANGUAGE PatternGuards, BangPatterns #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Stream.Infinite.Skew+-- Copyright   :  (C) 2011 Edward Kmett,+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- Anticausal streams implemented as non-empty skew binary random access lists+-- +-- The Applicative zips streams, the monad diagonalizes+------------------------------------------------------------------------------+++module Data.Stream.Infinite.Skew +    ( Stream+    , (<|)      -- O(1)+    , (!!)+    , head      -- O(1)+    , tail      -- O(1)+    , tails+    , uncons    -- O(1)+    , index     -- O(log n)+    , drop      -- O(log n)+    , dropWhile -- O(n)+    , span+    , break+    , split+    , splitW+    , repeat   +    , insert    -- O(n)+    , insertBy+    , adjust    -- O(log n)+    , update    -- O(log n)+    , fromList+    , from+    , indexed+    , interleave+    , tabulate+    ) where ++import Control.Arrow (first)+import Control.Applicative hiding (empty)+import Control.Comonad+import Data.Distributive+import Data.Functor.Alt+import Data.Functor.Extend+import Data.Foldable hiding (toList)+import Data.Traversable+import Data.Semigroup hiding (Last)+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+import Prelude hiding (null, head, tail, drop, dropWhile, length, foldr, last, span, repeat, replicate, (!!), break)++infixr 5 :<, <|++data Complete a +    = Tip a+    | Bin !Integer a !(Complete a) !(Complete a)+    deriving Show++instance Functor Complete where+  fmap f (Tip a) = Tip (f a)+  fmap f (Bin w a l r) = Bin w (f a) (fmap f l) (fmap f r)++instance Extend Complete where+  extended f w@Tip {} = Tip (f w)+  extended f w@(Bin n _ l r) = Bin n (f w) (extended f l) (extended f r)++instance Comonad Complete where+  extend f w@Tip {} = Tip (f w)+  extend f w@(Bin n _ l r) = Bin n (f w) (extend f l) (extend f r)+  extract (Tip a) = a+  extract (Bin _ a _ _) = a++instance Foldable Complete where+  foldMap f (Tip a) = f a +  foldMap f (Bin _ a l r) = f a `mappend` foldMap f l `mappend` foldMap f r+  foldr f z (Tip a) = f a z+  foldr f z (Bin _ a l r) = f a (foldr f (foldr f z r) l)++instance Foldable1 Complete where+  foldMap1 f (Tip a) = f a+  foldMap1 f (Bin _ a l r) = f a <> foldMap1 f l <> foldMap1 f r++instance Traversable Complete where+  traverse f (Tip a) = Tip <$> f a +  traverse f (Bin n a l r) = Bin n <$> f a <*> traverse f l <*> traverse f r++instance Traversable1 Complete where+  traverse1 f (Tip a) = Tip <$> f a +  traverse1 f (Bin n a l r) = Bin n <$> f a <.> traverse1 f l <.> traverse1 f r++bin :: a -> Complete a -> Complete a -> Complete a +bin a l r = Bin (1 + weight l + weight r) a l r+{-# INLINE bin #-}++weight :: Complete a -> Integer+weight Tip{} = 1+weight (Bin w _ _ _) = w+{-# INLINE weight #-}++-- A future is a non-empty skew binary random access list of nodes.+-- The last node, however, is allowed to contain fewer values. +data Stream a = !(Complete a) :< Stream a+--  deriving Show++instance Show a => Show (Stream a) where+  showsPrec d as = showParen (d >= 10) $ +    showString "fromList " . showsPrec 11 (toList as)++instance Functor Stream where+  fmap f (t :< ts) = fmap f t :< fmap f ts++instance Extend Stream where+  extended = extend++instance Comonad Stream where+  extend g0 (t :< ts) = go g0 t (:< ts) :< extend g0 ts+    where+      go :: (Stream a -> b) -> Complete a -> (Complete a -> Stream a) -> Complete b+      go g w@Tip{}         f = Tip (g (f w))+      go g w@(Bin n _ l r) f = Bin n (g (f w)) (go g l (:< f r))  (go g r f)+  extract = head++instance Apply Stream where+  fs <.> as = mapWithIndex (\n f -> f (as !! n)) fs+  as <.  _  = as+  _   .> bs = bs++instance ComonadApply Stream where+  (<@>) = (<.>)+  (<@) = (<.)+  (@>) = (.>)++instance Applicative Stream where+  pure = repeat+  (<*>) = (<.>)+  (<* ) = (<. )+  ( *>) = ( .>)++instance Alt Stream where+  as <!> bs = tabulate $ \i -> case quotRem i 2 of +    (q,0) -> as !! q+    (q,_) -> bs !! q+++instance Foldable Stream where+  foldMap f (t :< ts) = foldMap f t `mappend` foldMap f ts+  foldr f z (t :< ts) = foldr f (foldr f z ts) t++toList :: Stream a -> [a]+toList = foldr (:) []++instance Foldable1 Stream where+  foldMap1 f (t :< ts) = foldMap1 f t <> foldMap1 f ts++instance Traversable Stream where+  traverse f (t :< ts) = (:<) <$> traverse f t <*> traverse f ts++instance Traversable1 Stream where+  traverse1 f (t :< ts) = (:<) <$> traverse1 f t <.> traverse1 f ts++instance Distributive Stream where+  distribute w = tabulate (\i -> fmap (!! i) w)++instance Semigroup (Stream a) where+  (<>) = (<!>)++instance Monad Stream where+  return = pure+  as >>= f = mapWithIndex (\i a -> f a !! i) as++interleave :: Stream a -> Stream a -> Stream a+interleave = (<!>) +      +repeat :: a -> Stream a +repeat b = go b (Tip b) +    where +      go :: a -> Complete a -> Stream a +      go a as | ass <- bin a as as = as :< go a ass++mapWithIndex :: (Integer -> a -> b) -> Stream a -> Stream b+mapWithIndex f0 as0 = spine f0 0 as0+  where +    spine f m (a :< as) = tree f m a :< spine f (m + weight a) as+    tree f m (Tip a) = Tip (f m a)+    tree f m (Bin n a l r) = Bin n (f m a) (tree f (m + 1) l) (tree f (m + 1 + weight l) r)++tabulate :: (Integer -> a) -> Stream a+tabulate f = mapWithIndex (const . f) (pure ())+++indexed :: Stream a -> Stream (Integer, a)+indexed = mapWithIndex (,)++from :: Num a => a -> Stream a+from a = mapWithIndex ((+) . fromIntegral) (pure a)++-- | /O(1)/ cons+(<|) :: a -> Stream a -> Stream a+a <| (l :< r :< as) +  | weight l == weight r = bin a l r :< as+a <| as = Tip a :< as+{-# INLINE (<|) #-}++-- | /O(1)/+head :: Stream a -> a+head (a :< _) = extract a+{-# INLINE head #-}++-- | /O(1)/.+tail :: Stream a -> Stream a+tail (Tip{} :< ts) = ts+tail (Bin _ _ l r :< ts) = l :< r :< ts+{-# INLINE tail #-}++tails :: Stream a -> Stream (Stream a)+tails = duplicate+{-# INLINE tails #-}++-- | /O(1)/.+uncons :: Stream a -> (a, Stream a)+uncons (Tip a       :< as)  = (a, as)+uncons (Bin _ a l r :< as)  = (a, l :< r :< as)+{-# INLINE uncons #-}++-- | /O(log n)/.+index :: Integer -> Stream a -> a+index i (t :< ts) +  | i < 0     = error "index: negative index"+  | i < w     = indexComplete i t+  | otherwise = index (i - w) ts+  where w = weight t++indexComplete :: Integer -> Complete a -> a+indexComplete 0 (Tip a) = a+indexComplete 0 (Bin _ a _ _) = a+indexComplete i (Bin w _ l r) +  | i <= w'   = indexComplete (i-1) l+  | otherwise = indexComplete (i-1-w') r+  where w' = div w 2+indexComplete _ _ = error "indexComplete"++-- | /O(log n)/.+(!!) :: Stream a -> Integer -> a+(!!) = flip index ++-- | /O(log n)/.+drop :: Integer -> Stream a -> Stream a+drop 0 ts = ts+drop i (t :< ts) = case compare i w of+  LT -> dropComplete i t (:< ts)+  EQ -> ts+  GT -> drop (i - w) ts+  where w = weight t++dropComplete :: Integer -> Complete a -> (Complete a -> Stream a) -> Stream a +dropComplete 0 t f             = f t+dropComplete 1 (Bin _ _ l r) f = l :< f r+dropComplete i (Bin w _ l r) f = case compare (i - 1) w' of+    LT -> dropComplete (i-1) l (:< f r)+    EQ -> f r+    GT -> dropComplete (i-1-w') r f+    where w' = div w 2+dropComplete _ _ _ = error "dropComplete"++-- /O(n)/.+dropWhile :: (a -> Bool) -> Stream a -> Stream a+dropWhile p as +  | p (head as) = dropWhile p (tail as)+  | otherwise   = as++-- /O(n)/+span :: (a -> Bool) -> Stream a -> ([a], Stream a)+span p as+  | a <- head as, p a = first (a:) $ span p (tail as)+  | otherwise = ([], as)++-- /O(n)/+break :: (a -> Bool) -> Stream a -> ([a], Stream a)+break p = span (not . p)++-- /(O(n), O(log n))/ split at _some_ edge where function goes from False to True.+-- best used with a monotonic function+split :: (a -> Bool) -> Stream a -> ([a], Stream a)+split p (a :< as)+  | p (extract as) = splitComplete p a (:< as)+  | (ts, fs) <- split p as = (foldr (:) ts a, fs)++-- for use when we know the split occurs within a given tree+splitComplete :: (a -> Bool) -> Complete a -> (Complete a -> Stream a) -> ([a], Stream a)+splitComplete _ t@Tip{} f = ([], f t)+splitComplete p t@(Bin _ a l r) f+  | p a                                                   = ([], f t)+  | p (extract r), (ts, fs) <- splitComplete p l (:< f r) = (a:ts, fs)+  |                (ts, fs) <- splitComplete p r f        = (a:foldr (:) ts l, fs)++-- /(O(n), O(log n))/ split at _some_ edge where function goes from False to True.+-- best used with a monotonic function+--+-- > splitW p xs = (map extract &&& fmap (fmap extract)) . split p . duplicate+splitW :: (Stream a -> Bool) -> Stream a -> ([a], Stream a)+splitW p (a :< as) +  | p as                    = splitCompleteW p a (:< as)+  | (ts, fs) <- splitW p as = (foldr (:) ts a, fs)++-- for use when we know the split occurs within a given tree+splitCompleteW :: (Stream a -> Bool) -> Complete a -> (Complete a -> Stream a) -> ([a], Stream a)+splitCompleteW _ t@Tip{} f = ([], f t)+splitCompleteW p t@(Bin _ a l r) f+  | w <- f t, p w                                        = ([], w)+  | w <- f r, p w, (ts, fs) <- splitCompleteW p l (:< w) = (a:ts, fs)+  |                (ts, fs) <- splitCompleteW p r f      = (a:foldr (:) ts l, fs)++fromList :: [a] -> Stream a+fromList = foldr (<|) (error "fromList: finite list")++-- /O(n)/+insert :: Ord a => a -> Stream a -> Stream a+insert a as | (ts, as') <- split (a<=) as = foldr (<|) (a <| as') ts++-- /O(n)/. Finds the split in O(log n), but then has to recons+insertBy :: (a -> a -> Ordering) -> a -> Stream a -> Stream a+insertBy cmp a as | (ts, as') <- split (\b -> cmp a b <= EQ) as = foldr (<|) (a <| as') ts++-- /O(log n)/ Change the value of the nth entry in the future+adjust :: Integer -> (a -> a) -> Stream a -> Stream a+adjust !n f (a :< as) +  | n < w = adjustComplete n f a :< as+  | otherwise = a :< adjust (n - w) f as+  where w = weight a++adjustComplete :: Integer -> (a -> a) -> Complete a -> Complete a+adjustComplete 0 f (Tip a) = Tip (f a)+adjustComplete _ _ t@Tip{} = t+adjustComplete n f (Bin m a l r) +  | n == 0 = Bin m (f a) l r+  | n < w = Bin m a (adjustComplete (n - 1) f l) r+  | otherwise = Bin m a l (adjustComplete (n - 1 - w) f r)+  where w = weight l++update :: Integer -> a -> Stream a -> Stream a+update n = adjust n . const+

@@ -0,0 +1,174 @@+{-# LANGUAGE CPP, FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Stream.Supply+-- Copyright   :  (C) 2008-2011 Edward Kmett,+--                (C) 2008 Iavor S. Diatchki+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- This library can be used to generate values (for example, new names)+-- without the need to thread state.  This means that functions that+-- need to generate new values only need a supply object as an argument,+-- and they do not need to return a new supply object as a result.+-- This decreases the number of data-dependencies in a program, which+-- makes it easier to exploit parallelism.+--+-- The technique for generating new values is based on the paper+-- ''On Generating Unique Names'' by Lennart Augustsson, Mikael Rittri, +-- and Dan Synek.+----------------------------------------------------------------------------+module Data.Stream.Supply+  ( Supply+  , newSupply+  , newEnumSupply+  , newNumSupply+  , newDupableSupply+  , newDupableEnumSupply+  , newDupableNumSupply+  , leftSupply+  , rightSupply+  , split+  , splits+  , splitSkew+  , split2+  , split3+  , split4+  ) where++import Control.Applicative+import Control.Comonad+import Data.Functor.Apply+import Data.Functor.Extend+import Data.Foldable+import Data.IORef(newIORef, atomicModifyIORef)+import Data.Traversable+import Data.Semigroup+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+import System.IO.Unsafe (unsafeInterleaveIO)+import Data.Stream.Infinite+import qualified Data.Stream.Infinite.Skew as Skew++#ifdef LANGUAGE_DeriveDataTypeable+import Data.Data+#endif++#ifdef __GLASGOW_HASKELL__ >= 608 +import GHC.IO(unsafeDupableInterleaveIO)+#else+unsafeDupableInterleaveIO :: IO a -> IO a+unsafeDupableInterleaveIO = unsafeInterleaveIO+#endif++data Supply a = Supply a (Supply a) (Supply a) deriving +  ( Show, Read, Eq, Ord+#ifdef LANGUAGE_DeriveDataTypeable+  , Data, Typeable+#endif+  )++instance Functor Supply where+  fmap f (Supply a l r) = Supply (f a) (fmap f l) (fmap f r)+  a <$ _ = pure a++instance Extend Supply where+  extended f s@(Supply _ l r) = Supply (f s) (extended f l) (extended f r)+  duplicated s@(Supply _ l r) = Supply s (duplicated l) (duplicated r)++instance Comonad Supply where+  extend f s@(Supply _ l r) = Supply (f s) (extend f l) (extend f r)+  duplicate s@(Supply _ l r) = Supply s (duplicate l) (duplicate r)+  extract (Supply a _ _) = a++instance Apply Supply where+  Supply f fl fr <.> Supply a al ar = Supply (f a) (fl <.> al) (fr <.> ar)+  a <. _ = a+  _ .> a = a++instance Applicative Supply where+  pure a = as where as = Supply a as as+  Supply f fl fr <*> Supply a al ar = Supply (f a) (fl <*> al) (fr <*> ar)+  a <* _ = a+  _ *> a = a++instance Foldable Supply where+  foldMap f (Supply a l r) = f a `mappend` foldMap f l `mappend` foldMap f r++instance Foldable1 Supply where+  foldMap1 f (Supply a l r) = f a <> foldMap1 f l <> foldMap1 f r++instance Traversable Supply where+  traverse f (Supply a l r) = Supply <$> f a <*> traverse f l <*> traverse f r++instance Traversable1 Supply where+  traverse1 f (Supply a l r) = Supply <$> f a <.> traverse1 f l <.> traverse1 f r+  +leftSupply :: Supply a -> Supply a+leftSupply (Supply _ l _) = l++rightSupply :: Supply a -> Supply a+rightSupply (Supply _ _ r) = r++-- unfoldsW :: (Comonad w, Functor f) => (w a -> (b, f a)) -> w a -> StreamT f w b+newSupply :: (a -> a) -> a -> IO (Supply a)+newSupply f x = gen =<< newIORef x+  where gen r = unsafeInterleaveIO $+          Supply <$> unsafeInterleaveIO (atomicModifyIORef r update) +                 <*> gen r +                 <*> gen r+        update a = b `seq` (b, a) where b = f a+{-# INLINE newSupply #-}++newDupableSupply :: (a -> a) -> a -> IO (Supply a)+newDupableSupply f x = gen =<< newIORef x+  where gen r = unsafeDupableInterleaveIO $+          Supply <$> unsafeDupableInterleaveIO (atomicModifyIORef r update)+                 <*> gen r+                 <*> gen r+        update a = b `seq` (b, a) where b = f a+{-# INLINE newDupableSupply #-}++newEnumSupply :: Enum a => IO (Supply a)+newEnumSupply = newSupply succ (toEnum 0)+{-# SPECIALIZE newEnumSupply :: IO (Supply Int) #-}++newNumSupply :: Num a => IO (Supply a)+newNumSupply = newSupply (1+) 0+{-# SPECIALIZE newNumSupply :: IO (Supply Int) #-}++newDupableEnumSupply :: Enum a => IO (Supply a)+newDupableEnumSupply = newSupply succ (toEnum 0)+{-# SPECIALIZE newEnumSupply :: IO (Supply Int) #-}++newDupableNumSupply :: Num a => IO (Supply a)+newDupableNumSupply = newSupply (1+) 0+{-# SPECIALIZE newNumSupply :: IO (Supply Int) #-}++split :: Supply a -> Stream (Supply a)+split (Supply _ l r) = l :> split r++splits :: Integral b => Supply a -> b -> Supply a+splits (Supply _ l r) n = case n `quotRem` 2 of+  (0,0)  -> leftSupply l+  (q,-1) -> splits (rightSupply l) q+  (q,0)  -> splits (leftSupply r) q+  (q,1)  -> splits (rightSupply r) q+  (_,_)  -> error "quotRem: impossible result"+{-# SPECIALIZE splits :: Supply a -> Int -> Supply a #-}+{-# SPECIALIZE splits :: Supply a -> Integer -> Supply a #-}++splitSkew :: Supply a -> Skew.Stream (Supply a)+splitSkew = Skew.tabulate . splits++split2 :: Supply a -> (Supply a, Supply a)+split2 (Supply _ l r) = (l, r)++split3 :: Supply a -> (Supply a, Supply a, Supply a)+split3 (Supply _ a (Supply _ b c)) = (a, b, c)++split4 :: Supply a -> (Supply a, Supply a, Supply a, Supply a)+split4 (Supply _ (Supply _ a b) (Supply _ c d)) = (a, b, c, d)

@@ -1,6 +1,6 @@ name:          streams category:      Control, Comonads-version:       3.0.0.1+version:       3.0.1 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -9,7 +9,7 @@ stability:     provisional homepage:      http://github.com/ekmett/streams homepage:      http://github.com/ekmett/streams/issues-copyright:     Copyright 2011-2012 Edward Kmett+copyright:     Copyright 2011-2013 Edward Kmett                Copyright 2010 Tony Morris, Oliver Taylor, Eelis van der Weegen                Copyright 2007-2010 Wouter Swierstra, Bas van Dijk                Copyright 2008 Iavor S. Diatchki@@ -52,24 +52,6 @@   .   * "Data.Stream.Supply" provides a comonadic supply of unique values, which are     generated impurely as the tree is explored.-  .-  /Changes since 0.6.3/:-  .-  * "Data.Stream.NonEmpty" renamed to "Data.List.NonEmpty" and pushed upstream into the semigroups package.-  .-  /Changes since 0.5.1/:-  .-  * Removed a redundant UNPACK pragma-  .-  /Changes since 0.5/:-  .-  * Data.Stream.Supply added-  .-  /Changes since 0.1/:-  .-  * A number of strictness issues with 'NonEmpty' were fixed-  .-  * More documentation  source-repository head   type: git@@ -81,11 +63,11 @@     BangPatterns    build-depends:-    base          >= 4       && < 5,-    comonad       == 3.0.*,-    distributive  >= 0.2.1   && < 0.4,-    semigroupoids == 3.0.*,-    semigroups    >= 0.8.3.1 && < 0.9+    base          >= 4 && < 5,+    comonad       >= 3,+    distributive  >= 0.2.1,+    semigroupoids >= 3,+    semigroups    >= 0.8.3.1    extensions: CPP   if impl(ghc)@@ -100,5 +82,6 @@     Data.Stream.Infinite.Functional.Zipper     Data.Stream.Supply +  hs-source-dirs: src   ghc-options: -Wall