streams: Various Haskell 2010 stream comonads

[ bsd3, comonads, control, library ] [ Propose Tags ]

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 Zipper a = !Integer :~ (Integer -> a)
  • Data.Stream.Supply provides a comonadic supply of unique values, which are generated impurely as the tree is explored.

Changes since 0.5.1:

  • Removed a redundant UNPACK pragma

Changes since 0.5:

  • Data.Stream.Supply added

Changes since 0.1:

  • A number of strictness issues with NonEmpty were fixed

  • More documentation


[Skip to Readme]

Downloads

Maintainer's Corner

Package maintainers

For package maintainers and hackage trustees

Candidates

  • No Candidates
Versions [RSS] 0.1.1, 0.2, 0.3, 0.3.1, 0.4, 0.5.0, 0.5.1, 0.5.1.1, 0.5.1.2, 0.6.0, 0.6.0.1, 0.6.1.1, 0.6.1.2, 0.6.3, 0.7.0, 0.7.1, 0.7.2, 0.8.0, 0.8.0.1, 0.8.0.2, 0.8.0.3, 0.8.0.4, 0.8.1, 0.8.2, 3.0, 3.0.0.1, 3.0.1, 3.0.1.1, 3.1, 3.1.1, 3.2, 3.2.1, 3.3, 3.3.1, 3.3.2
Dependencies base (>=4 && <4.4), comonad (>=1.0 && <1.1), distributive (>=0.1 && <0.2), semigroupoids (>=1.0 && <1.2), semigroups (>=0.3.4 && <0.4) [details]
License BSD-3-Clause
Copyright Copyright 2011 Edward Kmett Copyright 2010 Tony Morris, Oliver Taylor, Eelis van der Weegen Copyright 2007-2010 Wouter Swierstra, Bas van Dijk Copyright 2008 Iavor S. Diatchki
Author Edward A. Kmett
Maintainer Edward A. Kmett <ekmett@gmail.com>
Category Control, Comonads
Home page http://github.com/ekmett/streams
Source repo head: git clone git://github.com/ekmett/streams.git
Uploaded by EdwardKmett at 2011-01-31T16:44:16Z
Distributions Arch:3.3.2, LTSHaskell:3.3.2, NixOS:3.3.2, Stackage:3.3.2
Reverse Dependencies 9 direct, 7725 indirect [details]
Downloads 28045 total (113 in the last 30 days)
Rating 2.0 (votes: 1) [estimated by Bayesian average]
Your Rating
  • λ
  • λ
  • λ
Status Docs uploaded by user
Build status unknown [no reports yet]

Readme for streams-0.6.0.1

[back to package description]
-- currently implemented

* Data.Stream.Supply          data Supply a = Supply a (Supply a) (Supply a)
* 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))