diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,28 @@ + + Pipes-based combinators for cellular data processing + ==================================================== + + Copyright © 2015 Patryk Zadarnowski «pat@jantar.org». + 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. ➂ The name of any + author may not be used to endorse or promote products derived from this + software without their specific prior written permission. + + THIS SOFTWARE IS PROVIDED “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 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/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +#! /usr/bin/env runhaskell +import Distribution.Simple +main = defaultMain diff --git a/pipes-cellular.cabal b/pipes-cellular.cabal new file mode 100644 --- /dev/null +++ b/pipes-cellular.cabal @@ -0,0 +1,47 @@ +name: pipes-cellular +version: 0.0.0.1 +synopsis: Pipes-based combinators for cellular data processing +homepage: https://github.com/zadarnowski/pipes-cellular +category: Control, Pipes +stability: alpha + +author: Patryk Zadarnowski +maintainer: Patryk Zadarnowski + +copyright: Copyright (c) 2015 Patryk Zadarnowski + +description: + + This library provides a number of miscellaneous utilities + for pipes-based processing of cellular data. + +cabal-version: >= 1.18 +build-type: Simple +license: BSD3 +license-file: LICENSE + +source-repository head + type: git + location: https://github.com/zadarnowski/pipes-cellular.git + +source-repository this + type: git + location: https://github.com/zadarnowski/pipes-cellular.git + tag: 0.0.0.1 + +library + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-missing-signatures + + exposed-modules: + Pipes.ByteString.Chunks + Pipes.Cell + Pipes.Maybe + Pipes.Either + + build-depends: + base >= 4.8 && < 5, + bytestring >= 0.10.6.0, + data-cell >= 1.0.0.2, + pipes >= 4.1.5 diff --git a/src/Pipes/ByteString/Chunks.lhs b/src/Pipes/ByteString/Chunks.lhs new file mode 100644 --- /dev/null +++ b/src/Pipes/ByteString/Chunks.lhs @@ -0,0 +1,108 @@ +> -- | Module: Pipes.ByteString.Chunks +> -- Description: Chunked lazy bytestring pipes +> -- Copyright: © 2015 Patryk Zadarnowski +> -- License: BSD3 +> -- Maintainer: pat@jantar.org +> -- Stability: experimental +> -- Portability: portable +> -- +> -- When binary data is streamed through a pipe, it's often partitioned +> -- arbitrarily into /packets/ with no semantic significance, beyond +> -- facilitation of processing in constant space. This is similar to +> -- the chunking mechanism within lazy bytestrings, and, accordingly, +> -- it's often convenient to unify the two mechanisms, by converting +> -- between pipes over lazy bytestrings and pipes over strict chunks +> -- these bytestrings. This module provides efficient implementations +> -- of these conversions. + +> module Pipes.ByteString.Chunks ( +> toChunks, fromChunks +> ) where + +> import Data.ByteString (ByteString) +> import Data.Int +> import Pipes + +> import qualified Data.ByteString as ByteString +> import qualified Data.ByteString.Lazy as Lazy +> import qualified Pipes.Prelude as Pipes + +> -- | An infinite pipe that converts lazy bytestring +> -- input into strict bytestring chunk output. + +> toChunks :: Monad m => Pipe Lazy.ByteString ByteString m r +> toChunks = Pipes.map Lazy.toChunks >-> Pipes.concat + +> -- | An infinite pipe that converts strict bytestrings +> -- into lazy bytestrings with the specified minimum +> -- and maximum size, without copying any data. + +> fromChunks :: Monad m => Int64 -> Int64 -> Pipe ByteString Lazy.ByteString m r +> fromChunks m n +> | (m > n || n <= 0) = error ("fromChunks: invalid string size range: [" ++ show m ++ ".." ++ show n ++ "]") +> | (m <= 0) = fromMaxChunks n +> | (n >= fromIntegral (maxBound::Int)) = fromMinChunks m +> | (m == n) = fromExactChunks n +> | otherwise = loop m n [] +> where +> loop rm rn cs = do +> c <- await +> loop' rm rn cs c (fromIntegral (ByteString.length c)) +> loop' rm rn cs c cl = +> if cl == 0 then +> loop rm rn cs -- skip empty chunks +> else +> if cl < rm then +> loop (rm - cl) (rn - cl) (c:cs) +> else if cl <= rn then +> yield (Lazy.fromChunks (reverse (c:cs))) >> loop m n [] +> else +> let (c1, c2) = ByteString.splitAt (fromIntegral rn) c +> in yield (Lazy.fromChunks (reverse (c1:cs))) >> loop' m n [] c2 (cl - rn) + +> fromMaxChunks :: Monad m => Int64 -> Pipe ByteString Lazy.ByteString m r +> fromMaxChunks n +> | (n <= 0) = error ("Pipes.fromChunks: invalid maximum chunk size: " ++ show n) +> | (n >= fromIntegral (maxBound::Int)) = Pipes.map Lazy.fromStrict +> | otherwise = loop +> where +> loop = do +> c <- await +> loop' c (fromIntegral (ByteString.length c)) +> loop' c cl +> | (cl <= n) = yield (Lazy.fromStrict c) >> loop +> | otherwise = let (c1, c2) = ByteString.splitAt n' c in yield (Lazy.fromStrict c1) >> loop' c2 (cl - n) +> n' = fromIntegral n + +> fromMinChunks :: Monad m => Int64 -> Pipe ByteString Lazy.ByteString m r +> fromMinChunks n +> | (n > 0) = loop n [] +> | otherwise = Pipes.map Lazy.fromStrict +> where +> loop r cs = do +> c <- await +> loop' r cs c (fromIntegral (ByteString.length c)) +> loop' r cs c cl = +> if cl == 0 then +> loop r cs -- skip empty chunks +> else +> if cl < r then +> loop (r - cl) (c:cs) +> else +> yield (Lazy.fromChunks (reverse (c:cs))) >> loop 0 [] + +> fromExactChunks :: Monad m => Int64 -> Pipe ByteString Lazy.ByteString m r +> fromExactChunks n +> | (n > 0) = loop n [] +> | otherwise = error ("Pipes.fromChunks: invalid chunk size: " ++ show n) +> where +> loop r cs = do +> c <- await +> loop' r cs c (fromIntegral (ByteString.length c)) +> loop' r cs c cl = +> if cl == 0 then +> loop r cs -- skip empty chunks +> else case compare cl r of +> LT -> loop (r - cl) (c:cs) +> EQ -> yield (Lazy.fromChunks (reverse (c:cs))) >> loop 0 [] +> GT -> let (c1, c2) = ByteString.splitAt (fromIntegral r) c in yield (Lazy.fromChunks (reverse (c1:cs))) >> loop' 0 [] c2 (cl - r) diff --git a/src/Pipes/Cell.lhs b/src/Pipes/Cell.lhs new file mode 100644 --- /dev/null +++ b/src/Pipes/Cell.lhs @@ -0,0 +1,41 @@ +> -- | Module: Pipes.Cell +> -- Description: Convertions between cell-based and row-based representations of tabular data +> -- Copyright: © 2015 Patryk Zadarnowski +> -- License: BSD3 +> -- Maintainer: pat@jantar.org +> -- Stability: experimental +> -- Portability: portable +> -- +> -- Pipes converting between cellular and traditional tabular data. + +> module Pipes.Cell ( +> toRows, fromRows, +> ) where + +> import Control.Monad +> import Data.Cell +> import Pipes + +> -- | An infinite pipe that converts a stream of cells into a stream of rows, +> -- with each row represented by a non-empty list of cell values. + +> toRows :: (Monad m, Monoid a) => Pipe (Cell a) [a] m () +> toRows = go [] [] +> where +> go row cell = do +> Cell part d <- await +> let cell' = part:cell +> case d of +> EOP -> go row cell' +> EOC -> go (mconcat (reverse cell') : row) [] +> EOR -> yield (reverse (mconcat (reverse cell') : row)) >> go [] [] +> EOT -> yield (reverse (mconcat (reverse cell') : row)) >> return () + +> -- | An infinite pipe that converts a stream of rows to a stream of cells. + +> fromRows :: Monad m => Pipe [a] (Cell a) m r +> fromRows = forever (await >>= fromRow) +> where +> fromRow (x:xs) = yield (Cell x (if null xs then EOR else EOC)) >> fromRow xs +> fromRow [] = return () + diff --git a/src/Pipes/Either.lhs b/src/Pipes/Either.lhs new file mode 100644 --- /dev/null +++ b/src/Pipes/Either.lhs @@ -0,0 +1,45 @@ +> -- | Module: Pipes.Either +> -- Description: Utilities for conversion between finite and infinite pipes +> -- Copyright: © 2015 Patryk Zadarnowski +> -- License: BSD3 +> -- Maintainer: pat@jantar.org +> -- Stability: experimental +> -- Portability: portable +> -- +> -- Conversion between finite and infinite pipe using the 'Either' type. + +> module Pipes.Either ( +> catWhileLeft, catWhileRight, +> extendWithLeft, extendWithRight, +> ) where + +> import Control.Monad +> import Pipes.Core + +> -- | A pipe that receives and forwards all 'Left' values in its input +> -- up to the first occurence of a 'Right r' value, returning the value @r@. + +> catWhileLeft :: Monad m => Pipe (Either a r) a m r +> catWhileLeft = go +> where go = request () >>= either (respond >=> const go) return + +> -- | A pipe that receives and forwards all 'Right' values in its input +> -- up to the first occurence of a 'Left r' value, returning the value @r@. + +> catWhileRight :: Monad m => Pipe (Either r a) a m r +> catWhileRight = go +> where go = request () >>= either return (respond >=> const go) + +> -- | Converts a finite pipe into an infinite pipe, in which the original +> -- pipe's values are followed by an infinite stream of 'Left r'. + +> extendWithLeft :: Monad m => Pipe a b m r -> Pipe a (Either r b) m r' +> extendWithLeft p = (p //> respond . Right) >>= forever . respond . Left + +> -- | Converts a finite pipe into an infinite pipe, in which the original +> -- pipe's values are followed by an infinite stream of 'Right r'. + +> extendWithRight :: Monad m => Pipe a b m r -> Pipe a (Either b r) m r' +> extendWithRight p = (p //> respond . Left) >>= forever . respond . Right + + diff --git a/src/Pipes/Maybe.lhs b/src/Pipes/Maybe.lhs new file mode 100644 --- /dev/null +++ b/src/Pipes/Maybe.lhs @@ -0,0 +1,30 @@ +> -- | Module: Pipes.Maybe +> -- Description: Utilities for conversion between finite and infinite pipes +> -- Copyright: © 2015 Patryk Zadarnowski +> -- License: BSD3 +> -- Maintainer: pat@jantar.org +> -- Stability: experimental +> -- Portability: portable +> -- +> -- Conversion between finite and infinite pipe using the 'Either' type. + +> module Pipes.Maybe ( +> catWhileJust, extendWithNothing +> ) where + +> import Control.Monad +> import Pipes.Core + +> -- | A pipe that receives and forwards all 'Just' values in its input +> -- up to the first occurence of 'Nothing'. + +> catWhileJust :: Monad m => Pipe (Maybe a) a m () +> catWhileJust = go +> where go = request () >>= maybe (return ()) (respond >=> const go) + +> -- | Converts a finite pipe into an infinite pipe, in which the original +> -- pipe's values are followed by an infinite stream of 'Nothing'. + +> extendWithNothing :: Monad m => Pipe a b m r -> Pipe a (Maybe b) m r' +> extendWithNothing p = (p //> respond . Just) >> forever (respond Nothing) +