cassava-conduit (empty) → 0.0.1
raw patch · 7 files changed
+389/−0 lines, 7 filesdep +QuickCheckdep +arraydep +basebuild-type:Customsetup-changed
Dependencies added: QuickCheck, array, base, bifunctors, bytestring, cassava, cassava-conduit, conduit, conduit-extra, containers, criterion, mtl
Files
- Setup.hs +87/−0
- benchmarks/Main.hs +33/−0
- cassava-conduit.cabal +110/−0
- etc/LICENCE.md +20/−0
- quickcheck/Main.hs +11/−0
- src/Data/Csv/Conduit.hs +83/−0
- src/LocalPrelude.hs +45/−0
+ Setup.hs view
@@ -0,0 +1,87 @@+#!/usr/bin/env runhaskell+{-# OPTIONS_GHC -Wall #-}+module Main (main) where++import Data.List ( nub )+import Data.Maybe ( catMaybes )+import Data.Version ( showVersion )+import Control.Applicative+import Distribution.Package ( PackageName(PackageName), PackageId, InstalledPackageId, packageVersion, packageName )+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )+import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )+import Distribution.Simple.Compiler ( PackageDB(..), PackageDBStack )+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, findProgramVersion, currentDir )+import Distribution.Simple.BuildPaths ( autogenModulesDir )+import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag )+import Distribution.Simple.LocalBuildInfo ( withLibLBI, withPackageDB, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )+import Distribution.Verbosity ( Verbosity )+import Distribution.Version ( Version )+import System.Directory ( getDirectoryContents )+import System.FilePath ( (</>) )++main :: IO ()+main = defaultMainWithHooks simpleUserHooks+ { buildHook = \pkg lbi hooks flags -> do+ generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi+ buildHook simpleUserHooks pkg lbi hooks flags+ }++generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()+generateBuildModule verbosity pkg lbi = do+ let dir = autogenModulesDir lbi+ createDirectoryIfMissingVerbose verbosity True dir+ withLibLBI pkg lbi $ \_ libcfg ->+ withTestLBI pkg lbi $ \suite suitecfg -> do+ ghcOpts <-+ generateCabalDevOpts+ <$> isCabalDevPresent+ <*> getGhcVersion verbosity+ rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines+ [ "module Build_" ++ testName suite ++ " where"+ , "deps :: [String]"+ , "deps = " ++ show (formatdeps (testDeps libcfg suitecfg))+ , "opts :: [String]"+ , "opts = " ++ show ghcOpts+ , "specificPackageDBs :: [FilePath]"+ , "specificPackageDBs = " ++ show (getSpecificDBs (withPackageDB lbi))+ ]+ where+ formatdeps = map (formatone . snd)+ formatone p = case packageName p of+ PackageName n -> n ++ "-" ++ showVersion (packageVersion p)++getFilePath :: PackageDB -> Maybe FilePath+getFilePath GlobalPackageDB = Nothing+getFilePath UserPackageDB = Nothing+getFilePath (SpecificPackageDB fp) = Just fp++getSpecificDBs :: PackageDBStack -> [FilePath]+getSpecificDBs = catMaybes . fmap getFilePath+++isCabalDevPresent :: IO Bool+isCabalDevPresent = do+ contents <- getDirectoryContents currentDir+ return $ "cabal-dev" `elem` contents++getGhcVersion :: Verbosity -> IO (Maybe Version)+getGhcVersion verb = findProgramVersion+ "--version"+ (last . words)+ verb+ "ghc"++generateCabalDevOpts :: Bool -> Maybe Version -> [String]+generateCabalDevOpts isCabalDev version =+ case version of+ Nothing -> []+ Just version' ->+ let+ baseOpts = [ "-Lcabal-dev/lib"+ , "-package-conf=cabal-dev/packages-" ++ showVersion version' ++ ".conf"+ ]+ in+ if isCabalDev then baseOpts else []++testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]+testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys
+ benchmarks/Main.hs view
@@ -0,0 +1,33 @@+module Main ( main ) where++import Criterion.Main+ ( bench+ , bgroup+ , defaultMain+ , nf+ , whnf+ )+import Criterion.Types ( Pure )++-- | An example function to benchmark...+--+fib :: Int -> Int+fib 0 = 0+fib 1 = 0+fib n = fib (n - 1) + fib (n - 2)++main :: IO ()+main = defaultMain+ -- when benchmarking **pure** functions, use one of the following two functions to produce a Benchmark:+ -- @ nf :: (a -> b) -> a -> Pure @ evaluates the given expression with the given argument to normal form+ -- @ whnf :: (a -> b) -> a -> Pure @ evaluates the given expression with the given argument to weak head normal form+ -- you can group benchmarks together with `bgroup`, benchmarks groups can contain benchmarks groups also+ [ bgroup "Example Group 1"+ [ bench "fib 10 (Normal Form)" $ nf (const (fib 10)) ()+ , bench "fib 10 (Weak Head Normal Form)" $ whnf (const (fib 10)) ()+ ]+ , bgroup "Example Group 2"+ [ bench "fib 20 (Normal Form)" $ nf (const (fib 20)) ()+ , bench "fib 20 (Weak Head Normal Form)" $ whnf (const (fib 20)) ()+ ]+ ]
+ cassava-conduit.cabal view
@@ -0,0 +1,110 @@+name: cassava-conduit+version: 0.0.1+license: BSD3+license-file: etc/LICENCE.md+author: Dom De Re+maintainer: Dom De Re+copyright: Copyright (C) 2014+synopsis: Conduit interface for cassava package+category: Data+description: Conduit interface for cassava package+homepage: https://github.com/domdere/cassava-conduit/issues+bug-reports: https://github.com/domdere/cassava-conduit/issues+cabal-version: >= 1.18+build-type: Custom+--extra-source-files: etc/CONTRIBUTORS,+-- etc/CREDITS++source-repository head+ type: git+ location: https://github.com/domdere/cassava-conduit++flag small_base+ description: Choose the new, split-up base package.++library+ default-language: Haskell2010++ build-depends: base < 5 && >= 4+ , containers+ , array+ , bifunctors == 4.2.*+ , bytestring == 0.10.*+ , cassava == 0.4.*+ , conduit == 1.2.*+ , conduit-extra == 1.1.*+ , mtl == 2.2.*++ ghc-options: -Wall+ -fno-warn-unused-imports+ -fno-warn-unused-binds+ -fno-warn-unused-do-bind+ -fno-warn-type-defaults++ hs-source-dirs: src++ exposed-modules: Data.Csv.Conduit++ other-modules: LocalPrelude++ default-extensions: NoImplicitPrelude++-- doctests are disabled (there are not doctests in the code atm)+-- since the latest version of doctests doesnt support GHC 7.4 and 7.6+-- and I would like to maintain support for these versions for a while++--test-suite doctests+-- type:+-- exitcode-stdio-1.0+--+-- main-is:+-- Main.hs+--+-- default-language:+-- Haskell2010+--+-- build-depends:+-- base >= 4 && < 5+-- , doctest >= 0.9.11+-- , filepath >= 1.3+-- , directory >= 1.1+-- , QuickCheck >= 2.0+-- , template-haskell == 2.9.*+--+-- ghc-options:+-- -Wall+-- -threaded+--+-- hs-source-dirs:+-- doctests++test-suite quickcheck+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: quickcheck+ build-depends: base >= 4 && < 5+ , QuickCheck == 2.7.6+ , cassava-conduit+++-- HLint tests are disabled until the SCC tags dont cause parse errors in HLint++--test-suite hlint+-- default-language: Haskell2010+-- type: exitcode-stdio-1.0+-- main-is: Main.hs+-- hs-source-dirs: hlint+-- build-depends: base+-- , hlint == 1.9.*++benchmark benchmarks+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: benchmarks+ main-is: Main.hs+ ghc-options: -O2 -rtsopts++ build-depends: base > 4 && <= 5+ , cassava-conduit+ , criterion >= 0.8
+ etc/LICENCE.md view
@@ -0,0 +1,20 @@+# BSD 3-Clause License++Copyright (c) 2014 - 2015, Dom De Re+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 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 EVENT 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.
+ quickcheck/Main.hs view
@@ -0,0 +1,11 @@+module Main where++import Control.Monad++import System.Exit+import System.IO++main :: IO ()+main = hSetBuffering stdout LineBuffering >> mapM id+ [+ ] >>= \rs -> when (not . all id $ rs) exitFailure
+ src/Data/Csv/Conduit.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE FlexibleContexts #-}+-------------------------------------------------------------------+-- |+-- Module : Data.Csv.Conduit+-- Copyright : (C) 2014+-- License : BSD-style (see the file etc/LICENSE.md)+-- Maintainer : Dom De Re+--+-- Conduit interface for cassava+--+-------------------------------------------------------------------+module Data.Csv.Conduit (+ -- * Types+ CsvParseError(..)+ -- * Conduits+ , fromCsv+ , fromCsvStreamError+ , toCsv+ ) where++import LocalPrelude++import Control.Monad.Error.Class ( MonadError(..) )+import Data.Bifunctor ( first )+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import Data.Conduit ( Conduit, await, yield )+import Data.Conduit.List ( map, mapM )+import Data.Csv ( FromRecord(..), ToRecord(..), DecodeOptions, EncodeOptions, HasHeader, encodeWith )+import Data.Csv.Incremental ( Parser(..), decodeWith )+import Data.Foldable ( mapM_ )++data CsvParseError =+ CsvParseError BS.ByteString String+ | IncrementalError String++fromCsv :: (Show a, Monad m, FromRecord a, MonadError CsvParseError m) => DecodeOptions -> HasHeader -> Conduit BS.ByteString m a+fromCsv opts h = {-# SCC fromCsv_p #-} terminatingStreamParser $ decodeWith opts h++fromCsvStreamError :: (Monad m, FromRecord a) => DecodeOptions -> HasHeader -> Conduit BS.ByteString m (Either CsvParseError a)+fromCsvStreamError opts h = {-# SCC fromCsvStreamError_p #-} streamParser $ decodeWith opts h+++toCsv :: (Monad m, ToRecord a) => EncodeOptions -> Conduit a m BS.ByteString+toCsv opts = {-# SCC toCsv_p #-} map $ BSL.toStrict . encodeWith opts . pure++-- helpers++streamParser :: (Monad m) => Parser a -> Conduit BS.ByteString m (Either CsvParseError a)+streamParser (Fail rest errMsg) = yield $ Left $ CsvParseError rest errMsg+streamParser (Many rs p) = do+ -- send the results down the stream..+ mapM_ (yield . first IncrementalError) rs+ -- wait for more..+ more <- await+ maybe (return ()) (streamParser . p) more+streamParser (Done rs) = mapM_ (yield . first IncrementalError) rs++terminatingStreamParser+ :: (Show a, Monad m, MonadError CsvParseError m)+ => Parser a+ -> Conduit BS.ByteString m a+terminatingStreamParser (Fail rest errMsg) = {-# SCC terminatingStreamParser_Fail_p #-} mapM $ const $ throwError $ CsvParseError rest errMsg+terminatingStreamParser (Many ers p) = {-# SCC terminatingStreamParser_Many_p #-}+ let+ errorHandler :: (Monad m, MonadError CsvParseError m) => String -> Conduit BS.ByteString m a+ errorHandler = mapM . const . throwError . IncrementalError++ safeResultHandler+ :: (Show a, Monad m, MonadError CsvParseError m)+ => (BS.ByteString -> Parser a)+ -> (Parser a -> Conduit BS.ByteString m a)+ -> [a]+ -> Conduit BS.ByteString m a+ safeResultHandler p' f rs = do+ mapM_ yield rs+ -- wait for more..+ await >>= maybe (return ()) (f . p')+ in+ -- send the results down the stream..+ either errorHandler (safeResultHandler p terminatingStreamParser) (sequence ers)+terminatingStreamParser (Done rs) = {-# SCC terminatingStreamParser_Done_p #-} either (mapM . const . throwError . IncrementalError) (mapM_ yield) (sequence rs)+
+ src/LocalPrelude.hs view
@@ -0,0 +1,45 @@+-------------------------------------------------------------------+-- |+-- Module : LocalPrelude+-- Copyright : (C) 2014+-- License : BSD-style (see the file etc/LICENSE.md)+-- Maintainer : Dom De Re+--+-- The bits of the Prelude used in this project.+--+-------------------------------------------------------------------+module LocalPrelude (+ -- * Type Classes+ Functor(..)+ , Applicative(..)+ , Monad(..)+ , Num(..)+ , Show(..)+ , Eq(..)+ -- * Types+ , Char+ , Either(..)+ , Int+ , IO+ , Maybe(..)+ , String+ , Word8+ -- * Operators+ , (.)+ , ($)+ , ($!)+ , (<$>)+ , (++)+ -- * Functions+ , id+ , const+ , either+ , flip+ , fromIntegral+ , maybe+ , sequence+ ) where++import Prelude+import Control.Applicative+import Data.Word