packages feed

streams 3.1.1 → 3.2

raw patch · 6 files changed

+98/−87 lines, 6 filesdep +adjunctionsdep ~comonaddep ~distributivedep ~semigroupoids

Dependencies added: adjunctions

Dependency ranges changed: comonad, distributive, semigroupoids, semigroups

Files

CHANGELOG.markdown view
@@ -1,3 +1,8 @@+3.2+---+* Switched to `tabulate` and `index` from `adjunctions`. Note: this reversed the argument order to `index`.+* Proper upper bounds on dependencies.+ 3.1.1 ----- * Marked modules appropriately Trustworthy
src/Data/Stream/Infinite.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE PatternGuards #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}@@ -51,7 +52,7 @@    , groupBy     -- :: (a -> a -> Bool) -> Stream a -> Stream (NonEmpty a)    -- * Sublist predicates    , isPrefixOf  -- :: [a] -> Stream a -> Bool-   -- * Indexing streams +   -- * Indexing streams    , (!!)        -- :: Int -> Stream a -> a    , elemIndex   -- :: Eq a => a -> Stream a -> Int    , elemIndices -- :: Eq a => a -> Stream a -> Stream Int@@ -70,7 +71,7 @@    , fromList    -- :: [a] -> Stream a    ) where -import Prelude hiding +import Prelude hiding   ( head, tail, map, scanr, scanr1, scanl, scanl1   , iterate, take, drop, takeWhile   , dropWhile, repeat, cycle, filter@@ -85,6 +86,7 @@ import Data.Data import Data.Functor.Apply import Data.Functor.Extend+import Data.Functor.Rep import Data.Semigroup import Data.Foldable import Data.Traversable@@ -93,7 +95,7 @@ import Data.Semigroup.Foldable import Data.List.NonEmpty (NonEmpty(..)) -data Stream a = a :> Stream a deriving +data Stream a = a :> Stream a deriving   ( Show #ifdef LANGUAGE_DeriveDataTypeable   , Data, Typeable@@ -113,6 +115,14 @@ instance Distributive Stream where   distribute w = fmap head w :> distribute (fmap tail w) +instance Representable Stream where+  type Rep Stream = Int+  tabulate f      = unfold (\i -> (,) (f i) $! (i + 1)) 0+  index (x :> xs) n+    | n == 0    = x+    | n > 0     = xs !! (n - 1)+    | otherwise = error "Stream.!! negative argument"+ -- | Extract the first element of the sequence. head :: Stream a -> a head (a :> _) = a@@ -268,8 +278,8 @@   | 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 +-- | @'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@@ -283,7 +293,7 @@ -- | @'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) +takeWhile p (x :> xs)   | p x = x : takeWhile p xs   | otherwise = [] @@ -313,7 +323,7 @@ -- /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) +filter p ~(x :> xs)   | p x       = x :> filter p xs   | otherwise = filter p xs @@ -341,8 +351,8 @@ group = groupBy (==)  groupBy :: (a -> a -> Bool) -> Stream a -> Stream (NonEmpty a)-groupBy eq ~(x :> ys) -  | (xs, zs) <- span (eq x) ys +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@@ -359,10 +369,7 @@ -- /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"+(!!) = index  -- | The 'elemIndex' function returns the index of the first element -- in the given stream which is equal (by '==') to the query element,@@ -388,7 +395,7 @@ findIndex :: (a -> Bool) -> Stream a -> Int findIndex p = indexFrom 0     where-    indexFrom ix (x :> xs) +    indexFrom ix (x :> xs)       | p x       = ix       | otherwise = (indexFrom $! (ix + 1)) xs @@ -400,8 +407,8 @@ -- 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 +  indicesFrom ix (x :> xs)+    | p x = ix :> ixs     | otherwise = ixs     where ixs = (indicesFrom $! (ix+1)) xs
src/Data/Stream/Infinite/Functional/Zipper.hs view
@@ -18,7 +18,7 @@    -- * The type of streams      Zipper(..)    , tail   -- :: Zipper a -> Zipper a-   , untail -- :: 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)@@ -43,7 +43,7 @@    , zipWith    ) where -import Prelude hiding +import Prelude hiding   ( head, tail, map, scanr, scanr1, scanl, scanl1   , iterate, take, drop, takeWhile   , dropWhile, repeat, cycle, filter@@ -74,7 +74,7 @@ #endif  toSequence :: (Integer -> a) -> Zipper a-toSequence = (0 :~) +toSequence = (0 :~)  infixr 0 :~ @@ -113,7 +113,7 @@   extract (n :~ f) = f n  instance Apply Zipper where-  (nf :~ f) <.> (na :~ a) +  (nf :~ f) <.> (na :~ a)     | dn <- na - nf     = nf :~ \n -> f n (a (n + dn))   as        <.  _         = as@@ -143,11 +143,11 @@ -- from each list. -- -- > [x1,x2,...] `interleave` [y1,y2,...] == [x1,y1,x2,y2,...]--- > interleave = (<>) +-- > interleave = (<>) interleave :: Zipper a -> Zipper a -> Zipper a-interleave = (<>) +interleave = (<>) instance Semigroup (Zipper a) where-  (n :~ a) <> (m :~ b) = 0 :~ \p -> case quotRem p 2 of +  (n :~ a) <> (m :~ b) = 0 :~ \p -> case quotRem p 2 of     (q, 0) -> a (n + q)     (q, _) -> b (m + q) @@ -167,14 +167,14 @@   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 +-- | @'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@@ -185,8 +185,8 @@ -- | @'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 +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 = [] @@ -201,7 +201,7 @@ -- | @'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) +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)@@ -230,14 +230,14 @@ -- @xs@ satisfy @p@. findIndex :: (a -> Bool) -> Zipper a -> Integer findIndex p0 (n0 :~ f0) = go p0 n0 f0 - n0 where-  go !p !n !f +  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 +-- | 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 +  go !p !n !f     | x <- f n, p x = n     | otherwise = go p (n + 1) f @@ -290,8 +290,8 @@ -- 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 +  indicesFrom ix (x :< xs)+    | p x = ix :< ixs     | otherwise = ixs     where ixs = (indicesFrom $! (ix+1)) xs
src/Data/Stream/Infinite/Skew.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE PatternGuards, BangPatterns #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}@@ -14,12 +15,12 @@ -- 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 +module Data.Stream.Infinite.Skew     ( Stream     , (<|)      -- O(1)     , (!!)@@ -27,14 +28,13 @@     , tail      -- O(1)     , tails     , uncons    -- O(1)-    , index     -- O(log n)     , drop      -- O(log n)     , dropWhile -- O(n)     , span     , break     , split     , splitW-    , repeat   +    , repeat     , insert    -- O(n)     , insertBy     , adjust    -- O(log n)@@ -43,8 +43,7 @@     , from     , indexed     , interleave-    , tabulate-    ) where +    ) where  import Control.Arrow (first) import Control.Applicative hiding (empty)@@ -52,6 +51,7 @@ import Data.Distributive import Data.Functor.Alt import Data.Functor.Extend+import Data.Functor.Rep import Data.Foldable hiding (toList) import Data.Traversable import Data.Semigroup hiding (Last)@@ -61,7 +61,7 @@  infixr 5 :<, <| -data Complete a +data Complete a     = Tip a     | Bin !Integer a !(Complete a) !(Complete a)     deriving Show@@ -81,7 +81,7 @@   extract (Bin _ a _ _) = a  instance Foldable Complete where-  foldMap f (Tip a) = f a +  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)@@ -91,14 +91,14 @@   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 (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 (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 -> Complete a -> Complete a -> Complete a bin a l r = Bin (1 + weight l + weight r) a l r {-# INLINE bin #-} @@ -108,12 +108,12 @@ {-# 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. +-- 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) $ +  showsPrec d as = showParen (d >= 10) $     showString "fromList " . showsPrec 11 (toList as)  instance Functor Stream where@@ -147,7 +147,7 @@   ( *>) = ( .>)  instance Alt Stream where-  as <!> bs = tabulate $ \i -> case quotRem i 2 of +  as <!> bs = tabulate $ \i -> case quotRem i 2 of     (q,0) -> as !! q     (q,_) -> bs !! q @@ -171,6 +171,15 @@ instance Distributive Stream where   distribute w = tabulate (\i -> fmap (!! i) w) +instance Representable Stream where+  type Rep Stream = Integer+  tabulate f      = mapWithIndex (const . f) (pure ())+  index (t :< ts) i+    | i < 0     = error "index: negative index"+    | i < w     = indexComplete i t+    | otherwise = index ts (i - w)+    where w = weight t+ instance Semigroup (Stream a) where   (<>) = (<!>) @@ -179,25 +188,21 @@   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 +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 +  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 (,) @@ -206,7 +211,7 @@  -- | /O(1)/ cons (<|) :: a -> Stream a -> Stream a-a <| (l :< r :< as) +a <| (l :< r :< as)   | weight l == weight r = bin a l r :< as a <| as = Tip a :< as {-# INLINE (<|) #-}@@ -232,18 +237,10 @@ 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) +indexComplete i (Bin w _ l r)   | i <= w'   = indexComplete (i-1) l   | otherwise = indexComplete (i-1-w') r   where w' = div w 2@@ -251,7 +248,7 @@  -- | /O(log n)/. (!!) :: Stream a -> Integer -> a-(!!) = flip index +(!!) = index  -- | /O(log n)/. drop :: Integer -> Stream a -> Stream a@@ -262,7 +259,7 @@   GT -> drop (i - w) ts   where w = weight t -dropComplete :: Integer -> Complete a -> (Complete a -> Stream a) -> Stream a +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@@ -274,7 +271,7 @@  -- /O(n)/. dropWhile :: (a -> Bool) -> Stream a -> Stream a-dropWhile p as +dropWhile p as   | p (head as) = dropWhile p (tail as)   | otherwise   = as @@ -308,7 +305,7 @@ -- -- > splitW p xs = (map extract &&& fmap (fmap extract)) . split p . duplicate splitW :: (Stream a -> Bool) -> Stream a -> ([a], Stream a)-splitW p (a :< as) +splitW p (a :< as)   | p as                    = splitCompleteW p a (:< as)   | (ts, fs) <- splitW p as = (foldr (:) ts a, fs) @@ -333,7 +330,7 @@  -- /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) +adjust !n f (a :< as)   | n < w = adjustComplete n f a :< as   | otherwise = a :< adjust (n - w) f as   where w = weight a@@ -341,7 +338,7 @@ 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) +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)
src/Data/Stream/Supply.hs view
@@ -21,7 +21,7 @@ -- 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, +-- ''On Generating Unique Names'' by Lennart Augustsson, Mikael Rittri, -- and Dan Synek. ---------------------------------------------------------------------------- module Data.Stream.Supply@@ -46,6 +46,7 @@ import Control.Comonad import Data.Functor.Apply import Data.Functor.Extend+import Data.Functor.Rep import Data.Foldable import Data.IORef(newIORef, atomicModifyIORef) import Data.Traversable@@ -67,7 +68,7 @@ unsafeDupableInterleaveIO = unsafeInterleaveIO #endif -data Supply a = Supply a (Supply a) (Supply a) deriving +data Supply a = Supply a (Supply a) (Supply a) deriving   ( Show, Read, Eq, Ord #ifdef LANGUAGE_DeriveDataTypeable   , Data, Typeable@@ -109,7 +110,7 @@  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 @@ -120,9 +121,9 @@ newSupply :: (a -> a) -> a -> IO (Supply a) newSupply f x = gen =<< newIORef x   where gen r = unsafeInterleaveIO $-          Supply <$> unsafeInterleaveIO (atomicModifyIORef r update) -                 <*> gen r +          Supply <$> unsafeInterleaveIO (atomicModifyIORef r update)                  <*> gen r+                 <*> gen r         update a = b `seq` (b, a) where b = f a {-# INLINE newSupply #-} @@ -165,7 +166,7 @@ {-# SPECIALIZE splits :: Supply a -> Integer -> Supply a #-}  splitSkew :: Supply a -> Skew.Stream (Supply a)-splitSkew = Skew.tabulate . splits+splitSkew = tabulate . splits  split2 :: Supply a -> (Supply a, Supply a) split2 (Supply _ l r) = (l, r)
streams.cabal view
@@ -1,6 +1,6 @@ name:          streams category:      Control, Comonads-version:       3.1.1+version:       3.2 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -68,11 +68,12 @@     BangPatterns    build-depends:-    base          >= 4 && < 5,-    comonad       >= 3,-    distributive  >= 0.2.1,-    semigroupoids >= 3,-    semigroups    >= 0.8.3.1+    base          >= 4       && < 5,+    adjunctions   >= 4.0.1   && < 5,+    comonad       >= 4       && < 5,+    distributive  >= 0.2.1   && < 1,+    semigroupoids >= 4       && < 5,+    semigroups    >= 0.8.3.1 && < 1    extensions: CPP   if impl(ghc)