pipes-key-value-csv 0.2.0.0 → 0.3.0.0
raw patch · 4 files changed
+116/−8 lines, 4 filesdep +bifunctorsdep +semigroupoidsdep −validationdep ~base
Dependencies added: bifunctors, semigroupoids
Dependencies removed: validation
Dependency ranges changed: base
Files
- pipes-key-value-csv.cabal +5/−3
- src/Data/Validation.hs +105/−0
- test/Test/Csv.hs +2/−2
- test/Test/KeyValue.hs +4/−3
pipes-key-value-csv.cabal view
@@ -1,5 +1,5 @@ name: pipes-key-value-csv -version: 0.2.0.0 +version: 0.3.0.0 synopsis: Streaming processing of CSV files preceded by key-value pairs. description: Nonstandard CSV files, with the table preceded by a header consisting of key-value pairs are often the output format of varius test equipment, such as digital oscilloscopes. homepage: https://github.com/marcinmrotek/key-value-csv @@ -35,7 +35,9 @@ , Pipes.KeyValueCsv.Internal.KeyValue , Pipes.KeyValueCsv.Internal.Names , Pipes.KeyValueCsv.Internal.Types + , Data.Validation build-depends: base >= 4.8 && < 5 + , bifunctors >= 5.3 && < 5.4 , containers >= 0.5.6 && < 0.6 , data-default-class >= 0.0.1 && < 0.2 , lens >= 4.12 && < 4.15 @@ -47,6 +49,7 @@ , pipes-safe >= 2.2 && < 2.3 , pipes-text >= 0.0 && < 0.1 , reflection >= 1.5 && < 2.2 + , semigroupoids >= 5.0.0 && < 5.1 , text >= 1.2 && < 1.3 , vinyl >= 0.5.2 && < 0.6 , vinyl-utils >= 0.2.0.1 && < 0.4 @@ -64,7 +67,7 @@ , Test.Instances , Test.KeyValue , Test.Types - build-depends: base >= 4.8 && < 4.9 + build-depends: base >= 4.8 && < 5 , contravariant >= 1.2 && < 1.5 , pipes-key-value-csv , data-default-class @@ -75,7 +78,6 @@ , reflection , text , transformers - , validation , vinyl , vinyl-utils hs-source-dirs: test
+ src/Data/Validation.hs view
@@ -0,0 +1,105 @@+{-|+Module : Data.Validation+Copyright : (c) Marcin Mrotek, 2016+License : BSD3+Maintainer : marcin.jan.mrotek@gmail.com+Stability : experimental++Accumulating Either-like type.+-}++{-# LANGUAGE + DeriveDataTypeable+ , DeriveFunctor+ , DeriveFoldable+ , DeriveGeneric + #-}++module Data.Validation (Validation(..)) where+ +import Control.Applicative+import Control.Lens+import Data.Bifunctor+import Data.Bifoldable+import Data.Bitraversable+import Data.Data+import Data.Functor.Alt+import Data.Semigroup+import GHC.Generics++data Validation e a = Success a | Failure e+ deriving (Show, Eq, Ord, Data, Functor, Foldable, Generic)++instance Semigroup e => Semigroup (Validation e a) where+ (<>) = app+ where+ app (Failure e1) (Failure e2) = Failure (e1 <> e2)+ app v@(Success _) _ = v+ app _ v@(Success _) = v+ +instance Monoid e => Monoid (Validation e a) where+ mempty = Failure mempty+ mappend = app+ where+ app (Failure e1) (Failure e2) = Failure (e1 `mappend` e2)+ app v@(Success _) _ = v+ app _ v@(Success _) = v+ +instance Semigroup e => Applicative (Validation e) where+ pure = Success+ (<*>) = app+ where+ app (Success f) (Success a) = Success (f a)+ app (Failure e) (Success _) = Failure e+ app (Success _) (Failure e) = Failure e+ app (Failure e1) (Failure e2) = Failure (e1 <> e2)+ +altValidation :: Validation e a -> Validation e a -> Validation e a+altValidation (Failure _) v = v+altValidation v@(Success _) _ = v++instance (Monoid e, Semigroup e) => Alternative (Validation e) where+ empty = Failure mempty+ (<|>) = altValidation+ +instance Semigroup e => Apply (Validation e) where+ (<.>) = (<*>)+ +instance Alt (Validation e) where+ (<!>) = altValidation++instance Traversable (Validation e) where+ traverse f v = + case v of+ Success a -> Success <$> f a+ Failure e -> pure $ Failure e+ +instance Swapped Validation where+ swapped = iso swap swap+ where+ swap (Success a) = Failure a+ swap (Failure e) = Success e+ +instance Bifunctor Validation where+ bimap f g v = + case v of+ Success a -> Success (g a)+ Failure e -> Failure (f e)+ first f v =+ case v of+ Success a -> Success a+ Failure e -> Failure (f e)+ second = fmap++instance Bifoldable Validation where+ bifoldMap f g v =+ case v of+ Success a -> g a+ Failure e -> f e+ +instance Bitraversable Validation where+ bitraverse f g v =+ case v of+ Success a -> Success <$> g a+ Failure e -> Failure <$> f e+
test/Test/Csv.hs view
@@ -36,7 +36,7 @@ prop_read :: [Rec Id TestFields] -> Property prop_read rs = map pure rs === useDelimiter delim parsed- & counterexample (concat. map Text.unpack $ Pipes.toList pipe)+ & counterexample (concatMap Text.unpack $ Pipes.toList pipe) where pipe :: Producer Text Transformers.Identity () pipe = @@ -45,7 +45,7 @@ . mconcat . intersperse (singleton '\n') $ map (buildDelimited delim) rs- parsed :: Given Delimiter => [AccValidation [CsvError] (Rec Id TestFields)]+ parsed :: Given Delimiter => [Validation [CsvError] (Rec Id TestFields)] parsed = map rtraverse1 . Pipes.toList
test/Test/KeyValue.hs view
@@ -3,6 +3,7 @@ , FlexibleContexts , OverloadedStrings , TemplateHaskell+ , PackageImports #-} module Test.KeyValue where@@ -15,6 +16,7 @@ import Pipes.KeyValueCsv.Common import Pipes.KeyValueCsv.KeyValue import Pipes.KeyValueCsv.Types+import Data.Validation import Control.Lens hiding (Const) import qualified Data.Functor.Identity as Transformers@@ -24,7 +26,6 @@ import qualified Data.Text as Text import Data.Text.Lazy.Builder import Data.Reflection-import Data.Validation import Data.Vinyl import Data.Vinyl.Functor import Data.Vinyl.Utils.Compose@@ -39,7 +40,7 @@ prop_read :: Rec Id TestFields -> Property prop_read r = pure r === useDelimiter delim parsed- & counterexample (concat. map Text.unpack $ Pipes.toList pipe)+ & counterexample (concatMap Text.unpack $ Pipes.toList pipe) where names :: Rec (Const Text) TestFields names = Const "foo" :& Const "bar" :& Const "baz" :& RNil@@ -52,7 +53,7 @@ . zipWith keyValue (map fromText $ recordToList names) $ build r keyValue k v = k <> singleton delim <> v- parsed :: Given Delimiter => AccValidation [KeyValueError] (Rec Id TestFields)+ parsed :: Given Delimiter => Validation [KeyValueError] (Rec Id TestFields) parsed = rtraverse1 . fst