streams (empty) → 0.1.1

raw patch · 11 files changed

+2445/−0 lines, 11 filesdep +basedep +comonaddep +functor-applysetup-changed

Dependencies added: base, comonad, functor-apply, semigroups

Files

• Data/Stream/Branching.hs +132/−0
• Data/Stream/Future.hs +147/−0
• Data/Stream/Future/Skew.hs +422/−0
• Data/Stream/Infinite.hs +444/−0
• Data/Stream/Infinite/Functional/Zipper.hs +323/−0
• Data/Stream/Infinite/Skew.hs +334/−0
• Data/Stream/NonEmpty.hs +468/−0
• LICENSE +32/−0
• README +41/−0
• Setup.lhs +7/−0
• streams.cabal +95/−0

@@ -0,0 +1,132 @@+{-# LANGUAGE CPP, PatternGuards, UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Stream.Branching+-- 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.Branching (+   -- * The type of streams+     Stream(..)+   -- * Basic functions+   , head   -- Stream f a -> a+   , tail   -- Stream f a -> f (Stream f a)+   , tails  -- Stream f a -> Stream f (Stream f a)+   , inits1 -- Stream f a -> Stream f (NonEmpty a)+   , unfold -- +  ) where++import Prelude hiding (head, tail)++import Control.Applicative+import Control.Comonad+import Control.Comonad.Apply+import Control.Monad+import Data.Functor.Apply+import Data.Stream.NonEmpty hiding (tail, tails, unfold, head)+import qualified Data.Stream.NonEmpty as NonEmpty++#ifdef GHC_TYPEABLE+import Data.Data+#endif++infixr 5 :<++data Stream f a = a :< f (Stream f a)++head :: Stream f a -> a+head (a :< _) = a+{-# INLINE head #-}++tail :: Stream f a -> f (Stream f a)+tail (_ :< as) = as+{-# INLINE tail #-}++tails :: Functor f => Stream f a -> Stream f (Stream f a)+tails = duplicate+{-# INLINE tails #-}++-- | equivalent to inits sans the initial [] context+inits1 :: Functor f => Stream f a -> Stream f (NonEmpty a)+inits1 (a :< as) = (a :| []) :< (fmap (NonEmpty.cons a) . inits1 <$> as)++instance Functor f => Functor (Stream f) where+  fmap f (a :< as) = f a :< fmap (fmap f) as+  b <$ (_ :< as) = b :< fmap (b <$) as++instance Functor f => Comonad (Stream f) where+  extract (a :< _) = a+  extend f w = f w :< fmap (extend f) (tail w)+  duplicate w = w :< fmap duplicate (tail w)++instance FunctorApply f => FunctorApply (Stream f) where+  (f :< fs) <.> (a :< as) = f a :< ((<.>) <$> fs <.> as)+  (f :< fs) <.  (_ :< as) = f :< ((<. ) <$> fs <.> as)+  (_ :< fs)  .> (a :< as) = a :< (( .>) <$> fs <.> as)++instance FunctorApply f => ComonadApply (Stream f)++instance Applicative f => Applicative (Stream f) where+  pure a = as where as = a :< pure as+  (f :< fs) <*> (a :< as) = f a :< ((<*>) <$> fs <*> as)+  (f :< fs) <*  (_ :< as) = f :< ((<* ) <$> fs <*> as)+  (_ :< fs)  *> (a :< as) = a :< (( *>) <$> fs <*> as)++unfold :: Functor f => (b -> (a, f b)) -> b -> Stream f a+unfold f c | (x, d) <- f c = x :< fmap (unfold f) d++instance (Show (f (Stream f a)), Show a) => Show (Stream f a) where+  showsPrec d (a :< as) = showParen (d > 5) $ +    showsPrec 6 a . showString " :< " . showsPrec 5 as++instance (Eq (f (Stream f a)), Eq a) => Eq (Stream f a) where+  a :< as == b :< bs = a == b && as == bs++instance (Ord (f (Stream f a)), Ord a) => Ord (Stream f a) where+  compare (a :< as) (b :< bs) = case compare a b of+    LT -> LT+    EQ -> compare as bs+    GT -> GT++#ifdef GHC_TYPEABLE++instance (Typeable1 f) => Typeable1 (Stream f) where+  typeOf1 dfa = mkTyConApp streamTyCon [typeOf1 (f dfa)]+    where+      f :: Stream f a -> f a+      f = undefined++instance (Typeable1 f, Typeable a) => Typeable (Stream f a) where+  typeOf = typeOfDefault++streamTyCon :: TyCon+streamTyCon = mkTyCon "Data.Stream.Branching.Stream"+{-# NOINLINE streamTyCon #-}++instance+  ( Typeable1 f+  , Data (f (Stream f a))+  , Data a+  ) => Data (Stream f a) where+    gfoldl f z (a :< as) = z (:<) `f` a `f` as+    toConstr _ = streamConstr+    gunfold k z c = case constrIndex c of+        1 -> k (k (z (:<)))+        _ -> error "gunfold"+    dataTypeOf _ = streamDataType+    dataCast1 f = gcast1 f++streamConstr :: Constr+streamConstr = mkConstr streamDataType ":<" [] Infix+{-# NOINLINE streamConstr #-}++streamDataType :: DataType+streamDataType = mkDataType "Data.Stream.Branching.Stream" [streamConstr]+{-# NOINLINE streamDataType #-}++#endif

@@ -0,0 +1,147 @@+{-# 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.Applicative.Alt+import Control.Comonad+import Control.Comonad.Apply+import Data.Foldable+import Data.Functor.Alt+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 Comonad Future where+  extract = head+  duplicate = tails+  extend f w@(_ :< as) = f w :< extend f as+  extend f w@(Last _)  = Last (f w)++instance FunctorApply 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 FunctorAlt Future where+  Last a    <!> bs = a :< bs+  (a :< as) <!> bs = a :< (as <!> bs)++instance Semigroup (Future a) where+  (<>) = (<!>)+  +instance ComonadApply Future++instance Applicative Future where+  pure = Last+  (<*>) = (<.>)+  (<* ) = (<. )+  ( *>) = ( .>)++instance ApplicativeAlt Future++

@@ -0,0 +1,422 @@+{-# 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 Control.Comonad.Apply+import Data.Functor.Alt+import Data.Functor.Apply+import Data.Foldable hiding (toList)+import Data.Traversable (Traversable, traverse)+import qualified Data.Traversable as Traversable+import Data.Semigroup hiding (Last)+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+import Data.Monoid (Monoid(mappend))+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 Comonad Complete where+  extract (Tip a) = a+  extract (Bin _ a _ _) = a+  extend f w@Tip {} = Tip (f w)+  extend f w@(Bin n _ l r) = Bin n (f w) (extend f l) (extend f r)++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 Comonad Future where+  extract = head+  extend g (Last t)  = Last (extendTree g t Last)+  extend g (t :< ts) = extendTree g t (:< ts) :< extend g ts++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 FunctorApply 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++instance Applicative Future where+  pure = repeat+  (<*>) = (<.>)++instance FunctorAlt 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) (\0 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,444 @@+{-# 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)+   -- * 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 Control.Comonad.Apply+import Data.Char (isSpace)+import Data.Data+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.Stream.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++-- | 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 Comonad Stream where+  extract = head+  duplicate = tails+  extend f w = f w :> extend f (tail w)++instance FunctorApply Stream where+  (f :> fs) <.> (a :> as) = f a :> (fs <.> as)+  as        <.  _         = as+  _          .> bs        = bs++instance ComonadApply Stream ++-- | '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,323 @@+{-# LANGUAGE DeriveDataTypeable, 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 Control.Comonad.Apply+-- import Data.Char (isSpace)+import Data.Data+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)+  deriving Typeable++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 Comonad Zipper where+  extract (n :~ f) = f n+  duplicate (n :~ f) = n :~ (:~ f)++instance FunctorApply Zipper where+  (nf :~ f) <.> (na :~ a) +    | dn <- na - nf+    = nf :~ \n -> f n (a (n + dn))+  as        <.  _         = as+  _          .> bs        = bs++instance ComonadApply Zipper ++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,334 @@+{-# 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+    ) where ++import Control.Arrow (first)+import Control.Applicative hiding (empty)+import Control.Comonad+import Control.Comonad.Apply+import Data.Functor.Alt+import Data.Functor.Apply+import Data.Foldable hiding (toList)+import Data.Traversable (Traversable, traverse)+import qualified Data.Traversable as Traversable+import Data.Semigroup hiding (Last)+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+import Data.Monoid (Monoid(mappend))+import Prelude hiding (null, head, tail, drop, dropWhile, length, foldr, last, span, repeat, replicate, (!!), break)++infixr 5 :<, <|++data Complete a +    = Tip a+    | Bin {-# UNPACK #-} !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 Comonad Complete where+  extract (Tip a) = a+  extract (Bin _ a _ _) = a+  extend f w@Tip {} = Tip (f w)+  extend f w@(Bin n _ l r) = Bin n (f w) (extend f l) (extend f r)++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 Comonad Stream where+  extract = head+  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)++instance FunctorApply Stream where+  fs <.> as = mapWithIndex (\n f -> f (as !! n)) fs+  as <.  _  = as+  _   .> bs = bs++instance ComonadApply Stream++instance Applicative Stream where+  pure = repeat+  (<*>) = (<.>)+  (<* ) = (<. )+  ( *>) = ( .>)++instance FunctorAlt 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 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,468 @@+{-# LANGUAGE CPP, PatternGuards #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Stream.NonEmpty+-- Copyright   :  (C) 2011 Edward Kmett,+--                (C) 2010 Tony Morris, Oliver Taylor, Eelis van der Weegen+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- A NonEmpty list forms a monad as per list.+-- Unlike Future, the ComonadApply instance pairs all positions in both +-- comonads like the list monad applicative.+----------------------------------------------------------------------------++module Data.Stream.NonEmpty (+   -- * The type of streams+     NonEmpty(..)+   -- * non-empty stream transformations+   , map         -- :: (a -> b) -> NonEmpty a -> NonEmpty b+   , intersperse -- :: a -> NonEmpty a -> NonEmpty a+   , scanl       -- :: Foldable f => (b -> a -> b) -> b -> f a -> NonEmpty b+   , scanr       -- :: Foldable f => (a -> b -> b) -> b -> f a -> NonEmpty b+   , scanl1      -- :: (a -> a -> a) -> NonEmpty a -> NonEmpty a+   , scanr1      -- :: (a -> a -> a) -> NonEmpty a -> NonEmpty a+   --, transpose   -- :: NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty a)+   -- * Basic functions+   , head        -- :: NonEmpty a -> a  +   , tail        -- :: NonEmpty a -> [a]+   , last        -- :: NonEmpty a -> a+   , init        -- :: NonEmpty a -> [a]+   , (<|), cons  -- :: a -> NonEmpty a -> NonEmpty a +   , uncons      -- :: NonEmpty a -> (a, Maybe (NonEmpty a))+   , sort        -- :: NonEmpty a -> NonEmpty a+   , reverse     -- :: NonEmpty a -> NonEmpty a+   , inits       -- :: Foldable f => f a -> NonEmpty a+   , tails       -- :: Foldable f => f a -> NonEmpty a+   -- * Building streams+   , iterate     -- :: (a -> a) -> a -> NonEmpty a+   , repeat      -- :: a -> NonEmpty a +   , cycle       -- :: NonEmpty a -> NonEmpty a+   , unfold      -- :: (a -> (b, Maybe a) -> a -> NonEmpty b+   , insert      -- :: Foldable f => a -> f a -> NonEmpty a+   -- * Extracting sublists+   , take        -- :: Int -> NonEmpty a -> [a]+   , drop        -- :: Int -> NonEmpty a -> [a]+   , splitAt     -- :: Int -> NonEmpty a -> ([a], [a])+   , takeWhile   -- :: Int -> NonEmpty a -> [a]+   , dropWhile   -- :: Int -> NonEmpty a -> [a]+   , span        -- :: Int -> NonEmpty a -> ([a],[a])+   , break       -- :: Int -> NonEmpty a -> ([a],[a])+   , filter      -- :: (a -> Bool) -> NonEmpty a -> [a]+   , partition   -- :: (a -> Bool) -> NonEmpty a -> ([a],[a])+   , group       -- :: Foldable f => Eq a => f a -> [NonEmpty a]+   , groupBy     -- :: Foldable f => (a -> a -> Bool) -> f a -> [NonEmpty a]+   , group1      -- :: Eq a => NonEmpty a -> NonEmpty (NonEmpty a)+   , groupBy1    -- :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty (NonEmpty a)+   -- * Sublist predicates+   , isPrefixOf  -- :: Foldable f => f a -> NonEmpty a -> Bool+   -- * Indexing streams+   , (!!)        -- :: NonEmpty a -> Int -> a+   -- * Zipping and unzipping streams+   , zip         -- :: NonEmpty a -> NonEmpty b -> NonEmpty (a,b)+   , zipWith     -- :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c+   , unzip       -- :: NonEmpty (a, b) -> (NonEmpty a, NonEmpty b)+   -- * Functions on streams of characters+   , words       -- :: NonEmpty Char -> NonEmpty String+   , unwords     -- :: NonEmpty String -> NonEmpty Char+   , lines       -- :: NonEmpty Char -> NonEmpty String+   , unlines     -- :: NonEmpty String -> NonEmpty Char+   -- * Converting to and from a list+   , fromList    -- :: [a] -> NonEmpty a+   , toList      -- :: NonEmpty a -> [a]+   , nonEmpty    -- :: [a] -> Maybe (NonEmpty a)+   ) where+++import Prelude hiding+  ( head, tail, map, reverse+  , scanl, scanl1, scanr, scanr1+  , iterate, take, drop, takeWhile+  , dropWhile, repeat, cycle, filter+  , (!!), zip, unzip, zipWith, words+  , unwords, lines, unlines, break, span+  , splitAt, foldr, foldl, last, init+  )++import Control.Applicative+import Control.Applicative.Alt+import Control.Comonad+import Control.Comonad.Apply+import Control.Monad+import Data.Functor.Alt+import Data.Foldable hiding (toList)+import qualified Data.Foldable as Foldable+import qualified Data.List as List+import Data.Monoid hiding (Last)+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 NonEmpty a = a :| [a] deriving +  ( Eq, Ord, Show, Read+#ifdef LANGUAGE_DeriveDataTypeable+  , Data, Typeable+#endif+  )++unfold :: (a -> (b, Maybe a)) -> a -> NonEmpty b+unfold f a = case f a of+  (b, Nothing) -> b :| []+  (b, Just c)  -> b <| unfold f c++nonEmpty :: [a] -> Maybe (NonEmpty a)+nonEmpty []     = Nothing+nonEmpty (a:as) = Just (a :| as)+{-# INLINE nonEmpty #-}++uncons :: NonEmpty a -> (a, Maybe (NonEmpty a))+uncons ~(a :| as) = (a, nonEmpty as)+{-# INLINE uncons #-}++instance Functor NonEmpty where+  fmap f ~(a :| as) = f a :| fmap f as+  b <$ ~(_ :| as)   = b   :| (b <$ as)++instance Comonad NonEmpty where+  extract ~(a :| _) = a+  extend f w@ ~(_ :| aas) = f w :| case aas of+      []     -> []+      (a:as) -> toList (extend f (a :| as))+  +instance FunctorApply NonEmpty where+  (<.>) = ap++instance FunctorAlt NonEmpty where+  (a :| as) <!> ~(b :| bs) = a :| (as ++ b : bs)++instance ComonadApply NonEmpty++instance Applicative NonEmpty where+  pure a = a :| []+  (<*>) = ap++instance ApplicativeAlt NonEmpty++instance Monad NonEmpty where+  return a = a :| []+  ~(a :| as) >>= f +    | b :| bs  <- f a+    , bs'      <- as >>= toList . f+    = b :| (bs ++ bs')++instance Traversable NonEmpty where+  traverse f ~(a :| as) = (:|) <$> f a <*> traverse f as++instance Traversable1 NonEmpty where+  traverse1 f (a :| []) = (:|[]) <$> f a+  traverse1 f (a :| (b: bs)) = (\a' (b':| bs') -> a' :| b': bs') <$> f a <.> traverse1 f (b :| bs)++instance Foldable NonEmpty where+  foldr f z ~(a :| as) = f a (foldr f z as)+  foldl f z ~(a :| as) = foldl f (f z a) as +  foldl1 f ~(a :| as) = foldl f a as+  foldMap f ~(a :| as) = f a `mappend` foldMap f as+  fold ~(m :| ms) = m `mappend` fold ms++instance Foldable1 NonEmpty where+  foldMap1 f (a :| []) = f a+  foldMap1 f (a :| b : bs) = f a <> foldMap1 f (b :| bs)++instance Semigroup (NonEmpty a) where+  (<>) = (<!>)++-- | Extract the first element of the stream+head :: NonEmpty a -> a+head ~(a :| _) = a+{-# INLINE head #-}++-- | Extract the possibly empty tail of the stream+tail :: NonEmpty a -> [a]+tail ~(_ :| as) = as+{-# INLINE tail #-}++-- | Extract the last element of the stream+last :: NonEmpty a -> a+last ~(a :| as) = List.last (a : as)+{-# INLINE last #-}++-- | Extract everything except the last element of the stream+init :: NonEmpty a -> [a]+init ~(a :| as) = List.init (a : as)+{-# INLINE init #-}++-- | cons onto a stream+(<|) :: a -> NonEmpty a -> NonEmpty a +a <| ~(b :| bs) = a :| b : bs+{-# INLINE (<|) #-}++cons :: a -> NonEmpty a -> NonEmpty a+cons = (<|)+{-# INLINE cons #-}++-- | Sort a stream+sort :: Ord a => NonEmpty a -> NonEmpty a +sort = lift List.sort+{-# INLINE sort #-}++-- | Converts an non-empty list to a stream.+fromList :: [a] -> NonEmpty a +fromList (a:as) = a :| as+fromList [] = error "NonEmpty.fromList: empty list"+{-# INLINE fromList #-}++-- | Convert a stream to a list efficiently+toList :: NonEmpty a -> [a]+toList ~(a :| as) = a : as+{-# INLINE toList #-}++-- | Lift list operations to work on a 'NonEmpty' stream+lift :: Foldable f => ([a] -> [b]) -> f a -> NonEmpty b+lift f = fromList . f . Foldable.toList +{-# INLINE lift #-}++-- | map a function over a 'NonEmpty' stream+map :: (a -> b) -> NonEmpty a -> NonEmpty b+map f ~(a :| as) = f a :| fmap f as +{-# INLINE map #-}++-- | The 'inits' function takes a stream @xs@ and returns all the+-- finite prefixes of @xs@.+inits :: Foldable f => f a -> NonEmpty [a]+inits = fromList . List.inits . Foldable.toList+{-# INLINE inits #-}++-- | The 'tails' function takes a stream @xs@ and returns all the+-- suffixes of @xs@.+tails   :: Foldable f => f a -> NonEmpty [a]+tails = fromList . List.tails . Foldable.toList+{-# INLINE tails #-}++-- | 'insert' an item into a 'NonEmpty'+insert  :: Foldable f => Ord a => a -> f a -> NonEmpty a+insert a = fromList . List.insert a . Foldable.toList+{-# INLINE insert #-}++-- | 'scanl' is similar to 'foldl', but returns a stream of successive+-- reduced values from the left:+--+-- > scanl f z [x1, x2, ...] == z :| [z `f` x1, (z `f` x1) `f` x2, ...]+--+-- Note that+--+-- > last (scanl f z xs) == foldl f z xs.+scanl   :: Foldable f => (b -> a -> b) -> b -> f a -> NonEmpty b+scanl f z = fromList . List.scanl f z . Foldable.toList+{-# INLINE scanl #-}++-- | 'scanr' is the right-to-left dual of 'scanl'.+-- Note that+--+-- > head (scanr f z xs) == foldr f z xs.+scanr   :: Foldable f => (a -> b -> b) -> b -> f a -> NonEmpty b+scanr f z = fromList . List.scanr f z . Foldable.toList+{-# INLINE scanr #-}++-- | 'scanl1' is a variant of 'scanl' that has no starting value argument:+--+-- > scanl1 f [x1, x2, ...] == x1 :| [x1 `f` x2, x1 `f` (x2 `f` x3), ...]+scanl1 :: (a -> a -> a) -> NonEmpty a -> NonEmpty a+scanl1 f ~(a :| as) = fromList (List.scanl f a as)+{-# INLINE scanl1 #-}++-- | 'scanr1' is a variant of 'scanr' that has no starting value argument.+scanr1 :: (a -> a -> a) -> NonEmpty a -> NonEmpty a+scanr1 f ~(a :| as) = fromList (List.scanr1 f (a:as))+{-# INLINE scanr1 #-}++intersperse :: a -> NonEmpty a -> NonEmpty a+intersperse a ~(b :| bs) = b :| case bs of +    [] -> []+    _ -> a : List.intersperse a bs+{-# INLINE intersperse #-}++-- | @'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 -> NonEmpty a+iterate f a = a :| List.iterate f (f a)+{-# INLINE iterate #-}++-- | @'cycle' xs@ returns the infinite repetition of @xs@:+--+-- > cycle [1,2,3] = 1 :| [2,3,1,2,3,...]+cycle :: NonEmpty a -> NonEmpty a +cycle = fromList . List.cycle . toList +{-# INLINE cycle #-}++-- | 'reverse' a finite NonEmpty+reverse :: NonEmpty a -> NonEmpty a+reverse = lift List.reverse+{-# INLINE reverse #-}++-- | @'repeat' x@ returns a constant stream, where all elements are+-- equal to @x@.+repeat :: a -> NonEmpty a+repeat a = a :| List.repeat a+{-# INLINE repeat #-}++-- | @'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 -> NonEmpty a -> [a]+take n = List.take n . toList +{-# INLINE take #-}++-- | @'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 -> NonEmpty a -> [a]+drop n = List.drop n . toList+{-# INLINE drop #-}++-- | @'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 -> NonEmpty a -> ([a],[a])+splitAt n = List.splitAt n . toList+{-# INLINE splitAt #-}++-- | @'takeWhile' p xs@ returns the longest prefix of the stream+-- @xs@ for which the predicate @p@ holds.+takeWhile :: (a -> Bool) -> NonEmpty a -> [a]+takeWhile p = List.takeWhile p . toList+{-# INLINE takeWhile #-}++-- | @'dropWhile' p xs@ returns the suffix remaining after+-- @'takeWhile' p xs@.+dropWhile :: (a -> Bool) -> NonEmpty a -> [a]+dropWhile p = List.dropWhile p . toList+{-# INLINE dropWhile #-}++-- | 'span' @p@ @xs@ returns the longest prefix of @xs@ that satisfies+-- @p@, together with the remainder of the stream.+span :: (a -> Bool) -> NonEmpty a -> ([a], [a])+span p = List.span p . toList+{-# INLINE span #-}++-- | The 'break' @p@ function is equivalent to 'span' @not . p@.+break :: (a -> Bool) -> NonEmpty a -> ([a], [a])+break p = span (not . p)+{-# INLINE break #-}++-- | 'filter' @p@ @xs@, removes any elements from @xs@ that do not satisfy @p@.+filter :: (a -> Bool) -> NonEmpty a -> [a]+filter p = List.filter p . toList+{-# INLINE filter #-}++-- | 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.+partition :: (a -> Bool) -> NonEmpty a -> ([a], [a])+partition p = List.partition p . toList +{-# INLINE partition #-}++-- | 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 :: (Foldable f, Eq a) => f a -> [NonEmpty a]+group = groupBy (==)+{-# INLINE group #-}++groupBy :: Foldable f => (a -> a -> Bool) -> f a -> [NonEmpty a]+groupBy eq0 = go eq0 . Foldable.toList+  where +    go _  [] = []+    go eq (x : xs) = (x :| ys) : groupBy eq zs+      where (ys, zs) = List.span (eq x) xs+  +group1 :: Eq a => NonEmpty a -> NonEmpty (NonEmpty a)+group1 = groupBy1 (==)+{-# INLINE group1 #-}++groupBy1 :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty (NonEmpty a)+groupBy1 eq (x :| xs) = (x :| ys) :| groupBy eq zs+  where (ys, zs) = List.span (eq x) xs+{-# INLINE groupBy1 #-}++-- | The 'isPrefix' function returns @True@ if the first argument is+-- a prefix of the second.+isPrefixOf :: Eq a => [a] -> NonEmpty a -> Bool+isPrefixOf [] _ = True+isPrefixOf (y:ys) (x :| xs) = (y == x) && List.isPrefixOf ys xs+{-# INLINE isPrefixOf #-}++-- | @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.+(!!) :: NonEmpty a -> Int -> a+(!!) ~(x :| xs) n +  | n == 0 = x+  | n > 0  = xs List.!! (n - 1)+  | otherwise = error "NonEmpty.!! negative argument"+{-# INLINE (!!) #-}++-- | The 'zip' function takes two streams and returns a list of+-- corresponding pairs.+zip :: NonEmpty a -> NonEmpty b -> NonEmpty (a,b)+zip ~(x :| xs) ~(y :| ys) = (x, y) :| List.zip xs ys+{-# INLINE zip #-}++-- | 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) -> NonEmpty a -> NonEmpty b -> NonEmpty c+zipWith f ~(x :| xs) ~(y :| ys) = f x y :| List.zipWith f xs ys+{-# INLINE zipWith #-}++-- | The 'unzip' function is the inverse of the 'zip' function.+unzip :: Functor f => f (a,b) -> (f a, f b)+unzip xs = (fst <$> xs, snd <$> xs)+{-# INLINE unzip #-}++-- | The 'words' function breaks a stream of characters into a+-- stream of words, which were delimited by white space.+words :: NonEmpty Char -> NonEmpty String+words = lift List.words+{-# INLINE words #-}++-- | The 'unwords' function is an inverse operation to 'words'. It+-- joins words with separating spaces.+unwords :: NonEmpty String -> NonEmpty Char+unwords = lift List.unwords+{-# INLINE unwords #-}++-- | The 'lines' function breaks a stream of characters into a list+-- of strings at newline characters. The resulting strings do not+-- contain newlines.+lines :: NonEmpty Char -> NonEmpty String+lines = lift List.lines+{-# INLINE lines #-}++-- | The 'unlines' function is an inverse operation to 'lines'. It+-- joins lines, after appending a terminating newline to each.+unlines :: NonEmpty String -> NonEmpty Char+unlines = lift List.unlines+{-# INLINE unlines #-}

@@ -0,0 +1,32 @@+Copyright 2011 Edward Kmett+Copyright 2010 Tony Morris, Oliver Taylor, Eelis van der Weegen+Copyright 2007-2010 Wouter Swierstra, Bas van Dijk++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,41 @@+-- currently implemented++* Data.Stream.Branching       data Stream f a = a :< f (Stream a)+* Data.Stream.NonEmpty        data NonEmpty a = a :| [a] +* Data.Stream.Future               data Future a = Last a | a :<   Future a+* Data.Stream.Future.Skew          data Future a = Last a | !(Complete a) :< Future a+* Data.Stream.Infinite                    data Future a = a :<   Future a+* Data.Stream.Infinite.Skew               data Future a = !(Complete a) :< Future a+* Data.Stream.Infinite.Functional.Zipper  data Zipper a = Zipper !(Integer -> a) !Integer++-- TODO: refactor the existing Functional.Zipper to have a lower bound and add a Symmetric variant+-- Data.Stream.Infinite.Functional.Zipper data Zipper a = Zipper !(Integer -> a) !Integer !Integer -- can seek arbitrarily++Data.Stream.Causal               data Causal a = First a |   Causal a  :> a   +Data.Stream.Causal.Infinite      data Causal a =             Causal a  :> a+Data.Stream.Causal.Finite        data Causal a = First a | !(Causal a) :> a+Data.Stream.Causal.Skew          data Causal a = First a |   Causal a  :> !(Complete a)+Data.Stream.Causal.Infinite.Skew data Causal a =             Causal a  :> !(Complete a)++Data.Stream.Future.Finite        data Future a = Last a | a :< !(Future a)++Data.Stream.Zipper                         data Zipper a = Now !(Finite.Causal a) | !(Finite.Causal a) :| (Future a) +Data.Stream.Zipper.Symmetric               data Zipper a = Now !(Causal a)        | !(Causal a)        :| (Future a) +Data.Stream.Zipper.Infinite                data Zipper a =                          !(Finite.Causal a) :| Infinite.Future a+Data.Stream.Zipper.Infinite.Symmetric      data Zipper a =         {- #UNPACK #-} !(Infinite.Causal a) :| Infinite.Future a+Data.Stream.Zipper.Finite                  data Zipper a = Now !(Finite.Causal a) | !(Finite.Causal a) :| !(Finite.Future a)+Data.Stream.Zipper.Skew                    data Zipper a = Zipper !(Seq a) !(Seq a) !(Skew.Future a)+Data.Stream.Zipper.Skew.Symmetric          data Zipper a = Zipper !(S.Causal a) !(Seq a) !(Seq a) !(Skew.Future a)+Data.Stream.Zipper.Infinite.Skew           data Zipper a = Zipper !(S.Causal a) !(Seq a) !(Seq a) !(IS.Future a)+Data.Stream.Zipper.Infinite.Skew.Symmetric data Zipper a = Zipper !(IS.Causal a) !(Seq a) !(Seq a) !(IS.Future a)++Data.Stream.Infinite.Functional.Future           data Future a = Future !(Integer -> a) !Integer -- increment only+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.Zipper        data Zipper a = Zipper !(Int# -> a) Int# Int# Int#++Data.Tensors          data Tensors f a = Last a | a :-   Tensors f (f a)+Data.Tensors.Infinite data Tensors f a =          a :-   Tensors f (f a)+Data.Tensors.Finite   data Tensors f a = Last a | a :- !(Tensors f (f a))

@@ -0,0 +1,7 @@+#!/usr/bin/runhaskell+> module Main (main) where++> import Distribution.Simple++> main :: IO ()+> main = defaultMain

@@ -0,0 +1,95 @@+name:          streams+category:      Control, Comonads+version:       0.1.1+license:       BSD3+cabal-version: >= 1.6+license-file:  LICENSE+author:        Edward A. Kmett+maintainer:    Edward A. Kmett <ekmett@gmail.com>+stability:     provisional+homepage:      http://github.com/ekmett/streams+copyright:     Copyright 2011 Edward Kmett+               Copyright 2010 Tony Morris, Oliver Taylor, Eelis van der Weegen+               Copyright 2007-2010 Wouter Swierstra, Bas van Dijk+synopsis:      Various Haskell 2010 stream comonads+build-type:    Simple+extra-source-files: README+description:   +  Various Haskell 2010 stream comonads.+  .+  * "Data.Stream.Branching" provides an \"f-Branching Stream\" comonad, aka the cofree comonad, or generalized rose tree. +  .+  > data Stream f a = a :< f (Stream a)+  .+  * "Data.Stream.Future" provides a coinductive anti-causal stream, or non-empty 'ZipList'. The comonad provides access to only the +    tail of the stream. Like a conventional 'ZipList', this is /not/ a monad.+  .+  > data Future a = Last a | a :< Future a+  .+  * "Data.Stream.Future.Skew" provides a non-empty skew-binary random-access-list with the semantics of @Data.Stream.Future@. As with+    "Data.Stream.Future" this stream is not a 'Monad', since the 'Applicative' instance zips streams of potentially differing lengths. +    The random-access-list structure provides a number of operations logarithmic access time, but makes 'Data.Stream.Future.Skew.cons' +    less productive. Where applicable "Data.Stream.Infinite.Skew" may be more efficient, due to a lazier and more efficient 'Applicative' +    instance.+  . +  >+  .+  * "Data.Stream.NonEmpty" provides a non-empty list comonad where the Applicative and Monad work like those of the @[a]@. +    Being non-empty, it trades in the 'Alternative' and 'Monoid' instances of @[a]@ for weaker append-based 'FunctorAlt' and 'Semigroup'+    instances while becoming a member of 'Comonad' and 'ComonadApply'. Acting like a list, the semantics of '<*>' and+    '<.>' take a cross-product of membership from both 'NonEmpty' lists rather than zipping like a 'Future'+  .+  > data NonEmpty a = a :| [a]+  .+  * "Data.Stream.Infinite" provides a coinductive infinite anti-causal stream. The 'Comonad' provides access to the tail of the+    stream and the 'Applicative' zips streams together. Unlike 'Future', infinite stream form a 'Monad'. The monad diagonalizes +    the 'Stream', which is consistent with the behavior of the 'Applicative', and the view of a 'Stream' as a isomorphic to the reader +    monad from the natural numbers. Being infinite in length, there is no 'Alternative' instance, but instead the 'FunctorAlt'+    instance provides access to the 'Semigroup' of interleaving streams.+  .+  > data Stream a = a :< Stream a+  .+  * "Data.Stream.Infinite.Skew" provides an infinite skew-binary random-access-list with the semantics of "Data.Stream.Infinite"+    Since every stream is infinite, the 'Applicative' instance can be considerably less strict than the corresponding instance for +    "Data.Stream.Future.Skew" and performs asymptotically better.+  .+  >+  .+  * "Data.Stream.Infinite.Functional.Zipper" provides a bi-infinite sequence, represented as a pure function with an accumulating+    parameter added to optimize moving the current focus.+  .+  > data Zipper a = !Integer :~ (Integer -> a)+  .+  /Changes since 0.1/: +  .+  * A number of strictness issues with 'NonEmpty' were fixed+  * More documentation++source-repository head+  type: git+  location: git://github.com/ekmett/streams.git+  ++library+  build-depends:+    base >= 4 && < 4.4,+    comonad >= 0.6.0 && < 0.7,+    functor-apply >= 0.7.4 && < 0.8,+    semigroups >= 0.3.2 && < 0.4++  extensions: CPP+  if impl(ghc)+    cpp-options: -DLANGUAGE_DeriveDataTypeable+    extensions: FlexibleContexts, DeriveDataTypeable++  exposed-modules:+    Data.Stream.Branching+    Data.Stream.Future+    Data.Stream.Future.Skew+    Data.Stream.NonEmpty+    Data.Stream.Infinite+    Data.Stream.Infinite.Skew+    Data.Stream.Infinite.Functional.Zipper++  ghc-options: -Wall+