machines 0.6 → 0.6.1
raw patch · 11 files changed
+204/−19 lines, 11 filesdep ~comonaddep ~conduit-combinatorsdep ~criterionsetup-changed
Dependency ranges changed: comonad, conduit-combinators, criterion, distributive, doctest, pointed, transformers
Files
- .gitignore +6/−0
- .travis.yml +106/−1
- CHANGELOG.markdown +6/−0
- Setup.lhs +4/−0
- examples/machines-examples.cabal +2/−2
- machines.cabal +9/−9
- src/Data/Machine/Fanout.hs +13/−2
- src/Data/Machine/Process.hs +24/−0
- src/Data/Machine/Source.hs +24/−1
- src/Data/Machine/Tee.hs +7/−1
- tests/doctests.hs +3/−3
.gitignore view
@@ -12,3 +12,9 @@ *~ *# .cabal-sandbox+cabal.sandbox.config+*.prof+*.aux+*.hp+*.eventlog+.stack-work/
.travis.yml view
@@ -1,4 +1,107 @@-language: haskell+# 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=1.24 GHCVER=head+ compiler: ": #GHC head"+ addons: {apt: {packages: [cabal-install-1.24,ghc-head], sources: [hvr-ghc]}}++ allow_failures:+ - env: CABALVER=1.24 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;+ if [ "$GHCVER" = "7.10.3" ]; then cabal install Cabal-1.22.4.0; fi;+ 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:+ # -v2 provides useful information for debugging+ - cabal configure --enable-tests -v2++ # this builds all libraries and executables+ # (including tests/benchmarks)+ - cabal build++ - cabal test++ # tests that a source-distribution can be generated+ - cabal sdist++ # check that the generated source-distribution can be built & installed+ - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ;+ cd dist/;+ if [ -f "$SRC_TGZ" ]; then+ cabal install --force-reinstalls "$SRC_TGZ";+ else+ echo "expected '$SRC_TGZ' not found";+ exit 1;+ fi+ notifications: irc: channels:@@ -6,3 +109,5 @@ skip_join: true template: - "\x0313machines\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"++# EOF
CHANGELOG.markdown view
@@ -1,3 +1,9 @@+0.6.1+-----+* Bumped upper version bounds for `comonad`, `conduit-combinators`, `criterion`, `distributive`, `pointed`, and `transformers`+* Fix compilation with `stack`+* Added `strippingPrefix`, `unfold`, `unfoldT`, `zipping`+ 0.6 --- * Added better fanout combinators. `Data.Machine.Fanout`
Setup.lhs view
@@ -30,6 +30,10 @@ withTestLBI pkg lbi $ \suite suitecfg -> do rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines [ "module Build_" ++ testName suite ++ " where"+ , ""+ , "autogen_dir :: String"+ , "autogen_dir = " ++ show dir+ , "" , "deps :: [String]" , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg)) ]
examples/machines-examples.cabal view
@@ -23,8 +23,8 @@ library build-depends: base == 4.*,- machines == 0.4,- mtl >= 2 && < 2.2+ machines == 0.6.*,+ mtl >= 2 && < 2.3 exposed-modules: Examples
machines.cabal view
@@ -1,6 +1,6 @@ name: machines category: Control, Enumerator-version: 0.6+version: 0.6.1 license: BSD3 cabal-version: >= 1.10 license-file: LICENSE@@ -38,15 +38,15 @@ build-depends: adjunctions >= 4.2 && < 5, base >= 4.5 && < 5,- comonad >= 3 && < 5,+ comonad >= 3 && < 6, containers >= 0.3 && < 0.6,- distributive < 0.5,+ distributive < 0.6, free >= 3.1.1 && < 5,- pointed >= 3 && < 5,+ pointed >= 3 && < 6, profunctors >= 3 && < 6, semigroupoids >= 5 && < 6, semigroups >= 0.8.3 && < 1,- transformers >= 0.3 && < 0.5,+ transformers >= 0.3 && < 0.6, transformers-compat >= 0.3, mtl >= 2 && < 2.3, void >= 0.6.1 && < 1@@ -88,8 +88,8 @@ build-depends: base == 4.*, directory >= 1.0 && < 1.3,- doctest >= 0.8 && < 0.11,- filepath >= 1.3 && < 1.5+ doctest >= 0.8 && < 0.12,+ filepath >= 1.3 && < 1.5 ghc-options: -Wall -threaded hs-source-dirs: tests @@ -103,8 +103,8 @@ build-depends: base == 4.*, conduit >= 1.0 && < 1.3,- conduit-combinators >= 0.2.5 && < 0.4,- criterion >= 0.6 && < 1.1,+ conduit-combinators >= 0.2.5 && < 1.1,+ criterion >= 0.6 && < 1.2, machines, mtl >= 2 && < 2.3, pipes >= 4 && < 4.2
src/Data/Machine/Fanout.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-} -- | Provide a notion of fanout wherein a single input is passed to -- several consumers.@@ -25,10 +26,15 @@ -- | Share inputs with each of a list of processes in lockstep. Any -- values yielded by the processes are combined into a single yield -- from the composite process.-fanout :: (Functor m, Monad m, Semigroup r)+fanout :: forall m a r. (Monad m, Semigroup r) => [ProcessT m a r] -> ProcessT m a r fanout = MachineT . go id id where+ go :: ([(a -> ProcessT m a r, ProcessT m a r)]+ -> [(a -> ProcessT m a r, ProcessT m a r)])+ -> ([r] -> [r])+ -> [ProcessT m a r]+ -> m (Step (Is a) r (ProcessT m a r)) go waiting acc [] = case waiting [] of ws -> return . maybe k (\x -> Yield x $ encased k) $ semigroupDlist acc where k = continue fanout ws@@ -44,10 +50,15 @@ -- run a collection of 'ProcessT's that await but don't yield some -- number of times, you can use 'fanOutSteps . map (fmap (const ()))' -- followed by a 'taking' process.-fanoutSteps :: (Functor m, Monad m, Monoid r)+fanoutSteps :: forall m a r. (Monad m, Monoid r) => [ProcessT m a r] -> ProcessT m a r fanoutSteps = MachineT . go id id where+ go :: ([(a -> ProcessT m a r, ProcessT m a r)]+ -> [(a -> ProcessT m a r, ProcessT m a r)])+ -> ([r] -> [r])+ -> [ProcessT m a r]+ -> m (Step (Is a) r (ProcessT m a r)) go waiting acc [] = case (waiting [], mconcat (acc [])) of (ws, xs) -> return . Yield xs $ encased (continue fanoutSteps ws) go waiting acc (m:ms) = runMachineT m >>= \v -> case v of
src/Data/Machine/Process.hs view
@@ -52,6 +52,7 @@ , mapping , reading , showing+ , strippingPrefix ) where import Control.Applicative@@ -344,3 +345,26 @@ -- Convert 'Show'able values to 'String's showing :: (Category k, Show a) => Machine (k a) String showing = mapping show++-- |+-- 'strippingPrefix' @mp mb@ Drops the given prefix from @mp@. It stops if @mb@+-- did not start with the prefix given, or continues streaming after the+-- prefix, if @mb@ did.+strippingPrefix :: (Eq b, Monad m)+ => MachineT m (k a) b+ -> MachineT m (k a) b+ -> MachineT m (k a) b+strippingPrefix mp mb = MachineT $ runMachineT mp >>= \v -> case v of+ Stop -> runMachineT mb+ Yield b k -> verify b k mb+ Await f ki ff ->+ return $ Await (\a -> strippingPrefix (f a) mb) ki (strippingPrefix ff mb)+ where+ verify b nxt cur = runMachineT cur >>= \u -> case u of+ Stop -> return Stop+ Yield b' nxt'+ | b == b' -> runMachineT $ strippingPrefix nxt nxt'+ | otherwise -> return Stop+ Await f ki ff ->+ return $ Await (\a -> MachineT $ verify b nxt (f a))+ ki (MachineT $ verify b nxt ff)
src/Data/Machine/Source.hs view
@@ -22,14 +22,17 @@ , iterated , replicated , enumerateFromTo+ , unfold+ , unfoldT ) where import Control.Category+import Control.Monad.Trans import Data.Foldable import Data.Machine.Plan import Data.Machine.Type import Data.Machine.Process-import Prelude (Enum, Eq, Int, otherwise, succ, (==), (>>))+import Prelude (Enum, Eq, Int, Maybe, Monad, otherwise, succ, (==), (>>), ($)) ------------------------------------------------------------------------------- -- Source@@ -82,3 +85,23 @@ go i | i == end = yield i | otherwise = yield i >> go (succ i)++-- | 'unfold' @k seed@ The function takes the element and returns Nothing if it+-- is done producing values or returns Just (a,r), in which case, @a@ is+-- 'yield'ed and @r@ is used as the next element in a recursive call.+unfold :: (r -> Maybe (a, r)) -> r -> Source a+unfold k seed = construct (go seed)+ where+ go r = for_ (k r) $ \(a, r') -> do+ yield a+ go r'++-- | Effectful 'unfold' variant.+unfoldT :: Monad m => (r -> m (Maybe (a, r))) -> r -> SourceT m a+unfoldT k seed = construct (go seed)+ where+ go r = do+ opt <- lift $ k r+ for_ opt $ \(a, r') -> do+ yield a+ go r'
src/Data/Machine/Tee.hs view
@@ -20,6 +20,7 @@ , capL, capR , zipWithT , zipWith+ , zipping ) where import Data.Machine.Is@@ -104,7 +105,7 @@ {-# INLINE cappedT #-} -- | wait for both the left and the right sides of a T and then merge them with f.-zipWithT :: Monad m => (a -> b -> c) -> PlanT (T a b) c m ()+zipWithT :: (a -> b -> c) -> PlanT (T a b) c m () zipWithT f = do { a <- awaits L; b <- awaits R; yield $ f a b } {-# INLINE zipWithT #-} @@ -117,3 +118,8 @@ b <- awaits R yield (f a b) {-# INLINE zipWith #-}++-- | Zip together two inputs, halting as soon as either input is exhausted.+zipping :: Tee a b (a, b)+zipping = zipWith (,)+{-# INLINE zipping #-}
tests/doctests.hs view
@@ -1,6 +1,6 @@ module Main where -import Build_doctests (deps)+import Build_doctests (autogen_dir, deps) import Control.Applicative import Control.Monad import Data.List@@ -12,9 +12,9 @@ main :: IO () main = getSources >>= \sources -> doctest $ "-isrc"- : "-idist/build/autogen"+ : ("-i" ++ autogen_dir) : "-optP-include"- : "-optPdist/build/autogen/cabal_macros.h"+ : ("-optP" ++ autogen_dir ++ "/cabal_macros.h") : "-hide-all-packages" : map ("-package="++) deps ++ sources