diff --git a/.ghci b/.ghci deleted file mode 100644 --- a/.ghci +++ /dev/null @@ -1,1 +0,0 @@ -:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h diff --git a/.gitignore b/.gitignore --- a/.gitignore +++ b/.gitignore @@ -1,29 +1,32 @@ -dist -docs -wiki -TAGS -tags -wip -.DS_Store -.*.swp -.*.swo -*.o -*.hi -*~ -*# -dist-* -cabal-dev -*.chi -*.chs.h -*.dyn_o -*.dyn_hi -.hpc -.hsenv -.cabal-sandbox/ -cabal.sandbox.config -*.prof -*.aux -*.hp -*.eventlog -.stack-work/ -cabal.project.local +dist +dist-newstyle +docs +wiki +TAGS +tags +wip +.DS_Store +.*.swp +.*.swo +*.o +*.hi +*~ +*# +.stack-work/ +cabal-dev +*.chi +*.chs.h +*.dyn_o +*.dyn_hi +.hpc +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +*.prof +*.aux +*.hp +*.eventlog +cabal.project.local +cabal.project.local~ +.HTF/ +.ghc.environment.* diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 --- a/.travis.yml +++ /dev/null @@ -1,101 +0,0 @@ -# This file has been generated -- see https://github.com/hvr/multi-ghc-travis -language: c -sudo: false - -cache: - directories: - - $HOME/.cabsnap - - $HOME/.cabal/packages - -before_cache: - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar - -matrix: - include: - - env: CABALVER=1.18 GHCVER=7.4.2 - compiler: ": #GHC 7.4.2" - addons: {apt: {packages: [cabal-install-1.18,ghc-7.4.2], sources: [hvr-ghc]}} - - env: CABALVER=1.18 GHCVER=7.6.3 - compiler: ": #GHC 7.6.3" - addons: {apt: {packages: [cabal-install-1.18,ghc-7.6.3], sources: [hvr-ghc]}} - - env: CABALVER=1.18 GHCVER=7.8.4 - compiler: ": #GHC 7.8.4" - addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} - - env: CABALVER=1.22 GHCVER=7.10.3 - compiler: ": #GHC 7.10.3" - addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}} - - env: CABALVER=1.24 GHCVER=8.0.1 - compiler: ": #GHC 8.0.1" - addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}} - - env: CABALVER=head GHCVER=head - compiler: ": #GHC head" - addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}} - - allow_failures: - - env: CABALVER=head GHCVER=head - -before_install: - - unset CC - - export PATH=$HOME/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH - -install: - - cabal --version - - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" - - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ]; - then - zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz > - $HOME/.cabal/packages/hackage.haskell.org/00-index.tar; - fi - - travis_retry cabal update -v - - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config - - cabal install --only-dependencies --enable-tests --dry -v > installplan.txt - - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt - -# check whether current requested install-plan matches cached package-db snapshot - - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt; - then - echo "cabal build-cache HIT"; - rm -rfv .ghc; - cp -a $HOME/.cabsnap/ghc $HOME/.ghc; - cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/; - else - echo "cabal build-cache MISS"; - rm -rf $HOME/.cabsnap; - mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin; - cabal install -j --only-dependencies --enable-tests; - fi - -# snapshot package-db on cache miss - - if [ ! -d $HOME/.cabsnap ]; - then - echo "snapshotting package-db to build-cache"; - mkdir $HOME/.cabsnap; - cp -a $HOME/.ghc $HOME/.cabsnap/ghc; - cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/; - fi - -# Here starts the actual work to be performed for the package under test; -# any command which exits with a non-zero exit code causes the build to fail. -script: - - cabal configure -v2 --enable-tests # -v2 provides useful information for debugging - - cabal build # this builds all libraries and executables (including tests/benchmarks) - - cabal sdist # tests that a source-distribution can be generated - - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ; - cd dist/; - if [ -f "$SRC_TGZ" ]; then - cabal install "$SRC_TGZ"; - else - echo "expected '$SRC_TGZ' not found"; - exit 1; - fi - -notifications: - irc: - channels: - - "irc.freenode.org#haskell-lens" - skip_join: true - template: - - "\x0313streams\x0f/\x0306%{branch}\x0f \x0314%{commit}\x0f %{message} \x0302\x1f%{build_url}\x0f" - -# EOF diff --git a/.vim.custom b/.vim.custom --- a/.vim.custom +++ b/.vim.custom @@ -1,31 +1,31 @@ -" Add the following to your .vimrc to automatically load this on startup - -" if filereadable(".vim.custom") -" so .vim.custom -" endif - -function StripTrailingWhitespace() - let myline=line(".") - let mycolumn = col(".") - silent %s/ *$// - call cursor(myline, mycolumn) -endfunction - -" enable syntax highlighting -syntax on - -" search for the tags file anywhere between here and / -set tags=TAGS;/ - -" highlight tabs and trailing spaces -set listchars=tab:‗‗,trail:‗ -set list - -" f2 runs hasktags -map :exec ":!hasktags -x -c --ignore src" - -" strip trailing whitespace before saving -" au BufWritePre *.hs,*.markdown silent! cal StripTrailingWhitespace() - -" rebuild hasktags after saving -au BufWritePost *.hs silent! :exec ":!hasktags -x -c --ignore src" +" Add the following to your .vimrc to automatically load this on startup + +" if filereadable(".vim.custom") +" so .vim.custom +" endif + +function StripTrailingWhitespace() + let myline=line(".") + let mycolumn = col(".") + silent %s/ *$// + call cursor(myline, mycolumn) +endfunction + +" enable syntax highlighting +syntax on + +" search for the tags file anywhere between here and / +set tags=TAGS;/ + +" highlight tabs and trailing spaces +set listchars=tab:‗‗,trail:‗ +set list + +" f2 runs hasktags +map :exec ":!hasktags -x -c --ignore src" + +" strip trailing whitespace before saving +" au BufWritePre *.hs,*.markdown silent! cal StripTrailingWhitespace() + +" rebuild hasktags after saving +au BufWritePost *.hs silent! :exec ":!hasktags -x -c --ignore src" diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,50 +1,55 @@ -3.3 ---- -* Removed a number of redundant parts of the API. If a method you were using has been removed, consider the classes available. No functionality was lost. -* Better support for GHC 7.10, the `Foldable (length, null)` members are now defined directly leading to asymptotic improvements and helping to further shrink the API. -* Added `prepend` and `concat` functions to `Data.Stream.Infinite` -* Allow `comonad-5` - -3.2.2 ------ -* Bug fix in `Data.Stream.Infinite.Skew` and removed `fromList`. - -3.2.1 ------ -* Add support for `semigroupoids` 5 and GHC 7.10 - -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 - -3.0.1 ------ -* Removed intra-package dependency bounds for my packages -* Build system improvements -* IRC Buildbot notification - -3.0 ---- -* Version sync with the rest of my packages - -0.7 --- -* "Data.Stream.NonEmpty" renamed to "Data.List.NonEmpty" and pushed upstream into the semigroups package. - -0.6.3 ------ -* Removed a redundant UNPACK pragma - -0.5.1 ------ -* Data.Stream.Supply added - -Since 0.1: ----------- -* A number of strictness issues with 'NonEmpty' were fixed -* More documentation +3.3.1 [2022.11.30] +------------------ +* Add `Boring` and `Absurd` instances for infinite streams. +* Add a `head :: Stream a -> a` function to `Data.Stream.Infinite`. + +3.3 +--- +* Removed a number of redundant parts of the API. If a method you were using has been removed, consider the classes available. No functionality was lost. +* Better support for GHC 7.10, the `Foldable (length, null)` members are now defined directly leading to asymptotic improvements and helping to further shrink the API. +* Added `prepend` and `concat` functions to `Data.Stream.Infinite` +* Allow `comonad-5` + +3.2.2 +----- +* Bug fix in `Data.Stream.Infinite.Skew` and removed `fromList`. + +3.2.1 +----- +* Add support for `semigroupoids` 5 and GHC 7.10 + +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 + +3.0.1 +----- +* Removed intra-package dependency bounds for my packages +* Build system improvements +* IRC Buildbot notification + +3.0 +--- +* Version sync with the rest of my packages + +0.7 +-- +* "Data.Stream.NonEmpty" renamed to "Data.List.NonEmpty" and pushed upstream into the semigroups package. + +0.6.3 +----- +* Removed a redundant UNPACK pragma + +0.5.1 +----- +* Data.Stream.Supply added + +Since 0.1: +---------- +* A number of strictness issues with 'NonEmpty' were fixed +* More documentation diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,33 +1,33 @@ -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 - -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. +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 + +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. diff --git a/README b/README --- a/README +++ b/README @@ -1,42 +1,42 @@ --- 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)) +-- 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)) diff --git a/Setup.lhs b/Setup.lhs --- a/Setup.lhs +++ b/Setup.lhs @@ -1,7 +1,7 @@ -#!/usr/bin/runhaskell -> module Main (main) where - -> import Distribution.Simple - -> main :: IO () -> main = defaultMain +#!/usr/bin/runhaskell +> module Main (main) where + +> import Distribution.Simple + +> main :: IO () +> main = defaultMain diff --git a/src/Data/Stream/Future.hs b/src/Data/Stream/Future.hs --- a/src/Data/Stream/Future.hs +++ b/src/Data/Stream/Future.hs @@ -1,164 +1,166 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Trustworthy #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Data.Stream.Future --- Copyright : (C) 2011-2015 Edward Kmett --- License : BSD-style (see the file LICENSE) --- --- Maintainer : Edward Kmett --- Stability : provisional --- Portability : portable --- ----------------------------------------------------------------------------- - -module Data.Stream.Future - ( Future(..) - , tail - , length - , index - ) where - -#if MIN_VERSION_base(4,8,0) -import Prelude hiding (tail) -#else -import Control.Applicative -import Prelude hiding (tail, length) -import Data.Foldable -#endif - -import Control.Comonad -import Data.Functor.Alt -import Data.Functor.Extend -import Data.Traversable -import Data.Semigroup hiding (Last) -import Data.Semigroup.Foldable -import Data.Semigroup.Traversable - -#ifdef LANGUAGE_DeriveDataTypeable -import Data.Data -#endif - -#if MIN_VERSION_base(4,7,0) -import GHC.Exts as Exts -#endif - -infixr 5 :< - -data Future a = Last a | a :< Future a deriving - ( Eq, Ord, Show, Read -#ifdef LANGUAGE_DeriveDataTypeable - , Data, Typeable -#endif - ) - -#if __GLASGOW_HASKELL__ < 710 -length :: Future a -> Int -length = go 1 - where - go !n (Last _) = n - go !n (_ :< as) = go (n + 1) as -{-# INLINE length #-} -#endif - -tail :: Future a -> Maybe (Future a) -tail (Last _) = Nothing -tail (_ :< as) = Just as -{-# INLINE tail #-} - -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 f (a :< as) = f a :< fmap f as - fmap f (Last a) = Last (f a) - b <$ (_ :< as) = b :< (b <$ as) - b <$ _ = Last b - -instance Foldable Future where - foldMap = foldMapDefault -#if __GLASGOW_HASKELL__ >= 710 - length = go 1 - where - go !n (Last _) = n - go !n (_ :< as) = go (n + 1) as - {-# INLINE length #-} - null _ = False -#endif - -instance Traversable Future where - traverse f (Last a) = Last <$> f a - traverse f (a :< as) = (:<) <$> f a <*> traverse f as - -instance Foldable1 Future - -instance Traversable1 Future where - traverse1 f (Last a) = Last <$> f a - traverse1 f (a :< as) = (:<) <$> f a <.> traverse1 f as - -instance Extend Future where - extended = extend - -instance Comonad Future where - extract (Last a) = a - extract (a :< _) = a - - duplicate w@(_ :< as) = w :< duplicate as - duplicate w@(Last _) = Last w - - extend f w@(_ :< as) = f w :< extend f as - extend f w@(Last _) = Last (f w) - -instance Apply Future where - Last f <.> Last a = Last (f a) - (f :< _) <.> Last a = Last (f a) - Last f <.> (a :< _ ) = Last (f a) - (f :< fs) <.> (a :< as) = f a :< (fs <.> as) - - Last a <. _ = Last a - (a :< _ ) <. Last _ = Last a - (a :< as) <. (_ :< bs) = a :< (as <. bs) - - _ .> Last b = Last b - Last _ .> (b :< _) = Last b - (_ :< as) .> (b :< bs) = b :< (as .> bs) - -instance ComonadApply Future where - (<@>) = (<.>) - -instance Alt Future where - Last a bs = a :< bs - (a :< as) bs = a :< (as bs) - -instance Semigroup (Future a) where - (<>) = () - -instance Applicative Future where - pure = Last - (<*>) = (<.>) - (<* ) = (<. ) - ( *>) = ( .>) - -#if MIN_VERSION_base(4,7,0) -instance Exts.IsList (Future a) where - type Item (Future a) = a - - toList (Last a) = [a] - toList (a :< as) = a : Exts.toList as - - fromList [] = error "Future.fromList: empty list" - fromList (x:xs) = go x xs where - go y [] = Last y - go y (z:zs) = y :< go z zs - - fromListN _ = Exts.fromList -#endif +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Trustworthy #-} +#endif +----------------------------------------------------------------------------- +-- | +-- Module : Data.Stream.Future +-- Copyright : (C) 2011-2015 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : provisional +-- Portability : portable +-- +---------------------------------------------------------------------------- + +module Data.Stream.Future + ( Future(..) + , tail + , length + , index + ) where + +#if MIN_VERSION_base(4,8,0) +import Prelude hiding (tail) +#else +import Control.Applicative +import Prelude hiding (tail, length) +import Data.Foldable +#endif + +import Control.Comonad +import Data.Functor.Alt +import Data.Functor.Extend +import Data.Traversable +#if !(MIN_VERSION_base(4,11,0)) +import Data.Semigroup hiding (Last) +#endif +import Data.Semigroup.Foldable +import Data.Semigroup.Traversable + +#ifdef LANGUAGE_DeriveDataTypeable +import Data.Data +#endif + +#if MIN_VERSION_base(4,7,0) +import GHC.Exts as Exts +#endif + +infixr 5 :< + +data Future a = Last a | a :< Future a deriving + ( Eq, Ord, Show, Read +#ifdef LANGUAGE_DeriveDataTypeable + , Data, Typeable +#endif + ) + +#if __GLASGOW_HASKELL__ < 710 +length :: Future a -> Int +length = go 1 + where + go !n (Last _) = n + go !n (_ :< as) = go (n + 1) as +{-# INLINE length #-} +#endif + +tail :: Future a -> Maybe (Future a) +tail (Last _) = Nothing +tail (_ :< as) = Just as +{-# INLINE tail #-} + +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 f (a :< as) = f a :< fmap f as + fmap f (Last a) = Last (f a) + b <$ (_ :< as) = b :< (b <$ as) + b <$ _ = Last b + +instance Foldable Future where + foldMap = foldMapDefault +#if __GLASGOW_HASKELL__ >= 710 + length = go 1 + where + go !n (Last _) = n + go !n (_ :< as) = go (n + 1) as + {-# INLINE length #-} + null _ = False +#endif + +instance Traversable Future where + traverse f (Last a) = Last <$> f a + traverse f (a :< as) = (:<) <$> f a <*> traverse f as + +instance Foldable1 Future + +instance Traversable1 Future where + traverse1 f (Last a) = Last <$> f a + traverse1 f (a :< as) = (:<) <$> f a <.> traverse1 f as + +instance Extend Future where + extended = extend + +instance Comonad Future where + extract (Last a) = a + extract (a :< _) = a + + duplicate w@(_ :< as) = w :< duplicate as + duplicate w@(Last _) = Last w + + extend f w@(_ :< as) = f w :< extend f as + extend f w@(Last _) = Last (f w) + +instance Apply Future where + Last f <.> Last a = Last (f a) + (f :< _) <.> Last a = Last (f a) + Last f <.> (a :< _ ) = Last (f a) + (f :< fs) <.> (a :< as) = f a :< (fs <.> as) + + Last a <. _ = Last a + (a :< _ ) <. Last _ = Last a + (a :< as) <. (_ :< bs) = a :< (as <. bs) + + _ .> Last b = Last b + Last _ .> (b :< _) = Last b + (_ :< as) .> (b :< bs) = b :< (as .> bs) + +instance ComonadApply Future where + (<@>) = (<.>) + +instance Alt Future where + Last a bs = a :< bs + (a :< as) bs = a :< (as bs) + +instance Semigroup (Future a) where + (<>) = () + +instance Applicative Future where + pure = Last + (<*>) = (<.>) + (<* ) = (<. ) + ( *>) = ( .>) + +#if MIN_VERSION_base(4,7,0) +instance Exts.IsList (Future a) where + type Item (Future a) = a + + toList (Last a) = [a] + toList (a :< as) = a : Exts.toList as + + fromList [] = error "Future.fromList: empty list" + fromList (x:xs) = go x xs where + go y [] = Last y + go y (z:zs) = y :< go z zs + + fromListN _ = Exts.fromList +#endif diff --git a/src/Data/Stream/Future/Skew.hs b/src/Data/Stream/Future/Skew.hs --- a/src/Data/Stream/Future/Skew.hs +++ b/src/Data/Stream/Future/Skew.hs @@ -1,439 +1,441 @@ -{-# LANGUAGE PatternGuards, BangPatterns, TypeFamilies #-} -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Trustworthy #-} -#endif - ------------------------------------------------------------------------------ --- | --- Module : Data.Stream.Future.Skew --- Copyright : (C) 2008-2015 Edward Kmett, --- (C) 2004 Dave Menendez --- License : BSD-style (see the file LICENSE) --- --- Maintainer : Edward Kmett --- 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) - , length -- O(log n) - , tail -- O(1) - , 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) - , replicate -- O(log n) - , insert -- O(n) - , insertBy - , update - , adjust -- O(log n) - , toFuture - , singleton - ) where - -import Control.Applicative hiding (empty) -import Control.Comonad -import Data.Functor.Alt -import Data.Functor.Extend -#if MIN_VERSION_base(4,8,0) -import Prelude hiding (tail, drop, dropWhile, last, span, repeat, replicate, break) -import Data.Foldable (toList) -#else -import Data.Foldable -import Data.Traversable (Traversable, traverse) -import Prelude hiding (null, tail, drop, dropWhile, length, foldr, last, span, repeat, replicate, break) -#endif -import Data.Semigroup hiding (Last) -import Data.Semigroup.Foldable -import Data.Semigroup.Traversable -#if MIN_VERSION_base(4,7,0) -import qualified GHC.Exts as Exts -#endif - -infixr 5 :<, <| - -data Complete a - = Tip a - | Bin {-# UNPACK #-} !Int a !(Complete a) !(Complete a) - deriving Show - -instance Functor Complete where - fmap f (Tip a) = Tip (f a) - fmap f (Bin w a l r) = Bin w (f a) (fmap f l) (fmap f r) - -instance Extend Complete where - extended = extend - -instance Comonad Complete where - extend f w@Tip {} = Tip (f w) - extend f w@(Bin n _ l r) = Bin n (f w) (extend f l) (extend f r) - extract (Tip a) = a - extract (Bin _ a _ _) = a - -instance Foldable Complete where - foldMap f (Tip a) = f a - foldMap f (Bin _ a l r) = f a `mappend` foldMap f l `mappend` foldMap f r - foldr f z (Tip a) = f a z - foldr f z (Bin _ a l r) = f a (foldr f (foldr f z r) l) -#if MIN_VERSION_base(4,8,0) - length Tip{} = 1 - length (Bin n _ _ _) = n - null _ = False -#endif - -instance Foldable1 Complete where - foldMap1 f (Tip a) = f a - foldMap1 f (Bin _ a l r) = f a <> foldMap1 f l <> foldMap1 f r - -instance Traversable Complete where - traverse f (Tip a) = Tip <$> f a - traverse f (Bin n a l r) = Bin n <$> f a <*> traverse f l <*> traverse f r - -instance Traversable1 Complete where - traverse1 f (Tip a) = Tip <$> f a - traverse1 f (Bin n a l r) = Bin n <$> f a <.> traverse1 f l <.> traverse1 f r - -bin :: a -> Complete a -> Complete a -> Complete a -bin a l r = Bin (1 + weight l + weight r) a l r -{-# INLINE bin #-} - -weight :: Complete a -> Int -weight Tip{} = 1 -weight (Bin w _ _ _) = w -{-# INLINE weight #-} - --- A future is a non-empty skew binary random access list of nodes. --- The last node, however, is allowed to contain fewer values. -data Future a - = Last !(Complete a) - | !(Complete a) :< Future a --- deriving Show - - -instance Show a => Show (Future a) where - showsPrec d as = showParen (d >= 10) $ - showString "fromList " . showsPrec 11 (toList as) - -instance Functor Future where - fmap f (t :< ts) = fmap f t :< fmap f ts - fmap f (Last t) = Last (fmap f t) - -instance Extend Future where - extended = extend - -instance Comonad Future where - extend g (Last t) = Last (extendTree g t Last) - extend g (t :< ts) = extendTree g t (:< ts) :< extend g ts - extract (a :< _) = extract a - extract (Last a) = extract a - -extendTree :: (Future a -> b) -> Complete a -> (Complete a -> Future a) -> Complete b -extendTree g w@Tip{} f = Tip (g (f w)) -extendTree g w@(Bin n _ l r) f = Bin n (g (f w)) (extendTree g l (:< f r)) (extendTree g r f) - -instance Apply Future where - Last (Tip f) <.> as = singleton (f (extract as)) - fs <.> Last (Tip a) = singleton (extract fs a) - Last (Bin _ f lf rf) <.> Last (Bin _ a la ra) = f a <| (lf :< Last rf <.> la :< Last ra ) - Last (Bin _ f lf rf) <.> Bin _ a la ra :< as = f a <| (lf :< Last rf <.> la :< ra :< as) - Last (Bin _ f lf rf) <.> Tip a :< as = f a <| (lf :< Last rf <.> as ) - Bin _ f lf rf :< fs <.> Last (Bin _ a la ra) = f a <| (lf :< rf :< fs <.> la :< Last ra ) - Bin _ f lf rf :< fs <.> Tip a :< as = f a <| (lf :< rf :< fs <.> as ) - Bin _ f lf rf :< fs <.> Bin _ a la ra :< as = f a <| (lf :< rf :< fs <.> la :< ra :< as) - Tip f :< fs <.> Tip a :< as = f a <| (fs <.> as ) - Tip f :< fs <.> Bin _ a la ra :< as = f a <| (fs <.> la :< ra :< as) - Tip f :< fs <.> Last (Bin _ a la ra) = f a <| (fs <.> la :< Last ra ) - -instance ComonadApply Future where - (<@>) = (<.>) - -instance Applicative Future where - pure a0 = go a0 (Tip a0) where - go :: a -> Complete a -> Future a - go a as | ass <- bin a as as = as :< go a ass - (<*>) = (<.>) - -instance Alt Future where - as bs = foldr (<|) bs as - -instance Foldable Future where - foldMap f (t :< ts) = foldMap f t `mappend` foldMap f ts - foldMap f (Last t) = foldMap f t - foldr f z (t :< ts) = foldr f (foldr f z ts) t - foldr f z (Last t) = foldr f z t -#if MIN_VERSION_base(4,8,0) - length (Last t) = weight t - length (t :< ts) = weight t + length ts - null _ = False -#endif - -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 - --- | /O(log n)/ -replicate :: Int -> a -> Future a -replicate n a - | n <= 0 = error "replicate: non-positive argument" - | otherwise = go 1 n a (Tip a) (\ _ r -> r) - where - -- invariants: - -- tb is a complete tree of i nodes all equal to b - -- 1 <= i = 2^m-1 <= j - -- k accepts r such that 0 <= r < i - go :: Int -> Int -> b -> Complete b -> (Int -> Future b -> r) -> r - go !i !j b tb k - | j >= i2p1 = go i2p1 j b (Bin i2p1 b tb tb) k' - | j >= i2 = k (j - i2) (tb :< Last tb) - | otherwise = k (j - i) (Last tb) - where - i2 = i * 2 - i2p1 = i2 + 1 - k' r xs - | r >= i2 = k (r - i2) (tb :< tb :< xs) - | r >= i = k (r - i) (tb :< xs) - | otherwise = k r xs -{-# INLINE replicate #-} - -mapWithIndex :: (Int -> a -> b) -> Future a -> Future b -mapWithIndex f0 as0 = spine f0 0 as0 - where - spine f m (Last as) = Last (tree f m as) - spine f m (a :< as) = tree f m a :< spine f (m + weight a) as - tree f m (Tip a) = Tip (f m a) - tree f m (Bin n a l r) = Bin n (f m a) (tree f (m + 1) l) (tree f (m + 1 + weight l) r) - -indexed :: Future a -> Future (Int, a) -indexed = mapWithIndex (,) -{-# INLINE indexed #-} - -from :: Num a => a -> Future a -from a = mapWithIndex ((+) . fromIntegral) (pure a) -{-# INLINE from #-} - --- | /O(1)/ -singleton :: a -> Future a -singleton a = Last (Tip a) -{-# INLINE singleton #-} - -#if !(MIN_VERSION_base(4,8,0)) --- | /O(log n)/. -length :: Future a -> Int -length (Last t) = weight t -length (t :< ts) = weight t + length ts -#endif - --- | /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 (<|) #-} - --- | /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 #-} - --- | /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 (extract 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) - -#if MIN_VERSION_base(4,7,0) -instance Exts.IsList (Future a) where - type Item (Future a) = a - toList = Data.Foldable.toList - fromList [] = error "fromList: empty list" - fromList (x:xs) = go x xs - where go a [] = singleton a - go a (b:bs) = a <| go b bs -#else -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 -#endif - -toFuture :: [a] -> Maybe (Future a) -toFuture [] = Nothing -#if MIN_VERSION_base(4,7,0) -toFuture xs = Just (Exts.fromList xs) -#else -toFuture xs = Just (fromList xs) -#endif - --- /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 +{-# LANGUAGE PatternGuards, BangPatterns, TypeFamilies #-} +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Trustworthy #-} +#endif + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Stream.Future.Skew +-- Copyright : (C) 2008-2015 Edward Kmett, +-- (C) 2004 Dave Menendez +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- 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) + , length -- O(log n) + , tail -- O(1) + , 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) + , replicate -- O(log n) + , insert -- O(n) + , insertBy + , update + , adjust -- O(log n) + , toFuture + , singleton + ) where + +import Control.Applicative hiding (empty) +import Control.Comonad +import Data.Functor.Alt +import Data.Functor.Extend +#if MIN_VERSION_base(4,8,0) +import Prelude hiding (tail, drop, dropWhile, last, span, repeat, replicate, break) +import Data.Foldable (toList) +#else +import Data.Foldable +import Data.Traversable (Traversable, traverse) +import Prelude hiding (null, tail, drop, dropWhile, length, foldr, last, span, repeat, replicate, break) +#endif +#if !(MIN_VERSION_base(4,11,0)) +import Data.Semigroup hiding (Last) +#endif +import Data.Semigroup.Foldable +import Data.Semigroup.Traversable +#if MIN_VERSION_base(4,7,0) +import qualified GHC.Exts as Exts +#endif + +infixr 5 :<, <| + +data Complete a + = Tip a + | Bin {-# UNPACK #-} !Int a !(Complete a) !(Complete a) + deriving Show + +instance Functor Complete where + fmap f (Tip a) = Tip (f a) + fmap f (Bin w a l r) = Bin w (f a) (fmap f l) (fmap f r) + +instance Extend Complete where + extended = extend + +instance Comonad Complete where + extend f w@Tip {} = Tip (f w) + extend f w@(Bin n _ l r) = Bin n (f w) (extend f l) (extend f r) + extract (Tip a) = a + extract (Bin _ a _ _) = a + +instance Foldable Complete where + foldMap f (Tip a) = f a + foldMap f (Bin _ a l r) = f a `mappend` foldMap f l `mappend` foldMap f r + foldr f z (Tip a) = f a z + foldr f z (Bin _ a l r) = f a (foldr f (foldr f z r) l) +#if MIN_VERSION_base(4,8,0) + length Tip{} = 1 + length (Bin n _ _ _) = n + null _ = False +#endif + +instance Foldable1 Complete where + foldMap1 f (Tip a) = f a + foldMap1 f (Bin _ a l r) = f a <> foldMap1 f l <> foldMap1 f r + +instance Traversable Complete where + traverse f (Tip a) = Tip <$> f a + traverse f (Bin n a l r) = Bin n <$> f a <*> traverse f l <*> traverse f r + +instance Traversable1 Complete where + traverse1 f (Tip a) = Tip <$> f a + traverse1 f (Bin n a l r) = Bin n <$> f a <.> traverse1 f l <.> traverse1 f r + +bin :: a -> Complete a -> Complete a -> Complete a +bin a l r = Bin (1 + weight l + weight r) a l r +{-# INLINE bin #-} + +weight :: Complete a -> Int +weight Tip{} = 1 +weight (Bin w _ _ _) = w +{-# INLINE weight #-} + +-- A future is a non-empty skew binary random access list of nodes. +-- The last node, however, is allowed to contain fewer values. +data Future a + = Last !(Complete a) + | !(Complete a) :< Future a +-- deriving Show + + +instance Show a => Show (Future a) where + showsPrec d as = showParen (d >= 10) $ + showString "fromList " . showsPrec 11 (toList as) + +instance Functor Future where + fmap f (t :< ts) = fmap f t :< fmap f ts + fmap f (Last t) = Last (fmap f t) + +instance Extend Future where + extended = extend + +instance Comonad Future where + extend g (Last t) = Last (extendTree g t Last) + extend g (t :< ts) = extendTree g t (:< ts) :< extend g ts + extract (a :< _) = extract a + extract (Last a) = extract a + +extendTree :: (Future a -> b) -> Complete a -> (Complete a -> Future a) -> Complete b +extendTree g w@Tip{} f = Tip (g (f w)) +extendTree g w@(Bin n _ l r) f = Bin n (g (f w)) (extendTree g l (:< f r)) (extendTree g r f) + +instance Apply Future where + Last (Tip f) <.> as = singleton (f (extract as)) + fs <.> Last (Tip a) = singleton (extract fs a) + Last (Bin _ f lf rf) <.> Last (Bin _ a la ra) = f a <| (lf :< Last rf <.> la :< Last ra ) + Last (Bin _ f lf rf) <.> Bin _ a la ra :< as = f a <| (lf :< Last rf <.> la :< ra :< as) + Last (Bin _ f lf rf) <.> Tip a :< as = f a <| (lf :< Last rf <.> as ) + Bin _ f lf rf :< fs <.> Last (Bin _ a la ra) = f a <| (lf :< rf :< fs <.> la :< Last ra ) + Bin _ f lf rf :< fs <.> Tip a :< as = f a <| (lf :< rf :< fs <.> as ) + Bin _ f lf rf :< fs <.> Bin _ a la ra :< as = f a <| (lf :< rf :< fs <.> la :< ra :< as) + Tip f :< fs <.> Tip a :< as = f a <| (fs <.> as ) + Tip f :< fs <.> Bin _ a la ra :< as = f a <| (fs <.> la :< ra :< as) + Tip f :< fs <.> Last (Bin _ a la ra) = f a <| (fs <.> la :< Last ra ) + +instance ComonadApply Future where + (<@>) = (<.>) + +instance Applicative Future where + pure a0 = go a0 (Tip a0) where + go :: a -> Complete a -> Future a + go a as | ass <- bin a as as = as :< go a ass + (<*>) = (<.>) + +instance Alt Future where + as bs = foldr (<|) bs as + +instance Foldable Future where + foldMap f (t :< ts) = foldMap f t `mappend` foldMap f ts + foldMap f (Last t) = foldMap f t + foldr f z (t :< ts) = foldr f (foldr f z ts) t + foldr f z (Last t) = foldr f z t +#if MIN_VERSION_base(4,8,0) + length (Last t) = weight t + length (t :< ts) = weight t + length ts + null _ = False +#endif + +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 + +-- | /O(log n)/ +replicate :: Int -> a -> Future a +replicate n a + | n <= 0 = error "replicate: non-positive argument" + | otherwise = go 1 n a (Tip a) (\ _ r -> r) + where + -- invariants: + -- tb is a complete tree of i nodes all equal to b + -- 1 <= i = 2^m-1 <= j + -- k accepts r such that 0 <= r < i + go :: Int -> Int -> b -> Complete b -> (Int -> Future b -> r) -> r + go !i !j b tb k + | j >= i2p1 = go i2p1 j b (Bin i2p1 b tb tb) k' + | j >= i2 = k (j - i2) (tb :< Last tb) + | otherwise = k (j - i) (Last tb) + where + i2 = i * 2 + i2p1 = i2 + 1 + k' r xs + | r >= i2 = k (r - i2) (tb :< tb :< xs) + | r >= i = k (r - i) (tb :< xs) + | otherwise = k r xs +{-# INLINE replicate #-} + +mapWithIndex :: (Int -> a -> b) -> Future a -> Future b +mapWithIndex f0 as0 = spine f0 0 as0 + where + spine f m (Last as) = Last (tree f m as) + spine f m (a :< as) = tree f m a :< spine f (m + weight a) as + tree f m (Tip a) = Tip (f m a) + tree f m (Bin n a l r) = Bin n (f m a) (tree f (m + 1) l) (tree f (m + 1 + weight l) r) + +indexed :: Future a -> Future (Int, a) +indexed = mapWithIndex (,) +{-# INLINE indexed #-} + +from :: Num a => a -> Future a +from a = mapWithIndex ((+) . fromIntegral) (pure a) +{-# INLINE from #-} + +-- | /O(1)/ +singleton :: a -> Future a +singleton a = Last (Tip a) +{-# INLINE singleton #-} + +#if !(MIN_VERSION_base(4,8,0)) +-- | /O(log n)/. +length :: Future a -> Int +length (Last t) = weight t +length (t :< ts) = weight t + length ts +#endif + +-- | /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 (<|) #-} + +-- | /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 #-} + +-- | /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 (extract 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) + +#if MIN_VERSION_base(4,7,0) +instance Exts.IsList (Future a) where + type Item (Future a) = a + toList = Data.Foldable.toList + fromList [] = error "fromList: empty list" + fromList (x:xs) = go x xs + where go a [] = singleton a + go a (b:bs) = a <| go b bs +#else +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 +#endif + +toFuture :: [a] -> Maybe (Future a) +toFuture [] = Nothing +#if MIN_VERSION_base(4,7,0) +toFuture xs = Just (Exts.fromList xs) +#else +toFuture xs = Just (fromList xs) +#endif + +-- /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 diff --git a/src/Data/Stream/Infinite.hs b/src/Data/Stream/Infinite.hs --- a/src/Data/Stream/Infinite.hs +++ b/src/Data/Stream/Infinite.hs @@ -1,449 +1,463 @@ -{-# LANGUAGE PatternGuards #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE CPP #-} -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Trustworthy #-} -#endif ------------------------------------------------------------------------------ --- | --- 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 --- Stability : provisional --- Portability : portable (Haskell 2010) --- ----------------------------------------------------------------------------- -module Data.Stream.Infinite ( - -- * The type of streams - Stream(..) - -- * Basic functions - , tail -- :: Stream a -> Stream a - , inits -- :: Stream a -> Stream [a] - , prepend -- :: [a] -> Stream a -> Stream a - , concat -- :: Stream [a] -> Stream a - -- * Stream transformations - , 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 - , cycle -- :: NonEmpty a -> Stream a - , unfold -- :: (a -> (b, a)) -> a -> Stream b - -- * Extracting sublists - , take -- :: Int -> Stream a -> [a] - , drop -- :: Int -> Stream a -> Stream a - , splitAt -- :: Int -> Stream a -> ([a],Stream a) - , takeWhile -- :: (a -> Bool) -> Stream a -> [a] - , dropWhile -- :: (a -> Bool) -> Stream a -> Stream a - , span -- :: (a -> Bool) -> Stream a -> ([a], Stream a) - , break -- :: (a -> Bool) -> Stream a -> ([a], Stream a) - , filter -- :: (a -> Bool) -> Stream a -> Stream a - , partition -- :: (a -> Bool) -> Stream a -> (Stream a, Stream a) - , group -- :: (a -> Bool) -> Stream a -> Stream (NonEmpty a) - , groupBy -- :: (a -> a -> Bool) -> Stream a -> Stream (NonEmpty a) - -- * Sublist predicates - , isPrefixOf -- :: [a] -> Stream a -> Bool - -- * Indexing streams - , (!!) -- :: Int -> Stream a -> a - , elemIndex -- :: Eq a => a -> Stream a -> Int - , elemIndices -- :: Eq a => a -> Stream a -> Stream Int - , findIndex -- :: (a -> Bool) -> Stream a -> Int - , findIndices -- :: (a -> Bool) -> Stream a -> Stream Int - -- * Zipping and unzipping streams - , zip -- :: Stream a -> Stream b -> Stream (a, b) - , zipWith -- :: (a -> b -> c) -> Stream a -> Stream b -> Stream c - , unzip -- :: Functor f => f (a, b) -> (f a, f b) - -- * Functions on streams of characters - , words -- :: Stream Char -> Stream String - , unwords -- :: Stream String -> Stream Char - , lines -- :: Stream Char -> Stream String - , unlines -- :: Stream String -> Stream Char - ) where - -import Prelude hiding - ( 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, concat - ) - -#if !(MIN_VERSION_base(4,8,0)) -import Control.Applicative -#endif -import Control.Comonad -import Data.Char (isSpace) -import Data.Data -import Data.Functor.Apply -import Data.Functor.Extend -import Data.Functor.Rep -#if !(MIN_VERSION_base(4,8,0)) -import Data.Semigroup -import Data.Traversable -#endif -import Data.Foldable hiding (concat) -import Data.Distributive -import Data.Semigroup.Traversable -import Data.Semigroup.Foldable -import Data.List.NonEmpty (NonEmpty(..)) - -data Stream a = a :> Stream a deriving - ( Show -#ifdef LANGUAGE_DeriveDataTypeable - , Data, Typeable -#endif - ) - -infixr 5 :> - -instance Functor Stream where - fmap f (a :> as) = f a :> fmap f as - b <$ _ = pure b - -instance Distributive Stream where - distribute w = fmap extract 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 sequence following the head of the stream. -tail :: Stream a -> Stream a -tail (_ :> as) = as -{-# INLINE tail #-} - -instance Extend Stream where - duplicated = duplicate - extended = extend - -instance Comonad Stream where - duplicate w = w :> duplicate (tail w) - extend f w = f w :> extend f (tail w) - extract (a :> _) = a - -instance Apply Stream where - (f :> fs) <.> (a :> as) = f a :> (fs <.> as) - as <. _ = as - _ .> bs = bs - -instance ComonadApply Stream where - (f :> fs) <@> (a :> as) = f a :> (fs <@> as) - as <@ _ = as - _ @> bs = bs - -instance Applicative Stream where - pure a = as where as = a :> as - (<*>) = (<.>) - (<* ) = (<. ) - ( *>) = ( .>) - -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) -#if __GLASGOW_HASKELL__ > 710 - length _ = error "infinite length" - null _ = False -#endif - -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 = pure - m >>= f = unfold (\(bs :> bss) -> (extract 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 - --- | 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 = [] :> ((extract xs :) <$> inits (tail xs)) - --- | Prepend a list to a stream. -prepend :: Foldable f => f a -> Stream a -> Stream a -prepend xs ys = foldr (:>) ys xs - --- | Flatten a stream of lists into a stream. -concat :: Foldable f => Stream (f a) -> Stream a -concat = foldr prepend undefined - --- | @'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 :> (extract <$> 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) = (extract 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 -(!!) = index - --- | 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 +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE CPP #-} +#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Trustworthy #-} +#endif +----------------------------------------------------------------------------- +-- | +-- 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 +-- Stability : provisional +-- Portability : portable (Haskell 2010) +-- +---------------------------------------------------------------------------- +module Data.Stream.Infinite ( + -- * The type of streams + Stream(..) + -- * Basic functions + , tail -- :: Stream a -> Stream a + , inits -- :: Stream a -> Stream [a] + , prepend -- :: [a] -> Stream a -> Stream a + , concat -- :: Stream [a] -> Stream a + -- * Stream transformations + , 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 + , cycle -- :: NonEmpty a -> Stream a + , unfold -- :: (a -> (b, a)) -> a -> Stream b + -- * Extracting sublists + , take -- :: Int -> Stream a -> [a] + , drop -- :: Int -> Stream a -> Stream a + , splitAt -- :: Int -> Stream a -> ([a],Stream a) + , takeWhile -- :: (a -> Bool) -> Stream a -> [a] + , dropWhile -- :: (a -> Bool) -> Stream a -> Stream a + , span -- :: (a -> Bool) -> Stream a -> ([a], Stream a) + , break -- :: (a -> Bool) -> Stream a -> ([a], Stream a) + , filter -- :: (a -> Bool) -> Stream a -> Stream a + , partition -- :: (a -> Bool) -> Stream a -> (Stream a, Stream a) + , group -- :: (a -> Bool) -> Stream a -> Stream (NonEmpty a) + , groupBy -- :: (a -> a -> Bool) -> Stream a -> Stream (NonEmpty a) + -- * Sublist predicates + , isPrefixOf -- :: [a] -> Stream a -> Bool + -- * Indexing streams + , (!!) -- :: Int -> Stream a -> a + , elemIndex -- :: Eq a => a -> Stream a -> Int + , elemIndices -- :: Eq a => a -> Stream a -> Stream Int + , findIndex -- :: (a -> Bool) -> Stream a -> Int + , findIndices -- :: (a -> Bool) -> Stream a -> Stream Int + -- * Zipping and unzipping streams + , zip -- :: Stream a -> Stream b -> Stream (a, b) + , zipWith -- :: (a -> b -> c) -> Stream a -> Stream b -> Stream c + , unzip -- :: Functor f => f (a, b) -> (f a, f b) + -- * Functions on streams of characters + , words -- :: Stream Char -> Stream String + , unwords -- :: Stream String -> Stream Char + , lines -- :: Stream Char -> Stream String + , unlines -- :: Stream String -> Stream Char + ) where + +import Prelude hiding + ( 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, concat + ) + +#if !(MIN_VERSION_base(4,8,0)) +import Control.Applicative +#endif +import Control.Comonad +import Data.Char (isSpace) +import Data.Data +import Data.Functor.Apply +import Data.Functor.Extend +import Data.Functor.Rep +#if !(MIN_VERSION_base(4,8,0)) +import Data.Semigroup +import Data.Traversable +#endif +import Data.Foldable hiding (concat) +import Data.Distributive +import Data.Semigroup.Traversable +import Data.Semigroup.Foldable +import Data.List.NonEmpty (NonEmpty(..)) +import Data.Boring (Boring (..), Absurd (..)) + +data Stream a = a :> Stream a deriving + ( Show +#ifdef LANGUAGE_DeriveDataTypeable + , Data, Typeable +#endif + ) + +infixr 5 :> + +instance Functor Stream where + fmap f (a :> as) = f a :> fmap f as + b <$ _ = pure b + +instance Distributive Stream where + distribute w = fmap extract 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 stream. +head :: Stream a -> a +head (x :> _) = x + +-- | @since 3.3.1 +instance Boring a => Boring (Stream a) where + boring = pure boring + +-- | @since 3.3.1 +instance Absurd a => Absurd (Stream a) where + absurd = absurd . extract + +-- | Extract the sequence following the head of the stream. +tail :: Stream a -> Stream a +tail (_ :> as) = as +{-# INLINE tail #-} + +instance Extend Stream where + duplicated = duplicate + extended = extend + +instance Comonad Stream where + duplicate w = w :> duplicate (tail w) + extend f w = f w :> extend f (tail w) + extract (a :> _) = a + +instance Apply Stream where + (f :> fs) <.> (a :> as) = f a :> (fs <.> as) + as <. _ = as + _ .> bs = bs + +instance ComonadApply Stream where + (f :> fs) <@> (a :> as) = f a :> (fs <@> as) + as <@ _ = as + _ @> bs = bs + +instance Applicative Stream where + pure a = as where as = a :> as + (<*>) = (<.>) + (<* ) = (<. ) + ( *>) = ( .>) + +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) +#if __GLASGOW_HASKELL__ > 710 + length _ = error "infinite length" + null _ = False +#endif + +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 + m >>= f = unfold (\(bs :> bss) -> (extract bs, tail <$> bss)) (fmap f m) +#if !(MIN_VERSION_base(4,11,0)) + return = pure + _ >> bs = bs +#endif + +-- | 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 + +-- | 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 = [] :> ((extract xs :) <$> inits (tail xs)) + +-- | Prepend a list to a stream. +prepend :: Foldable f => f a -> Stream a -> Stream a +prepend xs ys = foldr (:>) ys xs + +-- | Flatten a stream of lists into a stream. +concat :: Foldable f => Stream (f a) -> Stream a +concat = foldr prepend undefined + +-- | @'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 :> (extract <$> 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) = (extract 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 +(!!) = index + +-- | 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 diff --git a/src/Data/Stream/Infinite/Functional/Zipper.hs b/src/Data/Stream/Infinite/Functional/Zipper.hs --- a/src/Data/Stream/Infinite/Functional/Zipper.hs +++ b/src/Data/Stream/Infinite/Functional/Zipper.hs @@ -1,330 +1,334 @@ -{-# LANGUAGE CPP, PatternGuards, BangPatterns #-} -#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 710 -{-# LANGUAGE Trustworthy #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Data.Stream.Infinite.Functional.Zipper --- Copyright : (C) 2011-2015 Edward Kmett --- License : BSD-style (see the file LICENSE) --- --- Maintainer : Edward Kmett --- 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, reverse - ) - -import Control.Applicative -import Control.Comonad -#ifdef LANGUAGE_DeriveDataTypeable -import Data.Data -#endif -import Data.Functor.Extend -import Data.Functor.Apply -import Data.Semigroup - -data Zipper a = !Integer :~ !(Integer -> a) -#ifdef LANGUAGE_DeriveDataTypeable - deriving Typeable -#endif - -toSequence :: (Integer -> a) -> Zipper a -toSequence = (0 :~) - -reverse :: Zipper a -> Zipper a -reverse (n :~ f) = negate n :~ f . negate - -infixr 0 :~ - -instance Functor Zipper where - fmap g (n :~ f) = n :~ g . f - b <$ _ = 0 :~ const b - --- | Extract the focused element -head :: Zipper a -> a -head (n :~ f) = f n - --- | Move the head of the zipper to the right -tail :: Zipper a -> Zipper a -tail (n :~ f) = n + 1 :~ f - --- | Move the head of the zipper to the left -untail :: Zipper a -> Zipper a -untail (n :~ f) = n - 1 :~ f - --- | Cons before the head of the zipper. The head now points to the new element -(<|) :: a -> Zipper a -> Zipper a -a <| (n :~ f) = n :~ \z -> case compare z n of - LT -> f n - EQ -> a - GT -> f (n - 1) - --- | Move the head of the zipper one step to the right, returning the value we move over. -uncons :: Zipper a -> (a, Zipper a) -uncons (n :~ f) = (f n, n + 1 :~ f) - -instance Extend Zipper where - duplicated (n :~ f) = n :~ (:~ f) - -instance Comonad Zipper where - duplicate (n :~ f) = n :~ (:~ f) - extract (n :~ f) = f n - -instance Apply Zipper where - (nf :~ f) <.> (na :~ a) - | dn <- na - nf - = nf :~ \n -> f n (a (n + dn)) - as <. _ = as - _ .> bs = bs - -instance ComonadApply Zipper where - (<@>) = (<.>) - (<@) = (<.) - (@>) = (.>) - - -instance Applicative Zipper where - pure = repeat - (<*>) = (<.>) - as <* _ = as - _ *> bs = bs - -instance Monad Zipper where - return = repeat - (z :~ ma) >>= f = z :~ \ na -> case f (ma na) of - nb :~ mb -> mb (nb + na - z) - -repeat :: a -> Zipper a -repeat a = 0 :~ const a - --- | Interleave two Zippers @xs@ and @ys@, alternating elements --- from each list. --- --- > [x1,x2,...] `interleave` [y1,y2,...] == [x1,y1,x2,y2,...] --- > interleave = (<>) -interleave :: Zipper a -> Zipper a -> Zipper a -interleave = (<>) -instance Semigroup (Zipper a) where - (n :~ a) <> (m :~ b) = 0 :~ \p -> case quotRem p 2 of - (q, 0) -> a (n + q) - (q, _) -> b (m + q) - --- | @'intersperse' y xs@ creates an alternating stream of --- elements from @xs@ and @y@. -intersperse :: a -> Zipper a -> Zipper a -intersperse y z = z <> repeat y - --- | 'transpose' computes the transposition of a stream of streams. -transpose :: Zipper (Zipper a) -> Zipper (Zipper a) -transpose (n :~ f) = 0 :~ \z -> n :~ \n' -> let m :~ g = f n' in g (m + z) - -take :: Integer -> Zipper a -> [a] -take n0 (m0 :~ f0) - | n0 < 0 = error "Zipper.take: negative argument" - | otherwise = go n0 m0 f0 - where - go 0 !_ !_ = [] - go n m f = f m : go (n - 1) (m + 1) f - --- | @'drop' n xs@ drops the first @n@ elements off the front of --- the sequence @xs@. -drop :: Integer -> Zipper a -> Zipper a -drop m (n :~ f) = m + n :~ f - --- | @'splitAt' n xs@ returns a pair consisting of the prefix of --- @xs@ of length @n@ and the remaining stream immediately following --- this prefix. --- --- /Beware/: passing a negative integer as the first argument will --- cause an error if you access the taken portion -splitAt :: Integer -> Zipper a -> ([a],Zipper a) -splitAt n xs = (take n xs, drop n xs) - --- | @'takeWhile' p xs@ returns the longest prefix of the stream --- @xs@ for which the predicate @p@ holds. -takeWhile :: (a -> Bool) -> Zipper a -> [a] -takeWhile p0 (n0 :~ f0) = go p0 n0 f0 where - go !p !n !f - | x <- f n, p x = x : go p (n + 1) f - | otherwise = [] - --- | @'dropWhile' p xs@ returns the suffix remaining after --- @'takeWhile' p xs@. --- --- /Beware/: this function may diverge if every element of @xs@ --- satisfies @p@, e.g. @dropWhile even (repeat 0)@ will loop. -dropWhile :: (a -> Bool) -> Zipper a -> Zipper a -dropWhile p xs@(_ :~ f) = findIndex' p xs :~ f - --- | @'span' p xs@ returns the longest prefix of @xs@ that satisfies --- @p@, together with the remainder of the stream. -span :: (a -> Bool) -> Zipper a -> ([a], Zipper a) -span p0 (n0 :~ f0) - | (ts, n') <- go p0 n0 f0 = (ts, n' :~ f0) where - go !p !n !f - | x <- f n, p x, (ts, fs) <- go p (n + 1) f = (x:ts, fs) - | otherwise = ([], n) - --- | The 'break' @p@ function is equivalent to 'span' @not . p@. -break :: (a -> Bool) -> Zipper a -> ([a], Zipper a) -break p = span (not . p) - --- | The 'isPrefix' function returns @True@ if the first argument is --- a prefix of the second. -isPrefixOf :: Eq a => [a] -> Zipper a -> Bool -isPrefixOf xs0 (n0 :~ f0) = go xs0 n0 f0 where - go [] !_ !_ = True - go (y:ys) n f = y == f n && go ys (n + 1) f - --- | @xs !! n@ returns the element of the stream @xs@ at index --- @n@. Note that the head of the stream has index 0. -(!!) :: 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" - --} +{-# LANGUAGE CPP, PatternGuards, BangPatterns #-} +#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 710 +{-# LANGUAGE Trustworthy #-} +#endif +----------------------------------------------------------------------------- +-- | +-- Module : Data.Stream.Infinite.Functional.Zipper +-- Copyright : (C) 2011-2015 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- 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, reverse + ) + +import Control.Applicative +import Control.Comonad +#ifdef LANGUAGE_DeriveDataTypeable +import Data.Data +#endif +import Data.Functor.Extend +import Data.Functor.Apply +#if !(MIN_VERSION_base(4,11,0)) +import Data.Semigroup +#endif + +data Zipper a = !Integer :~ !(Integer -> a) +#ifdef LANGUAGE_DeriveDataTypeable + deriving Typeable +#endif + +toSequence :: (Integer -> a) -> Zipper a +toSequence = (0 :~) + +reverse :: Zipper a -> Zipper a +reverse (n :~ f) = negate n :~ f . negate + +infixr 0 :~ + +instance Functor Zipper where + fmap g (n :~ f) = n :~ g . f + b <$ _ = 0 :~ const b + +-- | Extract the focused element +head :: Zipper a -> a +head (n :~ f) = f n + +-- | Move the head of the zipper to the right +tail :: Zipper a -> Zipper a +tail (n :~ f) = n + 1 :~ f + +-- | Move the head of the zipper to the left +untail :: Zipper a -> Zipper a +untail (n :~ f) = n - 1 :~ f + +-- | Cons before the head of the zipper. The head now points to the new element +(<|) :: a -> Zipper a -> Zipper a +a <| (n :~ f) = n :~ \z -> case compare z n of + LT -> f n + EQ -> a + GT -> f (n - 1) + +-- | Move the head of the zipper one step to the right, returning the value we move over. +uncons :: Zipper a -> (a, Zipper a) +uncons (n :~ f) = (f n, n + 1 :~ f) + +instance Extend Zipper where + duplicated (n :~ f) = n :~ (:~ f) + +instance Comonad Zipper where + duplicate (n :~ f) = n :~ (:~ f) + extract (n :~ f) = f n + +instance Apply Zipper where + (nf :~ f) <.> (na :~ a) + | dn <- na - nf + = nf :~ \n -> f n (a (n + dn)) + as <. _ = as + _ .> bs = bs + +instance ComonadApply Zipper where + (<@>) = (<.>) + (<@) = (<.) + (@>) = (.>) + + +instance Applicative Zipper where + pure = repeat + (<*>) = (<.>) + as <* _ = as + _ *> bs = bs + +instance Monad Zipper where +#if !(MIN_VERSION_base(4,11,0)) + return = repeat +#endif + (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. +(!!) :: 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" + +-} diff --git a/src/Data/Stream/Infinite/Skew.hs b/src/Data/Stream/Infinite/Skew.hs --- a/src/Data/Stream/Infinite/Skew.hs +++ b/src/Data/Stream/Infinite/Skew.hs @@ -1,339 +1,348 @@ -{-# LANGUAGE PatternGuards, BangPatterns #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE CPP #-} -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Trustworthy #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Data.Stream.Infinite.Skew --- Copyright : (C) 2011 Edward Kmett, --- License : BSD-style (see the file LICENSE) --- --- Maintainer : Edward Kmett --- 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) - , (!!) - , tail -- O(1) - , uncons -- O(1) - , drop -- O(log n) - , dropWhile -- O(n) - , span - , break - , split - , splitW - , repeat - , insert -- O(n) - , insertBy - , adjust -- O(log n) - , update -- O(log n) - , from - , indexed - , interleave - ) where - -import Control.Arrow (first) -import Control.Applicative hiding (empty) -import Control.Comonad -import Data.Distributive -import Data.Functor.Alt -import Data.Functor.Extend -import Data.Functor.Rep -import Data.Foldable -import Data.Traversable -import Data.Semigroup hiding (Last) -import Data.Semigroup.Foldable -import Data.Semigroup.Traversable -import Prelude hiding (null, head, tail, drop, dropWhile, length, foldr, last, span, repeat, replicate, (!!), break) - -infixr 5 :<, <| - -data Complete a - = Tip a - | Bin !Integer a !(Complete a) !(Complete a) - deriving Show - -instance Functor Complete where - fmap f (Tip a) = Tip (f a) - fmap f (Bin w a l r) = Bin w (f a) (fmap f l) (fmap f r) - -instance Extend Complete where - extended f w@Tip {} = Tip (f w) - extended f w@(Bin n _ l r) = Bin n (f w) (extended f l) (extended f r) - -instance Comonad Complete where - extend f w@Tip {} = Tip (f w) - extend f w@(Bin n _ l r) = Bin n (f w) (extend f l) (extend f r) - extract (Tip a) = a - extract (Bin _ a _ _) = a - -instance Foldable Complete where - foldMap f (Tip a) = f a - foldMap f (Bin _ a l r) = f a `mappend` foldMap f l `mappend` foldMap f r - foldr f z (Tip a) = f a z - foldr f z (Bin _ a l r) = f a (foldr f (foldr f z r) l) -#if __GLASGOW_HASKELL__ >= 710 - length Tip{} = 1 - length (Bin n _ _ _) = fromIntegral n - null _ = False -#endif - -instance Foldable1 Complete where - foldMap1 f (Tip a) = f a - foldMap1 f (Bin _ a l r) = f a <> foldMap1 f l <> foldMap1 f r - -instance Traversable Complete where - traverse f (Tip a) = Tip <$> f a - traverse f (Bin n a l r) = Bin n <$> f a <*> traverse f l <*> traverse f r - -instance Traversable1 Complete where - traverse1 f (Tip a) = Tip <$> f a - traverse1 f (Bin n a l r) = Bin n <$> f a <.> traverse1 f l <.> traverse1 f r - -bin :: a -> Complete a -> Complete a -> Complete a -bin a l r = Bin (1 + weight l + weight r) a l r -{-# INLINE bin #-} - -weight :: Complete a -> Integer -weight Tip{} = 1 -weight (Bin w _ _ _) = w -{-# INLINE weight #-} - --- A future is a non-empty skew binary random access list of nodes. --- The last node, however, is allowed to contain fewer values. -data Stream a = !(Complete a) :< Stream a --- deriving Show - -instance Show a => Show (Stream a) where - showsPrec d as = showParen (d >= 10) $ - showString "fromList " . showsPrec 11 (toList as) - -instance Functor Stream where - fmap f (t :< ts) = fmap f t :< fmap f ts - -instance Extend Stream where - extended = extend - -instance Comonad Stream where - extend g0 (t :< ts) = go g0 t (:< ts) :< extend g0 ts - where - go :: (Stream a -> b) -> Complete a -> (Complete a -> Stream a) -> Complete b - go g w@Tip{} f = Tip (g (f w)) - go g w@(Bin n _ l r) f = Bin n (g (f w)) (go g l (:< f r)) (go g r f) - extract (a :< _) = extract a - -instance Apply Stream where - fs <.> as = mapWithIndex (\n f -> f (as !! n)) fs - as <. _ = as - _ .> bs = bs - -instance ComonadApply Stream where - (<@>) = (<.>) - (<@) = (<.) - (@>) = (.>) - -instance Applicative Stream where - pure = repeat - (<*>) = (<.>) - (<* ) = (<. ) - ( *>) = ( .>) - -instance Alt Stream where - as bs = tabulate $ \i -> case quotRem i 2 of - (q,0) -> as !! q - (q,_) -> bs !! q - -instance Foldable Stream where - foldMap f (t :< ts) = foldMap f t `mappend` foldMap f ts - foldr f z (t :< ts) = foldr f (foldr f z ts) t -#if __GLASGOW_HASKELL__ >= 710 - length _ = error "infinite length" - null _ = False -#endif - -instance Foldable1 Stream where - foldMap1 f (t :< ts) = foldMap1 f t <> foldMap1 f ts - -instance Traversable Stream where - traverse f (t :< ts) = (:<) <$> traverse f t <*> traverse f ts - -instance Traversable1 Stream where - traverse1 f (t :< ts) = (:<) <$> traverse1 f t <.> traverse1 f ts - -instance Distributive Stream where - distribute w = tabulate (\i -> fmap (!! i) w) - -instance 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 - (<>) = () - -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) - -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)/. -tail :: Stream a -> Stream a -tail (Tip{} :< ts) = ts -tail (Bin _ _ l r :< ts) = l :< r :< ts -{-# INLINE tail #-} - --- | /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 #-} - -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 -(!!) = 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 (extract as) = dropWhile p (tail as) - | otherwise = as - --- | /O(n)/ -span :: (a -> Bool) -> Stream a -> ([a], Stream a) -span p as - | a <- extract 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) - --- | /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 - +{-# LANGUAGE PatternGuards, BangPatterns #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE CPP #-} +#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Trustworthy #-} +#endif +----------------------------------------------------------------------------- +-- | +-- Module : Data.Stream.Infinite.Skew +-- Copyright : (C) 2011 Edward Kmett, +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- 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) + , (!!) + , tail -- O(1) + , uncons -- O(1) + , drop -- O(log n) + , dropWhile -- O(n) + , span + , break + , split + , splitW + , repeat + , insert -- O(n) + , insertBy + , adjust -- O(log n) + , update -- O(log n) + , from + , indexed + , interleave + ) where + +import Control.Arrow (first) +import Control.Applicative hiding (empty) +import Control.Comonad +import Data.Distributive +import Data.Functor.Alt +import Data.Functor.Extend +import Data.Functor.Rep +import Data.Foldable +import Data.Traversable +import Data.Semigroup hiding (Last) +import Data.Semigroup.Foldable +import Data.Semigroup.Traversable +import Prelude hiding (null, head, tail, drop, dropWhile, length, foldr, last, span, repeat, replicate, (!!), break) +import Data.Boring (Boring (..), Absurd (..)) + +infixr 5 :<, <| + +data Complete a + = Tip a + | Bin !Integer a !(Complete a) !(Complete a) + deriving Show + +instance Functor Complete where + fmap f (Tip a) = Tip (f a) + fmap f (Bin w a l r) = Bin w (f a) (fmap f l) (fmap f r) + +instance Extend Complete where + extended f w@Tip {} = Tip (f w) + extended f w@(Bin n _ l r) = Bin n (f w) (extended f l) (extended f r) + +instance Comonad Complete where + extend f w@Tip {} = Tip (f w) + extend f w@(Bin n _ l r) = Bin n (f w) (extend f l) (extend f r) + extract (Tip a) = a + extract (Bin _ a _ _) = a + +instance Foldable Complete where + foldMap f (Tip a) = f a + foldMap f (Bin _ a l r) = f a `mappend` foldMap f l `mappend` foldMap f r + foldr f z (Tip a) = f a z + foldr f z (Bin _ a l r) = f a (foldr f (foldr f z r) l) +#if __GLASGOW_HASKELL__ >= 710 + length Tip{} = 1 + length (Bin n _ _ _) = fromIntegral n + null _ = False +#endif + +instance Foldable1 Complete where + foldMap1 f (Tip a) = f a + foldMap1 f (Bin _ a l r) = f a <> foldMap1 f l <> foldMap1 f r + +instance Traversable Complete where + traverse f (Tip a) = Tip <$> f a + traverse f (Bin n a l r) = Bin n <$> f a <*> traverse f l <*> traverse f r + +instance Traversable1 Complete where + traverse1 f (Tip a) = Tip <$> f a + traverse1 f (Bin n a l r) = Bin n <$> f a <.> traverse1 f l <.> traverse1 f r + +bin :: a -> Complete a -> Complete a -> Complete a +bin a l r = Bin (1 + weight l + weight r) a l r +{-# INLINE bin #-} + +weight :: Complete a -> Integer +weight Tip{} = 1 +weight (Bin w _ _ _) = w +{-# INLINE weight #-} + +-- A future is a non-empty skew binary random access list of nodes. +-- The last node, however, is allowed to contain fewer values. +data Stream a = !(Complete a) :< Stream a +-- deriving Show + +instance Show a => Show (Stream a) where + showsPrec d as = showParen (d >= 10) $ + showString "fromList " . showsPrec 11 (toList as) + +instance Functor Stream where + fmap f (t :< ts) = fmap f t :< fmap f ts + +instance Extend Stream where + extended = extend + +instance Comonad Stream where + extend g0 (t :< ts) = go g0 t (:< ts) :< extend g0 ts + where + go :: (Stream a -> b) -> Complete a -> (Complete a -> Stream a) -> Complete b + go g w@Tip{} f = Tip (g (f w)) + go g w@(Bin n _ l r) f = Bin n (g (f w)) (go g l (:< f r)) (go g r f) + extract (a :< _) = extract a + +instance Apply Stream where + fs <.> as = mapWithIndex (\n f -> f (as !! n)) fs + as <. _ = as + _ .> bs = bs + +instance ComonadApply Stream where + (<@>) = (<.>) + (<@) = (<.) + (@>) = (.>) + +instance Applicative Stream where + pure = repeat + (<*>) = (<.>) + (<* ) = (<. ) + ( *>) = ( .>) + +instance Alt Stream where + as bs = tabulate $ \i -> case quotRem i 2 of + (q,0) -> as !! q + (q,_) -> bs !! q + +instance Foldable Stream where + foldMap f (t :< ts) = foldMap f t `mappend` foldMap f ts + foldr f z (t :< ts) = foldr f (foldr f z ts) t +#if __GLASGOW_HASKELL__ >= 710 + length _ = error "infinite length" + null _ = False +#endif + +instance Foldable1 Stream where + foldMap1 f (t :< ts) = foldMap1 f t <> foldMap1 f ts + +instance Traversable Stream where + traverse f (t :< ts) = (:<) <$> traverse f t <*> traverse f ts + +instance Traversable1 Stream where + traverse1 f (t :< ts) = (:<) <$> traverse1 f t <.> traverse1 f ts + +instance Distributive Stream where + distribute w = tabulate (\i -> fmap (!! i) w) + +instance 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 + +-- | @since 3.3.1 +instance Boring a => Boring (Stream a) where + boring = pure boring + +-- | @since 3.3.1 +instance Absurd a => Absurd (Stream a) where + absurd = absurd . extract + +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) + +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)/. +tail :: Stream a -> Stream a +tail (Tip{} :< ts) = ts +tail (Bin _ _ l r :< ts) = l :< r :< ts +{-# INLINE tail #-} + +-- | /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 #-} + +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 +(!!) = 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 (extract as) = dropWhile p (tail as) + | otherwise = as + +-- | /O(n)/ +span :: (a -> Bool) -> Stream a -> ([a], Stream a) +span p as + | a <- extract 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) + +-- | /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 + diff --git a/src/Data/Stream/Supply.hs b/src/Data/Stream/Supply.hs --- a/src/Data/Stream/Supply.hs +++ b/src/Data/Stream/Supply.hs @@ -1,182 +1,184 @@ -{-# LANGUAGE CPP, FlexibleContexts #-} -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE Trustworthy #-} -#endif ------------------------------------------------------------------------------ --- | --- Module : Data.Stream.Supply --- Copyright : (C) 2008-2011 Edward Kmett, --- (C) 2008 Iavor S. Diatchki --- License : BSD-style (see the file LICENSE) --- --- Maintainer : Edward Kmett --- Stability : provisional --- Portability : portable --- --- This library can be used to generate values (for example, new names) --- without the need to thread state. This means that functions that --- need to generate new values only need a supply object as an argument, --- and they do not need to return a new supply object as a result. --- This decreases the number of data-dependencies in a program, which --- makes it easier to exploit parallelism. --- --- The technique for generating new values is based on the paper --- ''On Generating Unique Names'' by Lennart Augustsson, Mikael Rittri, --- and Dan Synek. ----------------------------------------------------------------------------- -module Data.Stream.Supply - ( Supply - , newSupply - , newEnumSupply - , newNumSupply - , newDupableSupply - , newDupableEnumSupply - , newDupableNumSupply - , leftSupply - , rightSupply - , split - , splits - , splitSkew - , split2 - , split3 - , split4 - ) where - -#if !(MIN_VERSION_base(4,8,0)) -import Control.Applicative -#endif -import Control.Comonad -import Data.Functor.Apply -import Data.Functor.Extend -import Data.Functor.Rep -import Data.IORef(newIORef, atomicModifyIORef) -#if !(MIN_VERSION_base(4,8,0)) -import Data.Foldable -import Data.Traversable -#endif -import Data.Semigroup -import Data.Semigroup.Foldable -import Data.Semigroup.Traversable -import System.IO.Unsafe (unsafeInterleaveIO) -import Data.Stream.Infinite -import qualified Data.Stream.Infinite.Skew as Skew - -#ifdef LANGUAGE_DeriveDataTypeable -import Data.Data -#endif - -#if __GLASGOW_HASKELL__ >= 608 -import GHC.IO(unsafeDupableInterleaveIO) -#else -unsafeDupableInterleaveIO :: IO a -> IO a -unsafeDupableInterleaveIO = unsafeInterleaveIO -#endif - -data Supply a = Supply a (Supply a) (Supply a) deriving - ( Show, Read, Eq, Ord -#ifdef LANGUAGE_DeriveDataTypeable - , Data, Typeable -#endif - ) - -instance Functor Supply where - fmap f (Supply a l r) = Supply (f a) (fmap f l) (fmap f r) - a <$ _ = pure a - -instance Extend Supply where - extended f s@(Supply _ l r) = Supply (f s) (extended f l) (extended f r) - duplicated s@(Supply _ l r) = Supply s (duplicated l) (duplicated r) - -instance Comonad Supply where - extend f s@(Supply _ l r) = Supply (f s) (extend f l) (extend f r) - duplicate s@(Supply _ l r) = Supply s (duplicate l) (duplicate r) - extract (Supply a _ _) = a - -instance Apply Supply where - Supply f fl fr <.> Supply a al ar = Supply (f a) (fl <.> al) (fr <.> ar) - a <. _ = a - _ .> a = a - -instance Applicative Supply where - pure a = as where as = Supply a as as - Supply f fl fr <*> Supply a al ar = Supply (f a) (fl <*> al) (fr <*> ar) - a <* _ = a - _ *> a = a - -instance Foldable Supply where - foldMap f (Supply a l r) = f a `mappend` foldMap f l `mappend` foldMap f r - -instance Foldable1 Supply where - foldMap1 f (Supply a l r) = f a <> foldMap1 f l <> foldMap1 f r - -instance Traversable Supply where - traverse f (Supply a l r) = Supply <$> f a <*> traverse f l <*> traverse f r - -instance Traversable1 Supply where - traverse1 f (Supply a l r) = Supply <$> f a <.> traverse1 f l <.> traverse1 f r - -leftSupply :: Supply a -> Supply a -leftSupply (Supply _ l _) = l - -rightSupply :: Supply a -> Supply a -rightSupply (Supply _ _ r) = r - --- unfoldsW :: (Comonad w, Functor f) => (w a -> (b, f a)) -> w a -> StreamT f w b -newSupply :: (a -> a) -> a -> IO (Supply a) -newSupply f x = gen =<< newIORef x - where gen r = unsafeInterleaveIO $ - Supply <$> unsafeInterleaveIO (atomicModifyIORef r update) - <*> gen r - <*> gen r - update a = b `seq` (b, a) where b = f a -{-# INLINE newSupply #-} - -newDupableSupply :: (a -> a) -> a -> IO (Supply a) -newDupableSupply f x = gen =<< newIORef x - where gen r = unsafeDupableInterleaveIO $ - Supply <$> unsafeDupableInterleaveIO (atomicModifyIORef r update) - <*> gen r - <*> gen r - update a = b `seq` (b, a) where b = f a -{-# INLINE newDupableSupply #-} - -newEnumSupply :: Enum a => IO (Supply a) -newEnumSupply = newSupply succ (toEnum 0) -{-# SPECIALIZE newEnumSupply :: IO (Supply Int) #-} - -newNumSupply :: Num a => IO (Supply a) -newNumSupply = newSupply (1+) 0 -{-# SPECIALIZE newNumSupply :: IO (Supply Int) #-} - -newDupableEnumSupply :: Enum a => IO (Supply a) -newDupableEnumSupply = newSupply succ (toEnum 0) -{-# SPECIALIZE newEnumSupply :: IO (Supply Int) #-} - -newDupableNumSupply :: Num a => IO (Supply a) -newDupableNumSupply = newSupply (1+) 0 -{-# SPECIALIZE newNumSupply :: IO (Supply Int) #-} - -split :: Supply a -> Stream (Supply a) -split (Supply _ l r) = l :> split r - -splits :: Integral b => Supply a -> b -> Supply a -splits (Supply _ l r) n = case n `quotRem` 2 of - (0,0) -> leftSupply l - (q,-1) -> splits (rightSupply l) q - (q,0) -> splits (leftSupply r) q - (q,1) -> splits (rightSupply r) q - (_,_) -> error "quotRem: impossible result" -{-# SPECIALIZE splits :: Supply a -> Int -> Supply a #-} -{-# SPECIALIZE splits :: Supply a -> Integer -> Supply a #-} - -splitSkew :: Supply a -> Skew.Stream (Supply a) -splitSkew = tabulate . splits - -split2 :: Supply a -> (Supply a, Supply a) -split2 (Supply _ l r) = (l, r) - -split3 :: Supply a -> (Supply a, Supply a, Supply a) -split3 (Supply _ a (Supply _ b c)) = (a, b, c) - -split4 :: Supply a -> (Supply a, Supply a, Supply a, Supply a) -split4 (Supply _ (Supply _ a b) (Supply _ c d)) = (a, b, c, d) +{-# LANGUAGE CPP, FlexibleContexts #-} +#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Trustworthy #-} +#endif +----------------------------------------------------------------------------- +-- | +-- Module : Data.Stream.Supply +-- Copyright : (C) 2008-2011 Edward Kmett, +-- (C) 2008 Iavor S. Diatchki +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- Stability : provisional +-- Portability : portable +-- +-- This library can be used to generate values (for example, new names) +-- without the need to thread state. This means that functions that +-- need to generate new values only need a supply object as an argument, +-- and they do not need to return a new supply object as a result. +-- This decreases the number of data-dependencies in a program, which +-- makes it easier to exploit parallelism. +-- +-- The technique for generating new values is based on the paper +-- ''On Generating Unique Names'' by Lennart Augustsson, Mikael Rittri, +-- and Dan Synek. +---------------------------------------------------------------------------- +module Data.Stream.Supply + ( Supply + , newSupply + , newEnumSupply + , newNumSupply + , newDupableSupply + , newDupableEnumSupply + , newDupableNumSupply + , leftSupply + , rightSupply + , split + , splits + , splitSkew + , split2 + , split3 + , split4 + ) where + +#if !(MIN_VERSION_base(4,8,0)) +import Control.Applicative +#endif +import Control.Comonad +import Data.Functor.Apply +import Data.Functor.Extend +import Data.Functor.Rep +import Data.IORef(newIORef, atomicModifyIORef) +#if !(MIN_VERSION_base(4,8,0)) +import Data.Foldable +import Data.Traversable +#endif +#if !(MIN_VERSION_base(4,11,0)) +import Data.Semigroup +#endif +import Data.Semigroup.Foldable +import Data.Semigroup.Traversable +import System.IO.Unsafe (unsafeInterleaveIO) +import Data.Stream.Infinite +import qualified Data.Stream.Infinite.Skew as Skew + +#ifdef LANGUAGE_DeriveDataTypeable +import Data.Data +#endif + +#if __GLASGOW_HASKELL__ >= 608 +import GHC.IO(unsafeDupableInterleaveIO) +#else +unsafeDupableInterleaveIO :: IO a -> IO a +unsafeDupableInterleaveIO = unsafeInterleaveIO +#endif + +data Supply a = Supply a (Supply a) (Supply a) deriving + ( Show, Read, Eq, Ord +#ifdef LANGUAGE_DeriveDataTypeable + , Data, Typeable +#endif + ) + +instance Functor Supply where + fmap f (Supply a l r) = Supply (f a) (fmap f l) (fmap f r) + a <$ _ = pure a + +instance Extend Supply where + extended f s@(Supply _ l r) = Supply (f s) (extended f l) (extended f r) + duplicated s@(Supply _ l r) = Supply s (duplicated l) (duplicated r) + +instance Comonad Supply where + extend f s@(Supply _ l r) = Supply (f s) (extend f l) (extend f r) + duplicate s@(Supply _ l r) = Supply s (duplicate l) (duplicate r) + extract (Supply a _ _) = a + +instance Apply Supply where + Supply f fl fr <.> Supply a al ar = Supply (f a) (fl <.> al) (fr <.> ar) + a <. _ = a + _ .> a = a + +instance Applicative Supply where + pure a = as where as = Supply a as as + Supply f fl fr <*> Supply a al ar = Supply (f a) (fl <*> al) (fr <*> ar) + a <* _ = a + _ *> a = a + +instance Foldable Supply where + foldMap f (Supply a l r) = f a `mappend` foldMap f l `mappend` foldMap f r + +instance Foldable1 Supply where + foldMap1 f (Supply a l r) = f a <> foldMap1 f l <> foldMap1 f r + +instance Traversable Supply where + traverse f (Supply a l r) = Supply <$> f a <*> traverse f l <*> traverse f r + +instance Traversable1 Supply where + traverse1 f (Supply a l r) = Supply <$> f a <.> traverse1 f l <.> traverse1 f r + +leftSupply :: Supply a -> Supply a +leftSupply (Supply _ l _) = l + +rightSupply :: Supply a -> Supply a +rightSupply (Supply _ _ r) = r + +-- unfoldsW :: (Comonad w, Functor f) => (w a -> (b, f a)) -> w a -> StreamT f w b +newSupply :: (a -> a) -> a -> IO (Supply a) +newSupply f x = gen =<< newIORef x + where gen r = unsafeInterleaveIO $ + Supply <$> unsafeInterleaveIO (atomicModifyIORef r update) + <*> gen r + <*> gen r + update a = b `seq` (b, a) where b = f a +{-# INLINE newSupply #-} + +newDupableSupply :: (a -> a) -> a -> IO (Supply a) +newDupableSupply f x = gen =<< newIORef x + where gen r = unsafeDupableInterleaveIO $ + Supply <$> unsafeDupableInterleaveIO (atomicModifyIORef r update) + <*> gen r + <*> gen r + update a = b `seq` (b, a) where b = f a +{-# INLINE newDupableSupply #-} + +newEnumSupply :: Enum a => IO (Supply a) +newEnumSupply = newSupply succ (toEnum 0) +{-# SPECIALIZE newEnumSupply :: IO (Supply Int) #-} + +newNumSupply :: Num a => IO (Supply a) +newNumSupply = newSupply (1+) 0 +{-# SPECIALIZE newNumSupply :: IO (Supply Int) #-} + +newDupableEnumSupply :: Enum a => IO (Supply a) +newDupableEnumSupply = newSupply succ (toEnum 0) +{-# SPECIALIZE newEnumSupply :: IO (Supply Int) #-} + +newDupableNumSupply :: Num a => IO (Supply a) +newDupableNumSupply = newSupply (1+) 0 +{-# SPECIALIZE newNumSupply :: IO (Supply Int) #-} + +split :: Supply a -> Stream (Supply a) +split (Supply _ l r) = l :> split r + +splits :: Integral b => Supply a -> b -> Supply a +splits (Supply _ l r) n = case n `quotRem` 2 of + (0,0) -> leftSupply l + (q,-1) -> splits (rightSupply l) q + (q,0) -> splits (leftSupply r) q + (q,1) -> splits (rightSupply r) q + (_,_) -> error "quotRem: impossible result" +{-# SPECIALIZE splits :: Supply a -> Int -> Supply a #-} +{-# SPECIALIZE splits :: Supply a -> Integer -> Supply a #-} + +splitSkew :: Supply a -> Skew.Stream (Supply a) +splitSkew = tabulate . splits + +split2 :: Supply a -> (Supply a, Supply a) +split2 (Supply _ l r) = (l, r) + +split3 :: Supply a -> (Supply a, Supply a, Supply a) +split3 (Supply _ a (Supply _ b c)) = (a, b, c) + +split4 :: Supply a -> (Supply a, Supply a, Supply a, Supply a) +split4 (Supply _ (Supply _ a b) (Supply _ c d)) = (a, b, c, d) diff --git a/streams.cabal b/streams.cabal --- a/streams.cabal +++ b/streams.cabal @@ -1,93 +1,110 @@ -name: streams -category: Control, Comonads -version: 3.3 -license: BSD3 -cabal-version: >= 1.6 -license-file: LICENSE -author: Edward A. Kmett -maintainer: Edward A. Kmett -stability: provisional -homepage: http://github.com/ekmett/streams -homepage: http://github.com/ekmett/streams/issues -copyright: Copyright 2011-2013 Edward Kmett - Copyright 2010 Tony Morris, Oliver Taylor, Eelis van der Weegen - Copyright 2007-2010 Wouter Swierstra, Bas van Dijk - Copyright 2008 Iavor S. Diatchki -synopsis: Various Haskell 2010 stream comonads -build-type: Simple -extra-source-files: - CHANGELOG.markdown - README - .ghci - .gitignore - .travis.yml - .vim.custom -description: - Various Haskell 2010 stream comonads. - * "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.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. - . - > 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) - . - * "Data.Stream.Supply" provides a comonadic supply of unique values, which are - generated impurely as the tree is explored. - -source-repository head - type: git - location: git://github.com/ekmett/streams.git - -library - other-extensions: - PatternGuards - BangPatterns - - build-depends: - base >= 4 && < 5, - adjunctions >= 4.0.1 && < 5, - comonad >= 4 && < 6, - distributive >= 0.2.1 && < 1, - semigroupoids >= 4 && < 6, - semigroups >= 0.8.3.1 && < 1 - - extensions: CPP - if impl(ghc) - cpp-options: -DLANGUAGE_DeriveDataTypeable - extensions: FlexibleContexts, DeriveDataTypeable - - exposed-modules: - Data.Stream.Future - Data.Stream.Future.Skew - Data.Stream.Infinite - Data.Stream.Infinite.Skew - Data.Stream.Infinite.Functional.Zipper - Data.Stream.Supply - - hs-source-dirs: src - ghc-options: -Wall - +name: streams +category: Control, Comonads +version: 3.3.1 +license: BSD3 +cabal-version: >= 1.10 +license-file: LICENSE +author: Edward A. Kmett +maintainer: Edward A. Kmett +stability: provisional +homepage: http://github.com/ekmett/streams +bug-reports: http://github.com/ekmett/streams/issues +copyright: Copyright 2011-2013 Edward Kmett + Copyright 2010 Tony Morris, Oliver Taylor, Eelis van der Weegen + Copyright 2007-2010 Wouter Swierstra, Bas van Dijk + Copyright 2008 Iavor S. Diatchki +synopsis: Various Haskell 2010 stream comonads +build-type: Simple +extra-source-files: + CHANGELOG.markdown + README + .gitignore + .vim.custom +tested-with: GHC == 7.4.2 + , GHC == 7.6.3 + , GHC == 7.8.4 + , GHC == 7.10.3 + , GHC == 8.0.2 + , GHC == 8.2.2 + , GHC == 8.4.4 + , GHC == 8.6.5 + , GHC == 8.8.4 + , GHC == 8.10.7 + , GHC == 9.0.2 + , GHC == 9.2.2 +description: + Various Haskell 2010 stream comonads. + * "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.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. + . + > 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) + . + * "Data.Stream.Supply" provides a comonadic supply of unique values, which are + generated impurely as the tree is explored. + +source-repository head + type: git + location: git://github.com/ekmett/streams.git + +library + other-extensions: + PatternGuards + BangPatterns + + build-depends: + base >= 4 && < 5, + adjunctions >= 4.0.1 && < 5, + boring >= 0.2 && < 0.3, + comonad >= 4 && < 6, + distributive >= 0.2.1 && < 1, + semigroupoids >= 4 && < 6 + + if impl(ghc < 8.0) + build-depends: + semigroups >= 0.8.3.1 && < 1 + + default-extensions: CPP + if impl(ghc) + cpp-options: -DLANGUAGE_DeriveDataTypeable + default-extensions: FlexibleContexts, DeriveDataTypeable + + exposed-modules: + Data.Stream.Future + Data.Stream.Future.Skew + Data.Stream.Infinite + Data.Stream.Infinite.Skew + Data.Stream.Infinite.Functional.Zipper + Data.Stream.Supply + + hs-source-dirs: src + ghc-options: -Wall + if impl(ghc >= 7.10) + ghc-options: -fno-warn-trustworthy-safe + default-language: Haskell2010 +