simple-pipe (empty) → 0.0.0.0

raw patch · 5 files changed

+261/−0 lines, 5 filesdep +basedep +lifted-basedep +monad-controlsetup-changed

Dependencies added: base, lifted-base, monad-control, monads-tf

Files

LICENSE +27/−0
Setup.hs +1/−0
examples/upperFile.hs +48/−0
simple-pipe.cabal +98/−0
src/Data/Pipe.hs +87/−0

+ LICENSE view

@@ -0,0 +1,27 @@+Copyright (c) 2014, Yoshikuni Jujo+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++  * Redistributions of source code must retain the above copyright notice,+    this list of conditions and the following disclaimer.++  * 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.++  * Neither the name of the Yoshikuni Jujo nor the names of its+    contributors may be used to endorse or promote products derived from+    this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "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 EVEN SHALL THE COPYRIGHT HOLDER 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.

+ Setup.hs view

@@ -0,0 +1,1 @@+import Distribution.Simple; main = defaultMain

+ examples/upperFile.hs view

@@ -0,0 +1,48 @@+{-# LANGUAGE PackageImports #-}++import Data.Pipe+import Data.Char+import System.IO+import "monads-tf" Control.Monad.Trans++main :: IO ()+main = do+	_ <- runPipe $+		readFileP "sample.txt"+			=$= takeP 3+			=$= convert (map toUpper)+			=$= writeString+	return ()++readFileP :: FilePath -> Pipe () String IO ()+readFileP fp = bracket (openFile fp ReadMode) hClose hRead++hRead :: Handle -> Pipe () String IO ()+hRead h = do+	eof <- lift $ hIsEOF h+	if eof then return () else do+		l <- lift $ hGetLine h+		yield l+		hRead h++writeString :: Pipe String () IO ()+writeString = do+	ms <- await+	case ms of+		Just s -> lift (putStrLn s) >> writeString+		_ -> return ()++convert :: Monad m => (a -> b) -> Pipe a b m ()+convert f = do+	mx <- await+	case mx of+		Just x -> yield (f x) >> convert f+		_ -> return ()++takeP :: Monad m => Int -> Pipe a a m ()+takeP 0 = return ()+takeP n = do+	mx <- await+	case mx of+		Just x -> yield x >> takeP (n - 1)+		_ -> return ()

+ simple-pipe.cabal view

@@ -0,0 +1,98 @@+build-type:	Simple+cabal-version:	>= 1.8++name:		simple-pipe+version:	0.0.0.0+stability:	Experimental+author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp>+maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>+homepage:	https://github.com/YoshikuniJujo/simple-pipe/wiki++license:	BSD3+license-file:	LICENSE++category:	Data+synopsis:	simple pipeline library like conduit+description:+    .+    examples/upperFile.hs+    .+    * read file (sample.txt)+    .+    * take 3 lines+    .+    * to upper all lines+    .+    * write to stdout+    .+    extensions+    .+    .+    * PackageImports+    .+    > import Data.Pipe+    > import Data.Char+    > import System.IO+    > import "monads-tf" Control.Monad.Trans+    >+    > main :: IO ()+    > main = do+    > 	_ <- runPipe $ readFileP "sample.txt"+    >		=$= takeP 3+    >		=$= convert (map toUpper)+    >		=$= writeString+    > 	return ()+    >+    > readFileP :: FilePath -> Pipe () String IO ()+    > readFileP fp = bracket (openFile fp ReadMode) hClose hRead+    >+    > hRead :: Handle -> Pipe () String IO ()+    > hRead h = do+    > 	eof <- lift $ hIsEOF h+    > 	if eof then return () else do+    > 		l <- lift $ hGetLine h+    > 		yield l+    > 		hRead h+    >+    > writeString :: Pipe String () IO ()+    > writeString = do+    > 	ms <- await+    > 	case ms of+    > 		Just s -> lift (putStrLn s) >> writeString+    > 		_ -> return ()+    >+    > convert :: Monad m => (a -> b) -> Pipe a b m ()+    > convert f = do+    > 	mx <- await+    > 	case mx of+    > 		Just x -> yield (f x) >> convert f+    > 		_ -> return ()+    >+    > takeP :: Monad m => Int -> Pipe a a m ()+    > takeP 0 = return ()+    > takeP n = do+    >	mx <- await+    >	case mx of+    >		Just x -> yield x >> takeP (n - 1)+    >		_ -> return ()+    .++extra-source-files:+    examples/upperFile.hs++source-repository	head+    type:	git+    location:	git://github.com/YoshikuniJujo/forest.git++source-repository	this+    type:	git+    location:	git://github.com/YoshikuniJujo/forest.git+    tag:	simple-pipe-0.0.0.0++library+    hs-source-dirs:	src+    exposed-modules:	Data.Pipe+    build-depends:+        base == 4.*, monad-control == 0.3.*, lifted-base == 0.2.*,+        monads-tf == 0.1.*+    ghc-options:	-Wall

+ src/Data/Pipe.hs view

@@ -0,0 +1,87 @@+{-# LANGUAGE FlexibleContexts, RankNTypes, PackageImports #-}++module Data.Pipe (+	PipeClass(..), Pipe, runPipe, finalize, finally, bracket ) where++import Control.Applicative+import Control.Monad+import Control.Exception.Lifted (onException)+import Control.Monad.Trans.Control+import "monads-tf" Control.Monad.Trans++class PipeClass p where+	(=$=) :: Monad m => p a b m x -> p b c m y -> p a c m y+	yield :: Monad m => o -> p i o m ()+	await :: Monad m => p i o m (Maybe i)++data Pipe i o m r+	= Ready (m ()) o (Pipe i o m r)+	| Need (m ()) (Maybe i -> Pipe i o m r)+	| Done (m ()) r+	| Make (m ()) (m (Pipe i o m r))++finalizer :: Pipe i o m r -> m ()+finalizer (Ready f _ _) = f+finalizer (Need f _) = f+finalizer (Done f _) = f+finalizer (Make f _) = f++instance PipeClass Pipe where+	p =$= Done f r = Done (finalizer p >> f) r+	p =$= Ready f o p' = Ready f o $ p =$= p'+	Need f n =$= p = Need f $ \i -> n i =$= p+	Ready _ o p =$= Need _ n = p =$= n (Just o)+	Done f r =$= Need f' n =+		Done (return ()) r =$= Make f' (f >> return (n Nothing))+	Make f m =$= p = Make f $ (=$= p) `liftM` m+	p =$= Make f m = Make f $ (p =$=) `liftM` m++	yield x = Ready (return ()) x (return ())+	await = Need (return ()) return++instance Monad m => Monad (Pipe i o m) where+	Ready f o p >>= k = Ready f o $ p >>= k+	Need f n >>= k = Need f $ \i -> n i >>= k+--	Done f r >>= k = Make (return ()) $ f >> return (k r)+	Done _ r >>= k = k r+	Make f m >>= k = Make f $ (>>= k) `liftM` m+	return = Done (return ())++instance Monad m => Functor (Pipe i o m) where+	fmap = (=<<) . (return .)++instance Monad m => Applicative (Pipe i o m) where+	pure = return+	(<*>) = liftM2 id++instance MonadTrans (Pipe i o) where+	lift = liftP++runPipe :: Monad m => Pipe i o m r -> m (Maybe r)+runPipe (Done f r) = f >> return (Just r)+runPipe (Make _ m) = runPipe =<< m+runPipe _ = return Nothing++liftP :: Monad m => m a -> Pipe i o m a+liftP m = Make (return ()) $ Done (return ()) `liftM` m++bracket :: MonadBaseControl IO m =>+	m a -> (a -> m b) -> (a -> Pipe i o m r) -> Pipe i o m r+bracket o c p = do+	h <- liftP o+	p h `finally` (c h >> return ())++finalize :: Monad m => Pipe i o m r -> m b -> Pipe i o m r+finalize (Ready _ o p) f = Ready (f >> return ()) o $ finalize p f+finalize (Need _ n) f = Need (f >> return ()) $ \i -> finalize (n i) f+finalize (Done _ r) f = Done (f >> return ()) r+finalize (Make _ m) f = Make (f >> return ()) $ flip finalize f `liftM` m++finally :: MonadBaseControl IO m => Pipe i o m r -> m b -> Pipe i o m r+finally p f = finalize (mapMake (`onException` f) p) f++mapMake :: Monad m => (forall a . m a -> m a) -> Pipe i o m r -> Pipe i o m r+mapMake k (Ready f o p) = Ready f o $ mapMake k p+mapMake k (Need f n) = Need f $ \i -> mapMake k $ n i+mapMake _ (Done f r) = Done f r+mapMake k (Make f m) = Make f . k $ mapMake k `liftM` m