packages feed

machines 0.2.5 → 0.4

raw patch · 12 files changed

+474/−52 lines, 12 filesdep +conduitdep +criteriondep +hastachedep ~mtl

Dependencies added: conduit, criterion, hastache, machines, pipes, statistics

Dependency ranges changed: mtl

Files

README.markdown view
@@ -25,6 +25,8 @@  Runar's slides are also available from https://dl.dropbox.com/u/4588997/Machines.pdf +Some worked examples are here https://github.com/alanz/machines-play+ Contact Information -------------------
+ benchmarks/Benchmarks.hs view
@@ -0,0 +1,66 @@+module Main (main) where++import Control.Monad (void)+import Control.Monad.Identity+import Criterion.Main+import qualified Data.Conduit      as C+import qualified Data.Conduit.List as C+import qualified Data.Machine      as M+import qualified Pipes             as P+import qualified Pipes.Prelude     as P++value :: Int+value = 1000000++drainM :: M.ProcessT Identity Int o -> ()+drainM m = runIdentity $ M.runT_ (sourceM M.~> m)++drainP :: P.Proxy () Int () a Identity () -> ()+drainP p = runIdentity $ P.runEffect $ P.for (sourceP P.>-> p) P.discard++drainC :: C.Conduit Int Identity a -> ()+drainC c = runIdentity $ (sourceC C.$= c) C.$$ C.sinkNull++drainSC :: C.Sink Int Identity b -> ()+drainSC c = runIdentity $ void $ sourceC C.$$ c++sourceM = M.enumerateFromTo 1 value+sourceC = C.enumFromTo 1 value+sourceP = P.each [1..value]++main :: IO ()+main =+  defaultMain+  [ bgroup "map"+      [ bench "machines" $ whnf drainM (M.auto (+1))+      , bench "pipes" $ whnf drainP (P.map (+1))+      , bench "conduit" $ whnf drainC (C.map (+1))+      ]+  , bgroup "drop"+      [ bench "machines" $ whnf drainM (M.dropping value)+      , bench "pipes" $ whnf drainP (P.drop value)+      , bench "conduit" $ whnf drainC (C.drop value)+      ]+  , bgroup "dropWhile"+      [ bench "machines" $ whnf drainM (M.droppingWhile (<= value))+      , bench "pipes" $ whnf drainP (P.dropWhile (<= value))+      ]+  , bgroup "scan"+      [ bench "machines" $ whnf drainM (M.scan (+) 0)+      , bench "pipes" $ whnf drainP (P.scan (+) 0 id)+      , bench "conduit" $ whnf drainC (C.scanl (\a s -> let b = a+s in (b,b)) 0)+      ]+  , bgroup "take"+      [ bench "machines" $ whnf drainM (M.taking value)+      , bench "pipes" $ whnf drainP (P.take value)+      , bench "conduit" $ whnf drainSC (C.take value)+      ]+  , bgroup "takeWhile"+      [ bench "machines" $ whnf drainM (M.takingWhile (<= value))+      , bench "pipes" $ whnf drainP (P.takeWhile (<= value))+      ]+  , bgroup "fold"+      [ bench "machines" $ whnf drainM (M.fold (+) 0)+      , bench "pipes" $ whnf (P.fold (+) 0 id) sourceP+      ]+  ]
+ examples/Examples.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE RankNTypes #-}++module Examples where++import Control.Applicative+import Control.Exception+import Control.Monad.Trans+import Data.Machine+import System.IO++-- this slurp slurps until an eof exception is raised.+slurpHandleBad :: Handle -> IO [String]+slurpHandleBad h = do+  s <- hGetLine h+  (s:) <$> slurpHandleBad h++-- this is the good slurp+-- it catches the exception, and cleans up.+slurpHandle :: Handle -> IO [String]+slurpHandle h = clean <$> slurp where+  clean = either (\(SomeException _) -> []) id+  slurp = try $ do { s <- hGetLine h; (s:) <$> slurpHandle h }++-- read a file, returning each line in a list +readLines :: FilePath -> IO [String]+readLines f = withFile f ReadMode slurpHandle++-- | bad slurping machine+crashes :: Handle -> MachineT IO k String+crashes h = repeatedly $ lift (hGetLine h) >>= yield++-- | here is a plan that yields all the lines at once.+slurpHandlePlan :: Handle -> PlanT k [String] IO ()+slurpHandlePlan h = lift (slurpHandle h) >>= yield++{-+ - but we want a plan that will yield one line at a time+ - until we are done reading the file+ - but before we can do that, we need a few helper combinators.+ -}++-- | getFileLines reads each line out of the given file and pumps them into the given process.+getFileLines :: FilePath -> ProcessT IO String a -> SourceT IO a +getFileLines path proc = src ~> proc where +  src :: SourceT IO String+  src = construct $ lift (openFile path ReadMode) >>= slurpLinesPlan+  slurpLinesPlan :: Handle -> PlanT k String IO ()+  slurpLinesPlan h = exhaust (clean <$> try (hGetLine h)) where+  clean = either (\(SomeException _) -> Nothing) Just++-- | lineCount counts the number of lines in a file+lineCount :: FilePath -> IO Int+lineCount path = head <$> (runT src) where+  src = getFileLines path (fold (\a _ -> a + 1) 0)++-- | run a machine and just take the first value out of it.+runHead :: (Functor f, Monad f) => MachineT f k b -> f b+runHead src = head <$> runT src++-- | lineCharCount counts the number of lines, and characters in a file+lineCharCount :: FilePath -> IO (Int, Int)+lineCharCount path = runHead src where+  src = getFileLines path (fold (\(l,c) s -> (l+1, c + length s)) (0,0))++-- | A Process that takes in a String and outputs all the words in that String+wordsProc :: Process String String+wordsProc = repeatedly $ do { s <- await; mapM_ yield (words s) }++-- | A Plan to print all input.+printPlan :: PlanT (Is String) () IO ()+printPlan = await >>= lift . putStrLn >> yield ()++-- | A Process that prints all its input.+printProcess :: ProcessT IO String ()+printProcess = repeatedly printPlan++-- | A machine that prints all the lines in a file.+printLines :: FilePath -> IO ()+printLines path = runT_ $ getFileLines path printProcess++-- | A machine that prints all the words in a file.+printWords :: FilePath -> IO ()+printWords path = runT_ $ getFileLines path (wordsProc ~> printProcess)++-- | A machine that prints all the lines in a file with the line numbers.+printLinesWithLineNumbers :: FilePath -> IO ()+printLinesWithLineNumbers path = runT_ (t ~> printProcess) where+  t :: TeeT IO Int String String+  t = tee (source [1..]) (getFileLines path echo) lineNumsT+  lineNumsT :: MachineT IO (T Integer String) String+  lineNumsT = repeatedly $ zipWithT $ \i s -> show i ++ ": " ++ s++{-+def lineWordCount(fileName: String) =+  getFileLines(new File(fileName),+    (id split words) outmap (_.fold(_ => (1, 0), _ => (0, 1)))) execute++lineWordCount FilePath -> IO (Int, Int)+lineWordCount path = runHead lineWordCountSrc where+  lineWordCountSrc = echo +-}+
+ examples/LICENSE view
@@ -0,0 +1,30 @@+Copyright 2014 Edward Kmett++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.
+ examples/machines-examples.cabal view
@@ -0,0 +1,30 @@+name:          machines-examples+category:      Control, Enumerator+version:       0.1+license:       BSD3+cabal-version: >= 1.10+license-file:  LICENSE+author:        Josh Cough+maintainer:    Edward A. Kmett <ekmett@gmail.com>+stability:     provisional+homepage:      http://github.com/ekmett/machines/+bug-reports:   http://github.com/ekmett/machines/issues+copyright:     Copyright (C) 2014 Edward A. Kmett+synopsis:      Networked stream transducers+description:   machines examples++build-type:    Simple+tested-with:   GHC == 7.4.1++source-repository head+  type: git+  location: git://github.com/ekmett/machines.git++library+  build-depends:+    base         == 4.*,+    machines     == 0.4,+    mtl          >= 2 && < 2.2++  exposed-modules:+    Examples
machines.cabal view
@@ -1,10 +1,10 @@ name:          machines category:      Control, Enumerator-version:       0.2.5+version:       0.4 license:       BSD3 cabal-version: >= 1.10 license-file:  LICENSE-author:        Edward A. Kmett, Rúnar Bjarnason+author:        Edward A. Kmett, Rúnar Bjarnason, Josh Cough maintainer:    Edward A. Kmett <ekmett@gmail.com> stability:     provisional homepage:      http://github.com/ekmett/machines/@@ -26,6 +26,9 @@   config   README.markdown   CHANGELOG.markdown+  examples/LICENSE+  examples/machines-examples.cabal+  examples/*.hs  source-repository head   type: git@@ -53,9 +56,9 @@     Data.Machine.Process     Data.Machine.Plan     Data.Machine.Source+    Data.Machine.Stack     Data.Machine.Tee     Data.Machine.Type-    Data.Machine.Unread     Data.Machine.Wye    default-language: Haskell2010@@ -81,3 +84,20 @@     filepath >= 1.3 && < 1.4   ghc-options: -Wall -Werror -threaded   hs-source-dirs: tests++benchmark benchmarks+  default-language: Haskell2010+  type:             exitcode-stdio-1.0+  hs-source-dirs:   benchmarks+  main-is:          Benchmarks.hs+  ghc-options:      -O2 -rtsopts -threaded++  build-depends:+    base == 4.*,+    conduit == 1.0.17.1,+    criterion == 0.6.2.*,+    hastache < 0.6,+    machines,+    mtl == 2.1.2,+    pipes == 4.1.0,+    statistics < 0.11
src/Data/Machine/Plan.hs view
@@ -24,9 +24,11 @@   , runPlan   , PlanT(..)   , yield+  , maybeYield   , await   , stop   , awaits+  , exhaust   ) where  import Control.Applicative@@ -160,6 +162,10 @@ yield :: o -> Plan k o () yield o = PlanT (\kp ke _ _ -> ke o (kp ())) +-- | Like yield, except stops if there is no value to yield. +maybeYield :: Maybe o -> Plan k o ()+maybeYield = maybe stop yield+ -- | Wait for input. -- -- @'await' = 'awaits' 'id'@@@ -179,3 +185,7 @@ -- | @'stop' = 'empty'@ stop :: Plan k o a stop = empty++-- | Run a monadic action repeatedly yielding its results, until it returns Nothing.+exhaust :: Monad m => m (Maybe a) -> PlanT k a m ()+exhaust f = do (lift f >>= maybeYield); exhaust f
src/Data/Machine/Process.hs view
@@ -31,10 +31,22 @@   , takingWhile   , buffered   , fold+  , fold1   , scan+  , scan1+  , scanMap   , asParts   , sinkPart_   , autoM+  , final+  , finalOr+  , intersperse+  , largest+  , smallest+  , sequencing+  , mapping+  , reading+  , showing   ) where  import Control.Applicative@@ -45,6 +57,7 @@ import Data.Machine.Is import Data.Machine.Plan import Data.Machine.Type+import Data.Monoid (Monoid(..)) import Data.Void import Prelude hiding ((.), id, mapM_) @@ -111,7 +124,7 @@  -- | Chunk up the input into `n` element lists. ----- Avoids returning empty lists and deals with the truncation of the last group.+-- Avoids returning empty lists and deals with the truncation of the final group. buffered :: Int -> Process a [a] buffered = repeatedly . go [] where   go [] 0  = stop@@ -163,22 +176,37 @@   f' Stop            = Stop   f' (Await g kir h) = Await (process f . g . f kir) Refl (process f h) --- | +-- | -- Construct a 'Process' from a left-scanning operation. -- -- Like 'fold', but yielding intermediate values. -- -- @ -- 'scan' :: (a -> b -> a) -> a -> Process b a--- @  +-- @ scan :: Category k => (a -> b -> a) -> a -> Machine (k b) a scan func seed = construct $ go seed where   go cur = do+    yield cur     next <- await-    yield $ func cur next-    go $ func cur next+    go $! func cur next --- | +-- |+-- 'scan1' is a variant of 'scan' that has no starting value argument+scan1 :: Category k => (a -> a -> a) -> Machine (k a) a+scan1 func = construct $ await >>= go where+  go cur = do+    yield cur+    next <- await+    go $! func cur next++-- |+-- Like 'scan' only uses supplied function to map and uses Monoid for+-- associative operation+scanMap :: (Category k, Monoid b) => (a -> b) -> Machine (k a) b+scanMap f = scan (\b a -> mappend b (f a)) mempty++-- | -- Construct a 'Process' from a left-folding operation. -- -- Like 'scan', but only yielding the final value.@@ -187,11 +215,13 @@ -- 'fold' :: (a -> b -> a) -> a -> Process b a -- @ fold :: Category k => (a -> b -> a) -> a -> Machine (k b) a-fold func seed = construct $ go seed where-  go cur = do-    next <- await <|> yield cur *> stop-    go (func cur next)+fold func seed = scan func seed ~> final +-- |+-- 'fold1' is a variant of 'fold' that has no starting value argument+fold1 :: Category k => (a -> a -> a) -> Machine (k a) a+fold1 func = scan1 func ~> final+ -- | Break each input into pieces that are fed downstream -- individually. asParts :: Foldable f => Process (f a) a@@ -216,3 +246,80 @@ -- | Apply a monadic function to each element of a 'ProcessT'. autoM :: Monad m => (a -> m b) -> ProcessT m a b autoM f = repeatedly $ await >>= lift . f >>= yield++-- |+-- Skip all but the final element of the input+--+-- @+-- 'final' :: 'Process' a a+-- @+final :: Category k => Machine (k a) a+final = construct $ await >>= go where+  go prev = do+    next <- await <|> yield prev *> stop+    go next++-- |+-- Skip all but the final element of the input.+-- If the input is empty, the default value is emitted+--+-- @+-- 'finalOr' :: a -> 'Process' a a+-- @+finalOr :: Category k => a -> Machine (k a) a+finalOr = construct . go where+  go prev = do+    next <- await <|> yield prev *> stop+    go next++-- |+-- Intersperse an element between the elements of the input+--+-- @+-- 'intersperse' :: a -> 'Process' a a+-- @+intersperse :: Category k => a -> Machine (k a) a+intersperse sep = construct $ await >>= go where+  go cur = do+    next <- await <|> yield cur *> stop+    yield cur+    yield sep+    go next++-- |+-- Return the maximum value from the input+largest :: (Category k, Ord a) => Machine (k a) a+largest = fold1 max++-- |+-- Return the minimum value from the input+smallest :: (Category k, Ord a) => Machine (k a) a+smallest = fold1 min++-- |+-- Convert a stream of actions to a stream of values+sequencing :: (Category k, Monad m) => MachineT m (k (m a)) a+sequencing = repeatedly $ do+  ma <- await+  a  <- lift ma+  yield a++-- |+-- Apply a function to all values coming from the input+mapping :: Category k => (a -> b) -> Machine (k a) b+mapping f = repeatedly $ await >>= yield . f++-- |+-- Parse 'Read'able values, only emitting the value if the parse succceeds.+-- This 'Machine' stops at first parsing error+reading :: (Category k, Read a) => Machine (k String) a+reading = repeatedly $ do+  s <- await+  case reads s of+    [(a, "")] -> yield a+    _         -> stop++-- |+-- Convert 'Show'able values to 'String's+showing :: (Category k, Show a) => Machine (k a) String+showing = mapping show
src/Data/Machine/Source.hs view
@@ -19,6 +19,9 @@   , repeated   , cycled   , cap+  , iterated+  , replicated+  , enumerateFromTo   ) where  import Control.Category@@ -26,7 +29,7 @@ import Data.Machine.Plan import Data.Machine.Type import Data.Machine.Process-import Prelude hiding ((.),id)+import Prelude (Enum, Eq, Int, otherwise, succ, (==), (>>))  ------------------------------------------------------------------------------- -- Source@@ -60,3 +63,22 @@ -- cap :: Process a b -> Source a -> Source b cap l r = l <~ r++-- | 'iterated' @f x@ returns an infinite source of repeated applications+-- of @f@ to @x@+iterated :: (a -> a) -> a -> Source a+iterated f x = construct (go x) where+  go a = do+    yield a+    go (f a)++-- | 'replicated' @n x@ is a source of @x@ emitted @n@ time(s)+replicated :: Int -> a -> Source a+replicated n x = repeated x ~> taking n++-- | Enumerate from a value to a final value, inclusive, via 'succ'+enumerateFromTo :: (Enum a, Eq a) => a -> a -> Source a+enumerateFromTo start end = construct (go start) where+  go i+    | i == end  = yield i+    | otherwise = yield i >> go (succ i)
+ src/Data/Machine/Stack.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE Rank2Types #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Machine.Stack+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  GADTs+--+----------------------------------------------------------------------------+module Data.Machine.Stack+  ( Stack(..)+  , stack+  , peek+  , pop+  , push+  ) where++import Data.Machine.Plan+import Data.Machine.Type++-- | This is a simple process type that knows how to push back input.+data Stack a r where+  Push :: a -> Stack a ()+  Pop  ::      Stack a a++-- | Peek at the next value in the input stream without consuming it+peek :: Plan (Stack a) b a+peek = do+  a <- pop+  push a+  return a++-- | Push back into the input stream+push :: a -> Plan (Stack a) b ()+push a = awaits (Push a)++-- | Pop the next value in the input stream+pop :: Plan (Stack a) b a+pop = awaits Pop++-- TODO: make this a class?++-- | Stream outputs from one 'Machine' into another with the possibility+-- of pushing inputs back.+stack :: Monad m => MachineT m k a -> MachineT m (Stack a) o -> MachineT m k o+stack up down =+  advance1 down $ \stepD     ->+  case stepD of+    Stop                     -> stopped+    Yield o down'            -> encased (Yield o (up `stack` down'))+    Await down' (Push a) _   -> encased (Yield a up) `stack` down' ()+    Await down' Pop ffD      ->+      advance1 up $ \stepU   ->+      case stepU of+        Stop                 -> stopped `stack` ffD+        Yield o up'          -> up'     `stack` down' o+        Await up' req ffU    -> encased (Await (\a -> up' a `stack` encased stepD) req+                                               (      ffU   `stack` encased stepD))+  where+  advance1 m f = MachineT (runMachineT m >>= runMachineT . f)
src/Data/Machine/Tee.hs view
@@ -18,9 +18,11 @@   , tee   , addL, addR   , capL, capR+  , zipWithT   ) where  import Data.Machine.Is+import Data.Machine.Plan import Data.Machine.Process import Data.Machine.Type import Data.Machine.Source@@ -82,3 +84,8 @@ cappedT R = Refl cappedT L = Refl {-# 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 f = do { a <- awaits L; b <- awaits R; yield $ f a b }+{-# INLINE zipWithT #-}
− src/Data/Machine/Unread.hs 
@@ -1,38 +0,0 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE Rank2Types #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Machine.Unread--- Copyright   :  (C) 2012 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  GADTs---------------------------------------------------------------------------------module Data.Machine.Unread-  ( Unread(..)-  , peek-  , unread-  ) where--import Data.Machine.Plan---- | This is a simple process type that knows how to push back input.-data Unread a r where-  Unread :: a -> Unread a ()-  Read   :: Unread a a---- | Peek at the next value in the input stream without consuming it-peek :: Plan (Unread a) b a-peek = do-  a <- awaits Read-  awaits (Unread a)-  return a---- | Push back into the input stream-unread :: a -> Plan (Unread a) b ()-unread a = awaits (Unread a)---- TODO: make this a class?