packages feed

sv 0.1 → 1.0

raw patch · 35 files changed

+504/−3734 lines, 35 filesdep +Onlydep +cassavadep +hw-dsvdep −ansi-wl-pprintdep −charsetdep −containersdep ~contravariantdep ~hedgehogdep ~tasty

Dependencies added: Only, cassava, hw-dsv, sv-core

Dependencies removed: ansi-wl-pprint, charset, containers, deepseq, mtl, parsec, profunctors, readable, void

Dependency ranges changed: contravariant, hedgehog, tasty, tasty-hedgehog, trifecta

Files

changelog.md view
@@ -1,5 +1,10 @@ # Revision history for sv +## 1.0 -- 2018-07-19+* Split the package into sv, sv-core, svfactor. This removes Data.Sv.{Parse,Print,Syntax}+  and changes types in Data.Sv.Decode and Data.Sv.Encode.+  Compatibility with version 0.1 is minimal+ ## 0.1 -- 2018-03-06  * First version. Released on an unsuspecting world.
src/Data/Sv.hs view
@@ -19,57 +19,89 @@  module Data.Sv (   -- * Decoding-    decode-  , parseDecode-  , parseDecode'+    parseDecode   , parseDecodeFromFile-  , parseDecodeFromFile'+  , parseDecodeFromDsvCursor+  , decode   , decodeMay   , decodeEither   , decodeEither'   , (>>==)   , (==<<)+  , module Data.Sv.Parse   , module Data.Sv.Decode.Type   , module Data.Sv.Decode.Error -  -- * Parsing-  , module Data.Sv.Parse--  -- * Printing-  , module Data.Sv.Print-   -- * Encoding   , encode   , encodeToFile   , encodeToHandle   , encodeBuilder   , encodeRow-  , encodeSv   , module Data.Sv.Encode.Type   , module Data.Sv.Encode.Options -  -- * Core data types-  , module Data.Sv.Syntax+  -- * Structure+  , module Data.Sv.Structure -  -- * Re-exports from contravariant and semigroupoids+  -- * Re-exports from contravariant, validation, and semigroupoids   , Alt (..)   , Contravariant (..)   , Divisible (..)   , divided   , Decidable (..)   , chosen+  , Validation (..) ) where +import Control.Monad.IO.Class (MonadIO (liftIO))+import qualified Data.Attoparsec.ByteString.Lazy as AL+import Data.Bifunctor (Bifunctor (first))+import Data.ByteString (ByteString)+import qualified Data.ByteString.UTF8 as UTF8+import qualified Data.ByteString.Lazy as LBS+import HaskellWorks.Data.Dsv.Lazy.Cursor as DSV import Data.Functor.Alt (Alt (..)) import Data.Functor.Contravariant (Contravariant (..)) import Data.Functor.Contravariant.Divisible (Divisible (..), divided, Decidable (..), chosen)+import Data.Validation (Validation (..)) +import Data.Sv.Alien.Cassava (field) import Data.Sv.Decode import Data.Sv.Decode.Type import Data.Sv.Decode.Error import Data.Sv.Encode import Data.Sv.Encode.Options import Data.Sv.Encode.Type+import Data.Sv.Structure import Data.Sv.Parse-import Data.Sv.Print-import Data.Sv.Syntax++-- | Parse a 'ByteString' as an Sv, and then decode it with the given decoder.+parseDecode ::+  Decode' ByteString a+  -> ParseOptions+  -> LBS.ByteString+  -> DecodeValidation ByteString [a]+parseDecode d opts bs =+  let sep = _separator opts+      cursor = DSV.makeCursor sep bs+  in  parseDecodeFromDsvCursor d opts cursor++-- | Load a file, parse it, and decode it.+parseDecodeFromFile ::+  MonadIO m+  => Decode' ByteString a+  -> ParseOptions+  -> FilePath+  -> m (DecodeValidation ByteString [a])+parseDecodeFromFile d opts fp =+  parseDecode d opts <$> liftIO (LBS.readFile fp)++-- | Decode from a 'DsvCursor'+parseDecodeFromDsvCursor :: Decode' ByteString a -> ParseOptions -> DsvCursor -> DecodeValidation ByteString [a]+parseDecodeFromDsvCursor d opts cursor =+  let toField = Prelude.either badParse pure . parse+      parse = first UTF8.fromString . AL.eitherResult . AL.parse field+  in  flip bindValidation (decode d) . traverse (traverse toField) . DSV.toListVector $ case _headedness opts of+        Unheaded -> cursor+        Headed   -> nextPosition (nextRow cursor)
+ src/Data/Sv/Alien/Cassava.hs view
@@ -0,0 +1,114 @@+{-+Copyright (c)2012, Johan Tibell++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 Johan Tibell nor the names of other+      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+OWNER 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.+-}++module Data.Sv.Alien.Cassava (+  field+) where++import Data.ByteString.Builder (byteString, toLazyByteString, charUtf8)+import Data.Attoparsec.ByteString.Char8 (char)+import qualified Data.Attoparsec.ByteString as A+import qualified Data.Attoparsec.Lazy as AL+import qualified Data.Attoparsec.Zepto as Z+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.ByteString.Lazy (toStrict)+import qualified Data.ByteString.Unsafe as BS+import GHC.Word (Word8)++type Field = ByteString++doubleQuote, newline, cr :: Word8+doubleQuote = 34+newline = 10+cr = 13++-- | A strict version of 'Data.Functor.<$>' for monads.+(<$!>) :: Monad m => (a -> b) -> m a -> m b+f <$!> m = do+    a <- m+    return $! f a+{-# INLINE (<$!>) #-}++infixl 4 <$!>++-- | Parse a field. The field may be in either the escaped or+-- non-escaped format. The return value is unescaped.+field :: AL.Parser Field+field = do+    _ <- A.skipWhile (== 32) -- space+    mb <- A.peekWord8+    -- We purposely don't use <|> as we want to commit to the first+    -- choice if we see a double quote.+    case mb of+        Just b | b == doubleQuote -> escapedField+        _                         -> unescapedField+{-# INLINE field #-}++escapedField :: AL.Parser ByteString+escapedField = do+    _ <- dquote+    -- The scan state is 'True' if the previous character was a double+    -- quote.  We need to drop a trailing double quote left by scan.+    s <- BS.init <$> A.scan False (\s c -> if c == doubleQuote+                                           then Just (not s)+                                           else if s then Nothing+                                                else Just False)+    if doubleQuote `BS.elem` s+        then case Z.parse unescape s of+            Right r  -> return r+            Left err -> fail err+        else return s++unescapedField :: AL.Parser ByteString+unescapedField = A.takeWhile (\ c -> c /= doubleQuote &&+                                            c /= newline &&+                                            c /= cr)++dquote :: AL.Parser Char+dquote = char '"'++unescape :: Z.Parser ByteString+unescape = (toStrict . toLazyByteString) <$!> go mempty where+  go acc = do+    h <- Z.takeWhile (/= doubleQuote)+    let rest = do+          start <- Z.take 2+          if (BS.unsafeHead start == doubleQuote &&+              BS.unsafeIndex start 1 == doubleQuote)+              then go (acc `mappend` byteString h `mappend` charUtf8 '"')+              else fail "invalid CSV escape sequence"+    done <- Z.atEnd+    if done+      then return (acc `mappend` byteString h)+      else rest
src/Data/Sv/Decode.hs view
@@ -1,7 +1,3 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}- {-| Module      : Data.Sv.Decode Copyright   : (C) CSIRO 2017-2018@@ -11,7 +7,7 @@ Portability : non-portable  This module contains data structures, combinators, and primitives for-decoding an 'Sv' into a list of your Haskell datatype.+decoding a CSV into a list of your Haskell datatype.  A file can be read with 'parseDecodeFromFile'. If you already have the text data in memory, it can be decoded with 'parseDecode'.@@ -33,563 +29,7 @@ -}  module Data.Sv.Decode (-  -- * The types-  Decode (..)-, Decode'-, Validation (..)-, DecodeValidation-, DecodeError (..)-, DecodeErrors (..)--  -- * Running Decodes-, decode-, parseDecode-, parseDecode'-, parseDecodeFromFile-, parseDecodeFromFile'---- * Convenience constructors and functions-, decodeMay-, decodeEither-, decodeEither'-, mapErrors-, alterInput---- * Primitive Decodes--- ** Field-based-, contents-, untrimmed-, raw-, char-, byteString-, utf8-, lazyUtf8-, lazyByteString-, string-, int-, integer-, float-, double-, boolean-, boolean'-, ignore-, replace-, exactly-, emptyField--- ** Row-based-, row-, rowWithSpacing---- * Combinators-, choice-, element-, optionalField-, ignoreFailure-, orEmpty-, either-, orElse-, orElseE-, categorical-, categorical'-, (>>==)-, (==<<)-, bindDecode---- * Building Decodes from Readable-, decodeRead-, decodeRead'-, decodeReadWithMsg---- * Building Decodes from parsers-, withTrifecta-, withAttoparsec-, withParsec---- * Working with errors-, onError-, decodeError-, unexpectedEndOfRow-, expectedEndOfRow-, unknownCategoricalValue-, badParse-, badDecode-, validateEither-, validateEither'-, validateMaybe-, validateMaybe'---- * Implementation details-, runDecode-, buildDecode-, mkDecode-, mkDecodeWithQuotes-, mkDecodeWithSpaces-, promote+  module Data.Sv.Decode.Core ) where -import Prelude hiding (either)-import qualified Prelude--import Control.Lens (alaf, view)-import Control.Monad.IO.Class (MonadIO)-import Control.Monad.Reader (ReaderT (ReaderT))-import Control.Monad.State (state)-import Data.Attoparsec.ByteString (parseOnly)-import qualified Data.Attoparsec.ByteString as A (Parser)-import Data.Bifunctor (first, second)-import Data.ByteString (ByteString)-import qualified Data.ByteString.UTF8 as UTF8-import qualified Data.ByteString.Lazy as LBS-import Data.Char (toUpper)-import Data.Foldable (toList)-import Data.Functor.Alt (Alt ((<!>)))-import Data.Functor.Compose (Compose (Compose, getCompose))-import Data.List.NonEmpty (NonEmpty ((:|)))-import Data.Monoid (First (First))-import Data.Profunctor (lmap)-import Data.Readable (Readable (fromBS))-import Data.Semigroup (Semigroup ((<>)), sconcat)-import Data.Semigroup.Foldable (asum1)-import Data.Set (Set, fromList, member)-import Data.String (IsString (fromString))-import Data.Text (Text)-import Data.Text.Encoding (decodeUtf8')-import qualified Data.Text.Lazy as LT-import Data.Validation (_Validation)-import Data.Vector (Vector, (!))-import qualified Data.Vector as V-import Text.Parsec (Parsec)-import qualified Text.Parsec as P (parse)-import qualified Text.Trifecta as Tri--import Data.Sv.Decode.Error-import Data.Sv.Decode.Type-import qualified Data.Sv.Parse as P-import Data.Sv.Parse.Options (ParseOptions)-import Data.Sv.Syntax.Field (Field (Unquoted, Quoted), fieldContents, SpacedField, Spaced (Spaced))-import Data.Sv.Syntax.Record (Record, _fields)-import Data.Sv.Syntax.Sv (Sv, recordList)-import Text.Space (HorizontalSpace, Spaced (_value), spacedValue)---- | Decodes a sv into a list of its values using the provided 'Decode'-decode :: Decode' s a -> Sv s -> DecodeValidation s [a]-decode f = traverse (promote f) . recordList---- | Parse a 'ByteString' as an Sv, and then decode it with the given decoder.------ This version uses 'Text.Trifecta.Trifecta' to parse the 'ByteString', which is assumed to--- be UTF-8 encoded. If you want a different library, use 'parseDecode''.-parseDecode ::-  Decode' ByteString a-  -> ParseOptions ByteString-  -> ByteString-  -> DecodeValidation ByteString [a]-parseDecode = parseDecode' P.trifecta---- | Parse text as an Sv, and then decode it with the given decoder.------ This version lets you choose which parsing library to use by providing an--- 'P.SvParser'. Common selections are 'P.trifecta' and 'P.attoparsecByteString'.-parseDecode' ::-  P.SvParser s-  -> Decode' s a-  -> ParseOptions s-  -> s-  -> DecodeValidation s [a]-parseDecode' svp d opts s =-  Prelude.either badDecode pure (P.parseSv' svp opts s) `bindValidation` decode d---- | Load a file, parse it, and decode it.------ This version uses Trifecta to parse the file, which is assumed to be UTF-8--- encoded.-parseDecodeFromFile ::-  MonadIO m-  => Decode' ByteString a-  -> ParseOptions ByteString-  -> FilePath-  -> m (DecodeValidation ByteString [a])-parseDecodeFromFile = parseDecodeFromFile' P.trifecta---- | Load a file, parse it, and decode it.------ This version lets you choose which parsing library to use by providing an--- 'P.SvParser'. Common selections are 'P.trifecta' and 'P.attoparsecByteString'.-parseDecodeFromFile' ::-  MonadIO m-  => P.SvParser s-  -> Decode' s a-  -> ParseOptions s-  -> FilePath-  -> m (DecodeValidation s [a])-parseDecodeFromFile' svp d opts fp = do-  sv <- P.parseSvFromFile' svp opts fp-  pure (Prelude.either badDecode pure sv `bindValidation` decode d)---- | Build a 'Decode', given a function that returns 'Maybe'.------ Return the given error if the function returns 'Nothing'.-decodeMay :: DecodeError e -> (s -> Maybe a) -> Decode e s a-decodeMay e f = mkDecode (validateMaybe e . f)---- | Build a 'Decode', given a function that returns 'Either'.-decodeEither :: (s -> Either (DecodeError e) a) -> Decode e s a-decodeEither f = mkDecode (validateEither . f)---- | Build a 'Decode', given a function that returns 'Either', and a function to--- build the error.-decodeEither' :: (e -> DecodeError e') -> (s -> Either e a) -> Decode e' s a-decodeEither' e f = mkDecode (validateEither' e . f)---- | Succeeds with the whole field structure, including spacing and quoting information-raw :: Decode e s (SpacedField s)-raw = mkDecodeWithSpaces pure---- | Returns the field contents. This keeps the spacing around an unquoted field.-untrimmed :: Monoid s => (HorizontalSpace -> s) -> Decode e s s-untrimmed fromSpace =-  let sp = foldMap fromSpace-      spaceIfNecessary (Spaced b a f) = case f of-        Unquoted s -> mconcat [sp b, s, sp a]-        Quoted _ _ -> view fieldContents f-  in  fmap spaceIfNecessary raw---- | Get the contents of a field without doing any decoding. This never fails.-contents :: Decode e s s-contents = mkDecode pure---- | Grab the whole row as a 'Vector'-row :: Decode e s (Vector s)-row = (fmap . fmap) (view (spacedValue.fieldContents)) rowWithSpacing---- | Grab the whole row, including all spacing and quoting information,--- as a 'Vector'-rowWithSpacing :: Decode e s (Vector (SpacedField s))-rowWithSpacing =-  Decode . Compose . DecodeState . ReaderT $ \v ->-    state (const (pure v, Ind (V.length v)))---- | Get a field that's a single char. This will fail if there are mulitple--- characters in the field.-char :: Decode' ByteString Char-char = string >>== \cs -> case cs of-  [] -> badDecode "Expected single char but got empty string"-  (c:[]) -> pure c-  (_:_:_) -> badDecode ("Expected single char but got " <> UTF8.fromString cs)---- | Get the contents of a field as a bytestring.------ Alias for 'contents'-byteString :: Decode' ByteString ByteString-byteString = contents---- | Get the contents of a UTF-8 encoded field as 'Text'------ This will also work for ASCII text, as ASCII is a subset of UTF-8-utf8 :: Decode' ByteString Text-utf8 = contents >>==-  Prelude.either (badDecode . UTF8.fromString . show) pure . decodeUtf8'---- | Get the contents of a field as a lazy 'Data.Text.Lazy.Text'-lazyUtf8 :: Decode' ByteString LT.Text-lazyUtf8 = LT.fromStrict <$> utf8---- | Get the contents of a field as a lazy 'Data.ByteString.Lazy.ByteString'-lazyByteString :: Decode' ByteString LBS.ByteString-lazyByteString = LBS.fromStrict <$> contents---- | Get the contents of a field as a 'String'-string :: Decode' ByteString String-string = UTF8.toString <$> contents---- | Throw away the contents of a field. This is useful for skipping unneeded fields.-ignore :: Decode e s ()-ignore = replace ()---- | Throw away the contents of a field, and return the given value.-replace :: a -> Decode e s a-replace a = a <$ contents---- | Decode exactly the given string, or else fail.-exactly :: (Semigroup s, Eq s, IsString s) => s -> Decode' s s-exactly s = contents >>== \z ->-  if s == z-  then pure s-  else badDecode (sconcat ("'":|[z,"' was not equal to '",s,"'"]))---- | Decode a UTF-8 'ByteString' field as an 'Int'-int :: Decode' ByteString Int-int = named "int"---- | Decode a UTF-8 'ByteString' field as an 'Integer'-integer :: Decode' ByteString Integer-integer = named "integer"---- | Decode a UTF-8 'ByteString' field as a 'Float'-float :: Decode' ByteString Float-float = named "float"---- | Decode a UTF-8 'ByteString' field as a 'Double'-double :: Decode' ByteString Double-double = named "double"---- | Decode a field as a 'Bool'------ This aims to be tolerant to different forms a boolean might take.-boolean :: (IsString s, Ord s) => Decode' s Bool-boolean = boolean' fromString---- | Decode a field as a 'Bool'. This version lets you provide the fromString--- function that's right for you, since 'Data.String.IsString' on a--- 'Data.ByteString.ByteString' will do the wrong thing in the case of many--- encodings such as UTF-16 or UTF-32.------ This aims to be tolerant to different forms a boolean might take.-boolean' :: Ord s => (String -> s) -> Decode' s Bool-boolean' s =-  categorical' [-    (False, fmap s ["false", "False", "FALSE", "f", "F", "0", "n", "N", "no", "No", "NO", "off", "Off", "OFF"])-  , (True, fmap s ["true", "True", "TRUE", "t", "T", "1", "y", "Y", "yes", "Yes", "YES", "on", "On", "ON"])-  ]---- | Succeed only when the given field is the empty string.------ The empty string surrounded in quotes or spaces is still the empty string.-emptyField :: (Eq s, IsString s, Semigroup s) => Decode' s ()-emptyField = contents >>== \c ->-  if c == fromString "" then-    pure ()-  else-    badDecode ("Expected emptiness but got: " <> c)---- | Choose the leftmost 'Decode' that succeeds. Alias for '<!>'-choice :: Decode e s a -> Decode e s a -> Decode e s a-choice = (<!>)---- | Choose the leftmost 'Decode' that succeeds. Alias for 'asum1'-element :: NonEmpty (Decode e s a) -> Decode e s a-element = asum1---- | Try the given 'Decode'. If it fails, instead succeed with 'Nothing'.-ignoreFailure :: Decode e s a -> Decode e s (Maybe a)-ignoreFailure a = Just <$> a <!> Nothing <$ ignore---- | If the field is the empty string, succeed with 'Nothing'.--- Otherwise try the given 'Decode'.-orEmpty :: (Eq s, IsString s, Semigroup s) => Decode' s a -> Decode' s (Maybe a)-orEmpty a = Nothing <$ emptyField <!> Just <$> a---- | Try the given 'Decode'. If it fails, succeed without consuming anything.------ This usually isn't what you want. 'ignoreFailure' and 'orEmpty' are more--- likely what you are after.-optionalField :: Decode e s a -> Decode e s (Maybe a)-optionalField a = Just <$> a <!> pure Nothing---- | Try the first, then try the second, and wrap the winner in an 'Either'.------ This is left-biased, meaning if they both succeed, left wins.-either :: Decode e s a -> Decode e s b -> Decode e s (Either a b)-either a b = fmap Left a <!> fmap Right b---- | Try the given decoder, otherwise succeed with the given value.-orElse :: Decode e s a -> a -> Decode e s a-orElse f a = f <!> replace a---- | Try the given decoder, or if it fails succeed with the given value, in an 'Either'.-orElseE :: Decode e s b -> a -> Decode e s (Either a b)-orElseE b a = fmap Right b <!> replace (Left a)---- | Decode categorical data, given a list of the values and the strings which match them.------ Usually this is used with sum types with nullary constructors.------ > data TrafficLight = Red | Amber | Green--- > categorical [(Red, "red"), (Amber, "amber"), (Green, "green")]-categorical :: (Ord s, Show a) => [(a, s)] -> Decode' s a-categorical = categorical' . fmap (fmap pure)---- | Decode categorical data, given a list of the values and lists of strings--- which match them.------ This version allows for multiple strings to match each value, which is--- useful for when the categories are inconsistently labelled.------ > data TrafficLight = Red | Amber | Green--- > categorical' [(Red, ["red", "R"]), (Amber, ["amber", "orange", "A"]), (Green, ["green", "G"])]------ For another example of its usage, see the source for 'boolean'.-categorical' :: forall s a . (Ord s, Show a) => [(a, [s])] -> Decode' s a-categorical' as =-  let as' :: [(a, Set s)]-      as' = fmap (second fromList) as-      go :: s -> (a, Set s) -> Maybe a-      go s (a, set) =-        if s `member` set-        then Just a-        else Nothing-  in  contents >>== \s ->-    validateMaybe (UnknownCategoricalValue s (fmap snd as)) $-      alaf First foldMap (go s) as'---- | Use the 'Readable' instance to try to decode the given value.-decodeRead :: Readable a => Decode' ByteString a-decodeRead = decodeReadWithMsg (mappend "Couldn't parse ")---- | Use the 'Readable' instance to try to decode the given value,--- or fail with the given error message.-decodeRead' :: Readable a => ByteString -> Decode' ByteString a-decodeRead' e = decodeReadWithMsg (const e)---- | Use the 'Readable' instance to try to decode the given value,--- or use the value to build an error message.-decodeReadWithMsg :: Readable a => (ByteString -> e) -> Decode e ByteString a-decodeReadWithMsg e = contents >>== \c ->-  maybe (badDecode (e c)) pure . fromBS $ c---- | Given the name of a type, try to decode it using 'Readable', -named :: Readable a => ByteString -> Decode' ByteString a-named name =-  let vs' = ['a','e','i','o','u']-      vs  = fmap toUpper vs' ++ vs'-      n c = if c `elem` vs then "n" else ""-      n' = foldMap (n . fst) . UTF8.uncons-      n'' = n' name-      space = " "-  in  decodeReadWithMsg $ \bs ->-        mconcat ["Couldn't parse \"", bs, "\" as a", n'', space, name]---- | Map over the errors of a 'Decode'------ To map over the other two parameters, use the 'Data.Profunctor.Profunctor' instance.-mapErrors :: (e -> x) -> Decode e s a -> Decode x s a-mapErrors f (Decode (Compose r)) = Decode (Compose (fmap (first (fmap f)) r))---- | This transforms a @Decode' s a@ into a @Decode' t a@. It needs--- functions in both directions because the errors can include fragments of the--- input.------ @alterInput :: (s -> t) -> (t -> s) -> Decode' s a -> Decode' t a@-alterInput :: (e -> x) -> (t -> s) -> Decode e s a -> Decode x t a-alterInput f g = mapErrors f . lmap g------ Promoting parsers to 'Decode's---- | Build a 'Decode' from a Trifecta parser-withTrifecta :: Tri.Parser a -> Decode' ByteString a-withTrifecta =-  mkParserFunction-    (validateTrifectaResult (BadDecode . UTF8.fromString))-    (flip Tri.parseByteString mempty)---- | Build a 'Decode' from an Attoparsec parser-withAttoparsec :: A.Parser a -> Decode' ByteString a-withAttoparsec =-  mkParserFunction-    (validateEither' (BadDecode . fromString))-    parseOnly---- | Build a 'Decode' from a Parsec parser-withParsec :: Parsec ByteString () a -> Decode' ByteString a-withParsec =-  -- Parsec will include a position, but it will only confuse the user-  -- since it won't correspond obviously to a position in their source file.-  let dropPos = drop 1 . dropWhile (/= ':')-  in  mkParserFunction-    (validateEither' (BadDecode . UTF8.fromString . dropPos . show))-    (\p s -> P.parse p mempty s)--mkParserFunction ::-  Tri.CharParsing p-  => (f a -> DecodeValidation ByteString a)-  -> (p a -> ByteString -> f a)-  -> p a-  -> Decode' ByteString a-mkParserFunction err run p =-  let p' = p <* Tri.eof-  in  byteString >>== (err . run p')-{-# INLINE mkParserFunction #-}---- | Convenience to get the underlying function out of a Decode in a useful form-runDecode :: Decode e s a -> Vector (SpacedField s) -> Ind -> (DecodeValidation e a, Ind)-runDecode = runDecodeState . getCompose . unwrapDecode-{-# INLINE runDecode #-}---- | This can be used to build a 'Decode' whose value depends on the--- result of another 'Decode'. This is especially useful since 'Decode' is not--- a 'Monad'.------ If you need something like this but with more power, look at 'bindDecode'-(>>==) :: Decode e s a -> (a -> DecodeValidation e b) -> Decode e s b-(>>==) = flip (==<<)-infixl 1 >>==-{-# INLINE (>>==) #-}---- | flipped '>>=='-(==<<) :: (a -> DecodeValidation e b) -> Decode e s a -> Decode e s b-(==<<) f (Decode c) =-  Decode (rmapC (`bindValidation` (view _Validation . f)) c)-    where-      rmapC g (Compose fga) = Compose (fmap g fga)-infixr 1 ==<<---- | Bind through a 'Decode'.------ This bind does not agree with the 'Applicative' instance because it does--- not accumulate multiple error values. This is a violation of the 'Monad'--- laws, meaning 'Decode' is not a 'Monad'.------ That is not to say that there is anything wrong with using this function.--- It can be quite useful.-bindDecode :: Decode e s a -> (a -> Decode e s b) -> Decode e s b-bindDecode d f =-  buildDecode $ \v i ->-    case runDecode d v i of-      (Failure e, i') -> (Failure e, i')-      (Success a, i') -> runDecode (f a) v i'---- | Run a 'Decode', and based on its errors build a new 'Decode'.-onError :: Decode e s a -> (DecodeErrors e -> Decode e s a) -> Decode e s a-onError d f =-  buildDecode $ \v i ->-    case runDecode d v i of-      (Failure e, i') -> runDecode (f e) v i'-      (Success a, i') -> (Success a, i')---- | Build a 'Decode' from a function.------ This version gives you just the contents of the field, with no information--- about the spacing or quoting around that field.-mkDecode :: (s -> DecodeValidation e a) -> Decode e s a-mkDecode f = mkDecodeWithQuotes (f . view fieldContents)---- | Build a 'Decode' from a function.------ This version gives you access to the whole 'Field', which includes--- information about whether quotes were used, and if so which ones.-mkDecodeWithQuotes :: (Field s -> DecodeValidation e a) -> Decode e s a-mkDecodeWithQuotes f = mkDecodeWithSpaces (f . _value)---- | Build a 'Decode' from a function.------ This version gives you access to the whole 'SpacedField', which includes--- information about spacing both before and after the field, and about quotes--- if they were used.-mkDecodeWithSpaces :: (SpacedField s -> DecodeValidation e a) -> Decode e s a-mkDecodeWithSpaces f =-  Decode . Compose . DecodeState . ReaderT $ \v -> state $ \(Ind i) ->-    if i >= length v-    then (unexpectedEndOfRow, Ind i)-    else (f (v ! i), Ind (i+1))---- | promotes a Decode to work on a whole 'Record' at once. This does not need--- to be called by the user. Instead use 'decode'.-promote :: Decode' s a -> Record s -> DecodeValidation s a-promote dec rs =-  let vec = V.fromList . toList . _fields $ rs-      len = length vec-  in  case runDecode dec vec (Ind 0) of-    (d, Ind i) ->-      if i >= len-      then d-      else d *> expectedEndOfRow (V.force (V.drop i vec))+import Data.Sv.Decode.Core
− src/Data/Sv/Decode/Error.hs 
@@ -1,99 +0,0 @@-{-|-Module      : Data.Sv.Decode.Error-Copyright   : (C) CSIRO 2017-2018-License     : BSD3-Maintainer  : George Wilson <george.wilson@data61.csiro.au>-Stability   : experimental-Portability : non-portable--}--module Data.Sv.Decode.Error (-  DecodeError (..)-, DecodeErrors (..)---- * Convenience constructors-, decodeError-, unexpectedEndOfRow-, expectedEndOfRow-, unknownCategoricalValue-, badParse-, badDecode---- * Conversions-, validateEither-, validateEither'-, validateMaybe-, validateMaybe'-, trifectaResultToEither-, validateTrifectaResult---- * Re-exports from @validation@-, bindValidation-) where--import Data.Validation (Validation (Failure), bindValidation)-import Data.Vector (Vector)-import qualified Text.Trifecta as Trifecta (Result (Success, Failure), _errDoc)--import Data.Sv.Decode.Type-import Data.Sv.Syntax.Field---- | Build a failing 'DecodeValidation'-decodeError :: DecodeError e -> DecodeValidation e a-decodeError = Failure . DecodeErrors . pure---- | Fail with 'UnexpectedEndOfRow'-unexpectedEndOfRow :: DecodeValidation e a-unexpectedEndOfRow = decodeError UnexpectedEndOfRow---- | Fail with 'ExpectedEndOfRow'. This takes the rest of the row, so that it--- can be displayed to the user.-expectedEndOfRow :: Vector (SpacedField e) -> DecodeValidation e a-expectedEndOfRow = decodeError . ExpectedEndOfRow---- | Fail with 'UnknownCategoricalValue'.--- It takes the unknown value and the list of good categorical values.------ This mostly exists to be used by the 'Data.Sv.Decode.categorical' function.-unknownCategoricalValue :: e -> [[e]] -> DecodeValidation e a-unknownCategoricalValue unknown valids =-  decodeError (UnknownCategoricalValue unknown valids)---- | Fail with 'BadParse' with the given message. This is for when the parse--- step fails, and decoding does not even begin.-badParse :: e -> DecodeValidation e a-badParse = decodeError . BadParse---- | Fail with 'BadDecode' with the given message. This is something of a--- generic error for when decoding a field goes wrong.-badDecode :: e -> DecodeValidation e a-badDecode = decodeError . BadDecode---- | Build a 'DecodeValidation' from an 'Either'-validateEither :: Either (DecodeError e) a -> DecodeValidation e a-validateEither = validateEither' id---- | Build a 'DecodeValidation' from an 'Either', given a function to build the error.-validateEither' :: (e -> DecodeError e') -> Either e a -> DecodeValidation e' a-validateEither' f = either (decodeError . f) pure---- | Build a 'DecodeValidation' from a 'Maybe'. You have to supply an error--- to use in the 'Nothing' case-validateMaybe :: DecodeError e -> Maybe b -> DecodeValidation e b-validateMaybe e = maybe (decodeError e) pure---- | Build a 'DecodeValidation' from a function that returns a 'Maybe'--- You have to supply an error to use in the 'Nothing' case-validateMaybe' :: (a -> Maybe b) -> DecodeError e -> a -> DecodeValidation e b-validateMaybe' ab e a = validateMaybe e (ab a)---- | Helper to convert "Text.Trifecta" 'Text.Trifecta.Result' to 'Either'.-trifectaResultToEither :: Trifecta.Result a -> Either String a-trifectaResultToEither result = case result of-  Trifecta.Success a -> Right a-  Trifecta.Failure e -> Left . show . Trifecta._errDoc $ e---- | Convert a "Text.Trifecta" 'Text.Trifecta.Result' to a 'DecodeValidation'-validateTrifectaResult :: (String -> DecodeError e) -> Trifecta.Result a -> DecodeValidation e a-validateTrifectaResult f = validateEither' f . trifectaResultToEither-
− src/Data/Sv/Decode/Type.hs 
@@ -1,146 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE TupleSections #-}--{-|-Module      : Data.Sv.Decode.Type-Copyright   : (C) CSIRO 2017-2018-License     : BSD3-Maintainer  : George Wilson <george.wilson@data61.csiro.au>-Stability   : experimental-Portability : non-portable--}--module Data.Sv.Decode.Type (-  Decode (..)-, Decode'-, buildDecode-, DecodeState (..)-, runDecodeState-, Ind (..)-, DecodeError (..)-, DecodeErrors (..)-, DecodeValidation-, Validation (..)-) where--import Control.DeepSeq (NFData)-import Control.Monad.Reader (ReaderT (ReaderT, runReaderT), MonadReader, withReaderT)-import Control.Monad.State (State, runState, state, MonadState)-import Data.Functor.Alt (Alt ((<!>)))-import Data.Functor.Apply (Apply)-import Data.Functor.Bind (Bind ((>>-)))-import Data.Functor.Compose (Compose (Compose))-import Data.List.NonEmpty-import Data.Semigroup-import Data.Profunctor (Profunctor (lmap, rmap))-import Data.Validation (Validation (Success, Failure))-import Data.Vector (Vector)-import GHC.Generics (Generic)--import Data.Sv.Syntax.Field (SpacedField)---- | A 'Decode e s a' is for decoding some fields from a CSV row into our type 'a'.------ The second type parameter (@s@) is the input string type--- (usually 'ByteString' or 'Text').--- The first type parameter (@e@) is the type of strings which occur in errors.--- Under most circumstances you want these type paraters to coincide, but they--- don't have to. They are two separate type parameters instead of one so that--- 'Decode' can have a 'Data.Profunctor.Profunctor' instance.------ There are primitive 'Decode's, and combinators for composing or--- otherwise manipulating them. In particular, 'Decode' is an--- 'Applicative' functor and an 'Alt' from the semigroupoids package.------ 'Decode' is not a 'Monad', but we can perform monad-like operations on--- it with 'Data.Sv.Decode.Field.>>==' and 'Data.Sv.Decode.bindDecode'-newtype Decode e s a =-  Decode { unwrapDecode :: Compose (DecodeState s) (DecodeValidation e) a }-  deriving (Functor, Apply, Applicative)---- | 'Decode'' is 'Decode' with the input and error types the same. You usually--- want them to be the same, and most primitives are set up this way.-type Decode' s = Decode s s--instance Alt (Decode e s) where-  Decode (Compose as) <!> Decode (Compose bs) =-    buildDecode $ \v i ->-      case runDecodeState as v i of-        (a, j) -> case runDecodeState bs v i of-          (b, k) ->-            let a' = fmap (,j) a-                b' = fmap (,k) b-            in  case a' <!> b' of-                  Failure e -> (Failure e, k)-                  Success (z, m) -> (Success z, m)--instance Profunctor (Decode e) where-  lmap f (Decode (Compose dec)) = Decode (Compose (lmap f dec))-  rmap = fmap---- | As we decode a row of data, we walk through its 'Data.Sv.Syntax.Field's. This 'Monad'--- keeps track of our remaining 'Data.Sv.Syntax.Field's.-newtype DecodeState s a =-  DecodeState { getDecodeState :: ReaderT (Vector (SpacedField s)) (State Ind) a }-  deriving (Functor, Apply, Applicative, Monad, MonadReader (Vector (SpacedField s)), MonadState Ind)--instance Bind (DecodeState s) where-  (>>-) = (>>=)--instance Profunctor DecodeState where-  lmap f (DecodeState s) = DecodeState (withReaderT (fmap (fmap (fmap f))) s)-  rmap = fmap---- | Convenient constructor for 'Decode' that handles all the newtype noise for you.-buildDecode :: (Vector (SpacedField s) -> Ind -> (DecodeValidation e a, Ind)) -> Decode e s a-buildDecode f = Decode . Compose . DecodeState . ReaderT $ \v -> state $ \i -> f v i---- | Convenient function to run a DecodeState-runDecodeState :: DecodeState s a -> Vector (SpacedField s) -> Ind -> (a, Ind)-runDecodeState = fmap runState . runReaderT . getDecodeState---- | Newtype for indices into the field vector-newtype Ind = Ind Int---- | 'DecodeError' is a value indicating what went wrong during a parse or--- decode. Its constructor indictates the type of error which occured, and--- there is usually an associated string with more finely-grained details.-data DecodeError e =-  -- | I was looking for another field, but I am at the end of the row-  UnexpectedEndOfRow-  -- | I should be at the end of the row, but I found extra fields-  | ExpectedEndOfRow (Vector (SpacedField e))-  -- | This decoder was built using the 'categorical' primitive for categorical data-  | UnknownCategoricalValue e [[e]]-  -- | The parser failed, meaning decoding proper didn't even begin-  | BadParse e-  -- | Some other kind of decoding failure occured-  | BadDecode e-  deriving (Eq, Ord, Show, Generic)--instance Functor DecodeError where-  fmap f d = case d of-    UnexpectedEndOfRow -> UnexpectedEndOfRow-    ExpectedEndOfRow v -> ExpectedEndOfRow (fmap (fmap (fmap f)) v)-    UnknownCategoricalValue e ess -> UnknownCategoricalValue (f e) (fmap (fmap f) ess)-    BadParse e -> BadParse (f e)-    BadDecode e -> BadDecode (f e)--instance NFData e => NFData (DecodeError e)---- | 'DecodeErrors' is a 'Semigroup' full of 'DecodeError'. It is used as the--- error side of a 'DecodeValidation'. When multiple errors occur, they will--- be collected.-newtype DecodeErrors e =-  DecodeErrors (NonEmpty (DecodeError e))-  deriving (Eq, Ord, Show, Semigroup, Generic)--instance Functor DecodeErrors where-  fmap f (DecodeErrors nel) = DecodeErrors (fmap (fmap f) nel)--instance NFData e => NFData (DecodeErrors e)---- | 'DecodeValidation' is the error-accumulating 'Applicative' underlying--- 'Decode'-type DecodeValidation e = Validation (DecodeErrors e)
src/Data/Sv/Encode.hs view
@@ -1,6 +1,3 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE OverloadedStrings #-}- {-| Module      : Data.Sv.Encode Copyright   : (C) CSIRO 2017-2018@@ -8,428 +5,10 @@ Maintainer  : George Wilson <george.wilson@data61.csiro.au> Stability   : experimental Portability : non-portable--This module is intended to be imported qualified as follows--@import Data.Sv.Encode as E@--To produce a CSV file from data types, build an 'Encode' for your data-type. This module contains primitives, combinators, and type class instances-to help you to do so.--'Encode' is a 'Contravariant' functor, as well as a 'Divisible' and-'Decidable'. 'Divisible' is the contravariant form of 'Applicative',-while 'Decidable' is the contravariant form of 'Control.Applicative.Alternative'.-These type classes will provide useful combinators for working with 'Encode's.--Specialised to 'Encode', the function 'Data.Functor.Contravariant.Divisible.divide'-from 'Divisible' has the type:--@-divide :: (a -> (b,c)) -> Encode b -> Encode c -> Encode a-@--which can be read "if 'a' can be split into 'b' and 'c', and I can handle-'b', and I can handle 'c', then I can handle 'a'".--Here the "I can handle"-part corresponds to the 'Encode'. If we think of (covariant) functors as-being "full of" 'a', then we can think of contravariant functors as being-"able to handle" 'a'.--How does it work? Perform the split on the 'a', handle the 'b' by converting-it into some text,-handle the 'c' by also converting it to some text, then put each of those-text fragments into their own field in the CSV.--Similarly, the function 'Data.Functor.Contravariant.Divisible.choose'-from 'Decidable', specialsed to 'Encode', has the type:--@-choose :: (a -> Either b c) -> Encode b -> Encode c -> Encode a-@--which can be read "if 'a' is either 'b' or 'c', and I can handle 'b',-and I can handle 'c', then I can handle 'a'".--This works by performing the split, then checking whether 'b' or 'c' resulted,-then using the appropriate 'Encode'.--For an example of encoding, see-<https://github.com/qfpl/sv/blob/master/examples/src/Data/Sv/Example/Encoding.hs Encoding.hs> -}  module Data.Sv.Encode (-  Encode (..)---- * Convenience constructors-, mkEncodeBS-, mkEncodeWithOpts-, unsafeBuilder---- * Running an Encode-, encode-, encodeToHandle-, encodeToFile-, encodeBuilder-, encodeRow-, encodeRowBuilder-, encodeSv---- * Options-, module Data.Sv.Encode.Options---- * Primitive encodes--- ** Field-based-, const-, show-, nop-, empty-, orEmpty-, char-, int-, integer-, float-, double-, boolTrueFalse-, booltruefalse-, boolyesno-, boolYesNo-, boolYN-, bool10-, string-, text-, byteString-, lazyByteString--- ** Row-based-, row---- * Combinators-, (?>)-, (<?)-, (?>>)-, (<<?)-, encodeOf-, encodeOfMay---- * Unsafe encodes-, unsafeString-, unsafeText-, unsafeByteString-, unsafeLazyByteString-, unsafeByteStringBuilder-, unsafeConst+  module Data.Sv.Encode.Core ) where -import qualified Prelude as P-import Prelude hiding (const, show)--import Control.Applicative ((<$>), (<**>))-import Control.Lens (Getting, preview, review, view)-import Control.Monad (join)-import qualified Data.Bool as B (bool)-import qualified Data.ByteString as Strict-import qualified Data.ByteString.Builder as BS-import qualified Data.ByteString.Lazy as LBS-import Data.Foldable (fold, foldMap, toList)-import Data.Functor.Contravariant (Contravariant (contramap))-import Data.Functor.Contravariant.Divisible (Divisible (conquer), Decidable (choose))-import Data.List.NonEmpty (NonEmpty, nonEmpty)-import Data.Monoid (Monoid (mempty), First, (<>), mconcat)-import Data.Sequence (Seq, ViewL (EmptyL, (:<)), viewl, (<|))-import qualified Data.Sequence as Seq-import qualified Data.Sequence as S (singleton, empty)-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import System.IO (BufferMode (BlockBuffering), Handle, hClose, hSetBinaryMode, hSetBuffering, openFile, IOMode (WriteMode))--import Data.Sv.Encode.Options (EncodeOptions (..), HasEncodeOptions (..), HasSeparator (..), defaultEncodeOptions)-import Data.Sv.Encode.Type (Encode (Encode, getEncode))-import Data.Sv.Syntax.Field (Field (Unquoted), SpacedField, unescapedField)-import Data.Sv.Syntax.Record (Record (Record), Records (EmptyRecords), emptyRecord, mkRecords, recordNel)-import Data.Sv.Syntax.Sv (Sv (Sv), Header (Header))-import qualified Data.Vector.NonEmpty as V-import Text.Escape (Escaper, Escaper', Unescaped (Unescaped), escapeChar, escapeString, escapeText, escapeUtf8, escapeUtf8Lazy)-import Text.Newline (newlineToString)-import Text.Space (Spaced (Spaced), spacesString)-import Text.Quote (quoteChar)---- | Make an 'Encode' from a function that builds one 'Field'.-mkEncodeBS :: (a -> LBS.ByteString) -> Encode a-mkEncodeBS = unsafeBuilder . fmap BS.lazyByteString---- | Make an 'Encode' from a function that builds one 'Field'.-mkEncodeWithOpts :: (EncodeOptions -> a -> BS.Builder) -> Encode a-mkEncodeWithOpts = Encode . fmap (fmap pure)---- | Make an encode from any function that returns a ByteString 'Builder'.-unsafeBuilder :: (a -> BS.Builder) -> Encode a-unsafeBuilder b = Encode (\_ a -> pure (b a))-{-# INLINE unsafeBuilder #-}---- | Encode the given list with the given 'Encode', configured by the given--- 'EncodeOptions'.-encode :: Encode a -> EncodeOptions -> [a] -> LBS.ByteString-encode enc opts = BS.toLazyByteString . encodeBuilder enc opts---- | Encode, writing the output to a file handle.-encodeToHandle :: Encode a -> EncodeOptions -> [a] -> Handle -> IO ()-encodeToHandle enc opts as h =-  BS.hPutBuilder h (encodeBuilder enc opts as)---- | Encode, writing to a file. This is way is more efficient than encoding to--- a 'ByteString' and then writing to file.-encodeToFile :: Encode a -> EncodeOptions -> [a] -> FilePath -> IO ()-encodeToFile enc opts as fp = do-  h <- openFile fp WriteMode-  hSetBuffering h (BlockBuffering Nothing)-  hSetBinaryMode h True-  encodeToHandle enc opts as h-  hClose h---- | Encode to a ByteString 'Builder', which is useful if you are going--- to combine the output with other 'ByteString's.-encodeBuilder :: Encode a -> EncodeOptions -> [a] -> BS.Builder-encodeBuilder e opts as =-  let enc = encodeRowBuilder e opts-      nl  = newlineToString (_newline opts)-      terminal = if _terminalNewline opts then nl else mempty-  in  case as of-    [] -> terminal-    (a:as') -> enc a <> mconcat [nl <> enc a' | a' <- as'] <> terminal---- | Encode one row only-encodeRow :: Encode a -> EncodeOptions -> a -> LBS.ByteString-encodeRow e opts = BS.toLazyByteString . encodeRowBuilder e opts---- | Encode one row only, as a ByteString 'Builder'-encodeRowBuilder :: Encode a -> EncodeOptions -> a -> BS.Builder-encodeRowBuilder e opts =-  let addSeparators = intersperseSeq (BS.charUtf8 (view separator opts))-      quotep = foldMap (BS.charUtf8 . review quoteChar) (view quote opts)-      addQuotes x = quotep <> x <> quotep-      mkSpaces optic = BS.stringUtf8 . review spacesString . view optic $ opts-      bspaces = mkSpaces spacingBefore-      aspaces = mkSpaces spacingAfter-      addSpaces x = bspaces <> x <> aspaces-  in  fold . addSeparators . fmap (addSpaces . addQuotes) . getEncode e opts---- | Build an 'Sv' rather than going straight to 'ByteString'. This allows you--- to query the Sv or run sanity checks.-encodeSv :: Encode a -> EncodeOptions -> Maybe (NonEmpty Strict.ByteString) -> [a] -> Sv Strict.ByteString-encodeSv e opts headerStrings as =-  let encoded :: [Seq BS.Builder]-      encoded = getEncode e opts <$> as-      nl = view newline opts-      sep = view separator opts-      mkSpaced = Spaced (_spacingBefore opts) (_spacingAfter opts)-      mkField = maybe Unquoted unescapedField (_quote opts)-      mkHeader r = Header r nl-      mkRecord :: NonEmpty z -> Record z-      mkRecord = recordNel . fmap (mkSpaced . mkField)-      header :: Maybe (Header Strict.ByteString)-      header = mkHeader . mkRecord <$> headerStrings-      rs :: Records Strict.ByteString-      rs = l2rs (b2r <$> encoded)-      l2rs = maybe EmptyRecords (mkRecords nl) . nonEmpty -- Records . fmap (skrinple nl) . nonEmpty-      terminal = if _terminalNewline opts then [nl] else []-      b2f :: BS.Builder -> SpacedField Strict.ByteString-      b2f = mkSpaced . mkField . LBS.toStrict . BS.toLazyByteString-      b2r :: Seq BS.Builder -> Record Strict.ByteString-      b2r = maybe emptyRecord (Record . V.fromNel) . nonEmpty . toList . fmap b2f-  in  Sv sep header rs terminal---- | Encode this 'Data.ByteString.ByteString' every time, ignoring the input.-const :: Strict.ByteString -> Encode a-const b = contramap (pure b) byteString---- | Build an 'Encode' using a type's 'Show' instance.-show :: Show a => Encode a-show = contramap P.show string---- | Don't encode anything.-nop :: Encode a-nop = conquer---- | Encode anything as the empty string.-empty :: Encode a-empty = Encode (pure (pure (pure mempty)))---- | Lift an Encode to be able to hanlde 'Maybe', by using the empty string--- in the case of 'Nothing'-orEmpty :: Encode a -> Encode (Maybe a)-orEmpty = choose (maybe (Left ()) Right) empty---- | Build an 'Encode' for 'Maybe' given a 'Just' and a 'Nothing' encode.-(?>) :: Encode a -> Encode () -> Encode (Maybe a)-(?>) = flip (<?)-{-# INLINE (?>) #-}---- | Build an 'Encode' for 'Maybe' given a 'Nothing' and a 'Just' encode.-(<?) :: Encode () -> Encode a -> Encode (Maybe a)-(<?) = choose (maybe (Left ()) Right)-{-# INLINE (<?) #-}---- | Build an 'Encode' for 'Maybe' given a 'Just' encode and a--- 'Data.ByteString.Strict.ByteString' for the 'Nothing' case.-(?>>) :: Encode a -> Strict.ByteString -> Encode (Maybe a)-(?>>) a s = a ?> const s-{-# INLINE (?>>) #-}---- | Build an 'Encode' for 'Maybe' given a  'Data.ByteString.Strict.ByteString'--- for the 'Nothing' case and a 'Just' encode.-(<<?) :: Strict.ByteString -> Encode a -> Encode (Maybe a)-(<<?) = flip (?>>)-{-# INLINE (<<?) #-}---- | Encode a list as a whole row at once, using the same 'Encode'--- for every element-row :: Encode s -> Encode [s]-row enc = Encode $ \opts list -> join $ Seq.fromList $ fmap (getEncode enc opts) list---- | Encode a single 'Char'-char :: Encode Char-char = escaped escapeChar BS.charUtf8 BS.stringUtf8---- | Encode an 'Int'-int :: Encode Int-int = unsafeBuilder BS.intDec---- | Encode an 'Integer'-integer :: Encode Integer-integer = unsafeBuilder BS.integerDec---- | Encode a 'Float'-float :: Encode Float-float = unsafeBuilder BS.floatDec---- | Encode a 'Double'-double :: Encode Double-double = unsafeBuilder BS.doubleDec---- | Encode a 'String'-string :: Encode String-string = escaped' escapeString BS.stringUtf8---- | Encode a 'Data.Text.Text'-text :: Encode T.Text-text = escaped' escapeText (BS.byteString . T.encodeUtf8)---- | Encode a strict 'Data.ByteString.ByteString'-byteString :: Encode Strict.ByteString-byteString = escaped' escapeUtf8 BS.byteString---- | Encode a lazy 'Data.ByteString.Lazy.ByteString'-lazyByteString :: Encode LBS.ByteString-lazyByteString = escaped' escapeUtf8Lazy BS.lazyByteString--escaped :: Escaper s t -> (s -> BS.Builder) -> (t -> BS.Builder) -> Encode s-escaped esc sb tb = mkEncodeWithOpts $ \opts s ->-  case _quote opts of-    Nothing -> sb s-    Just q -> tb $ esc (review quoteChar q) (Unescaped s)--escaped' :: Escaper' s -> (s -> BS.Builder) -> Encode s-escaped' escaper = join (escaped escaper)---- | Encode a 'Bool' as False or True-boolTrueFalse :: Encode Bool-boolTrueFalse = mkEncodeBS $ B.bool "False" "True"---- | Encode a 'Bool' as false or true-booltruefalse :: Encode Bool-booltruefalse = mkEncodeBS $ B.bool "false" "true"---- | Encode a 'Bool' as no or yes-boolyesno :: Encode Bool-boolyesno = mkEncodeBS $ B.bool "no" "yes"---- | Encode a 'Bool' as No or Yes-boolYesNo :: Encode Bool-boolYesNo = mkEncodeBS $ B.bool "No" "Yes"---- | Encode a 'Bool' as N or Y-boolYN :: Encode Bool-boolYN = mkEncodeBS $ B.bool "N" "Y"---- | Encode a 'Bool' as 0 or 1-bool10 :: Encode Bool-bool10 = mkEncodeBS $ B.bool "0" "1"---- | Given an optic from @s@ to @a@, Try to use it to build an encode.------ @--- encodeOf :: Iso'       s a -> Encode a -> Encode s--- encodeOf :: Lens'      s a -> Encode a -> Encode s--- encodeOf :: Prism'     s a -> Encode a -> Encode s--- encodeOf :: Traversal' s a -> Encode a -> Encode s--- encodeOf :: Fold       s a -> Encode a -> Encode s--- encodeOf :: Getter     s a -> Encode a -> Encode s--- @------ This is very useful when you have a prism for each constructor of your type.--- You can define an 'Encode' as follows:------ @--- myEitherEncode :: Encode a -> Encode b -> Encode (Either a b)--- myEitherEncode encA encB = encodeOf _Left encA <> encodeOf _Right encB--- @------ In this example, when the prism lookup returns 'Nothing', the empty encoder--- is returned. This is the 'mempty' for the 'Encode' monoid, so it won't--- add a field to the resulting CSV. This is the behaviour you want for--- combining a collection of prisms.------ But this encoder also works with lenses (or weaker optics), which will--- never fail their lookup, in which case it never returns 'mempty'.--- So this actually does the right thing for both sum and product types.-encodeOf :: Getting (First a) s a -> Encode a -> Encode s-encodeOf g = encodeOfMay g . choose (maybe (Left ()) Right) conquer---- | Like 'encodeOf', but you can handle 'Nothing' however you'd like.--- In 'encodeOf', it is handled by the Encode which does nothing,--- but for example you might like to use 'orEmpty' to encode an empty field.-encodeOfMay :: Getting (First a) s a -> Encode (Maybe a) -> Encode s-encodeOfMay g x = contramap (preview g) x---- | Encode a 'String' really quickly.--- If the string has quotes in it, they will not be escaped properly, so--- the result maybe not be valid CSV-unsafeString :: Encode String-unsafeString = unsafeBuilder BS.stringUtf8---- | Encode 'Data.Text.Text' really quickly.--- If the text has quotes in it, they will not be escaped properly, so--- the result maybe not be valid CSV-unsafeText :: Encode T.Text-unsafeText = unsafeBuilder (BS.byteString . T.encodeUtf8)---- | Encode ByteString 'Data.ByteString.Builder.Builder' really quickly.--- If the builder builds a string with quotes in it, they will not be escaped--- properly, so the result maybe not be valid CSV-unsafeByteStringBuilder :: Encode BS.Builder-unsafeByteStringBuilder = unsafeBuilder id---- | Encode a 'Data.ByteString.ByteString' really quickly.--- If the string has quotes in it, they will not be escaped properly, so--- the result maybe not be valid CSV-unsafeByteString :: Encode Strict.ByteString-unsafeByteString = unsafeBuilder BS.byteString---- | Encode a 'Data.ByteString.Lazy.ByteString' really quickly.--- If the string has quotes in it, they will not be escaped properly, so--- the result maybe not be valid CSV-unsafeLazyByteString :: Encode LBS.ByteString-unsafeLazyByteString = unsafeBuilder BS.lazyByteString---- | Encode this 'Data.ByteString.ByteString' really quickly every time, ignoring the input.--- If the string has quotes in it, they will not be escaped properly, so--- the result maybe not be valid CSV-unsafeConst :: Strict.ByteString -> Encode a-unsafeConst b = contramap (pure b) unsafeByteString---- Added in containers 0.5.8, but we duplicate it here to support older GHCs-intersperseSeq :: a -> Seq a -> Seq a-intersperseSeq y xs = case viewl xs of-  EmptyL -> S.empty-  p :< ps -> p <| (ps <**> (pure y <| S.singleton id))+import Data.Sv.Encode.Core
− src/Data/Sv/Encode/Options.hs 
@@ -1,98 +0,0 @@-{-|-Module      : Data.Sv.Encode.Options-Copyright   : (C) CSIRO 2017-2018-License     : BSD3-Maintainer  : George Wilson <george.wilson@data61.csiro.au>-Stability   : experimental-Portability : non-portable--Options to configure encoding--}--module Data.Sv.Encode.Options (-  EncodeOptions (EncodeOptions, _encodeSeparator, _spacingBefore, _spacingAfter, _quote, _newline, _terminalNewline)-, HasEncodeOptions (encodeOptions, spacingBefore, spacingAfter, quote, newline, terminalNewline)-, HasSeparator (..)-, defaultEncodeOptions-) where--import Control.Lens (Lens')--import Data.Sv.Syntax.Sv (Separator, HasSeparator (separator), comma)-import Text.Newline (Newline (CRLF))-import Text.Space (Spaces)-import Text.Quote (Quote (DoubleQuote))---- | These are options to configure encoding. A default is provided as--- 'defaultEncodeOptions'.-data EncodeOptions =-  EncodeOptions {-    -- | Are your values separated by commas, tabs, or something else? Default: comma-    _encodeSeparator :: Separator-    -- | Between a comma and the next value, would you like some spacing? Default: no spacing-  , _spacingBefore :: Spaces-    -- | Between a value and the next comma, would you like some spacing? Default: no spacing-  , _spacingAfter :: Spaces-    -- | Would you like quotes around your values? If so, double quotes or single? Deafult: Double quotes-  , _quote :: Maybe Quote-    -- | What kind of newline would you like? Default: CRLF-  , _newline :: Newline-    -- | Should the file be terminated with a newline? Default: No-  , _terminalNewline :: Bool-  }---- | Classy lenses for 'EncodeOptions'------ @--- import Control.Lens------ defaultEncodeOptinons & quote .~ Just DoubleQuote & newline .~ LF--- @-class HasSeparator c => HasEncodeOptions c where-  encodeOptions :: Lens' c EncodeOptions-  newline :: Lens' c Newline-  {-# INLINE newline #-}-  quote :: Lens' c (Maybe Quote)-  {-# INLINE quote #-}-  spacingAfter :: Lens' c Spaces-  {-# INLINE spacingAfter #-}-  spacingBefore :: Lens' c Spaces-  {-# INLINE spacingBefore #-}-  terminalNewline :: Lens' c Bool-  {-# INLINE terminalNewline #-}-  newline = encodeOptions . newline-  quote = encodeOptions . quote-  spacingAfter = encodeOptions . spacingAfter-  spacingBefore = encodeOptions . spacingBefore-  terminalNewline = encodeOptions . terminalNewline--instance HasSeparator EncodeOptions where-  separator f (EncodeOptions x1 x2 x3 x4 x5 x6) =-    fmap (\ y -> EncodeOptions y x2 x3 x4 x5 x6) (f x1)-  {-# INLINE separator #-}--instance HasEncodeOptions EncodeOptions where-  encodeOptions = id-  {-# INLINE encodeOptions #-}-  newline f (EncodeOptions x1 x2 x3 x4 x5 x6) =-    fmap (\ y -> EncodeOptions x1 x2 x3 x4 y x6) (f x5)-  {-# INLINE newline #-}-  quote f (EncodeOptions x1 x2 x3 x4 x5 x6) =-    fmap (\ y -> EncodeOptions x1 x2 x3 y x5 x6) (f x4)-  {-# INLINE quote #-}-  spacingAfter f (EncodeOptions x1 x2 x3 x4 x5 x6) =-    fmap (\ y -> EncodeOptions x1 x2 y x4 x5 x6) (f x3)-  {-# INLINE spacingAfter #-}-  spacingBefore f (EncodeOptions x1 x2 x3 x4 x5 x6) =-    fmap (\ y -> EncodeOptions x1 y x3 x4 x5 x6) (f x2)-  {-# INLINE spacingBefore #-}-  terminalNewline f (EncodeOptions x1 x2 x3 x4 x5 x6) =-    fmap (\ y -> EncodeOptions x1 x2 x3 x4 x5 y) (f x6)-  {-# INLINE terminalNewline #-}---- | The default options for encoding.------ The default is a CSV file with double-quotes, CRLF lines, no spacing around--- fields, and no terminating newline.-defaultEncodeOptions :: EncodeOptions-defaultEncodeOptions = EncodeOptions comma mempty mempty (Just DoubleQuote) CRLF False
− src/Data/Sv/Encode/Type.hs 
@@ -1,48 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}--{-|-Module      : Data.Sv.Encode.Type-Copyright   : (C) CSIRO 2017-2018-License     : BSD3-Maintainer  : George Wilson <george.wilson@data61.csiro.au>-Stability   : experimental-Portability : non-portable--The core type for encoding--}--module Data.Sv.Encode.Type (-  Encode (Encode, getEncode)-) where--import Data.Bifoldable (bifoldMap)-import qualified Data.ByteString.Builder as BS-import Data.Functor.Contravariant (Contravariant (contramap))-import Data.Functor.Contravariant.Divisible (Divisible (divide, conquer), Decidable (choose, lose))-import Data.Semigroup (Semigroup)-import Data.Sequence (Seq)-import Data.Void (absurd)--import Data.Sv.Encode.Options---- | An 'Encode' converts its argument into one or more textual fields, to be--- written out as CSV.------ It is 'Semigroup', Contravariant', 'Divisible', and 'Decidable', allowing--- for composition of these values to build bigger 'Encode's from smaller ones.-newtype Encode a =-  Encode { getEncode :: EncodeOptions -> a -> Seq BS.Builder }-  deriving (Semigroup, Monoid)--instance Contravariant Encode where-  contramap f (Encode g) = Encode $ fmap (. f) g--instance Divisible Encode where-  conquer = Encode mempty-  divide f (Encode x) (Encode y) =-    Encode $ \e a -> bifoldMap (x e) (y e) (f a)--instance Decidable Encode where-  lose f = Encode (const (absurd . f))-  choose f (Encode x) (Encode y) =-    Encode $ \e a -> either (x e) (y e) (f a)
src/Data/Sv/Parse.hs view
@@ -8,107 +8,44 @@ -}  module Data.Sv.Parse (-  parseSv-, parseSv'-, parseSvFromFile-, parseSvFromFile'-, separatedValues--, module Data.Sv.Parse.Options-, SvParser (..)-, trifecta-, attoparsecByteString-, attoparsecText+  ParseOptions (..)+, defaultParseOptions+, defaultSeparator+, defaultHeadedness ) where -import Control.Lens (view)-import Control.Monad.IO.Class (MonadIO, liftIO)-import qualified Data.Attoparsec.ByteString as BS (parseOnly)-import qualified Data.Attoparsec.Text as Text (parseOnly)-import Data.Bifunctor (first)-import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import Data.Text (Text)-import qualified Data.Text.IO as Text-import qualified Text.Trifecta as Tri--import Data.Sv.Syntax.Sv (Sv)-import Data.Sv.Decode.Error (trifectaResultToEither)-import Data.Sv.Parse.Internal (separatedValues)-import Data.Sv.Parse.Options+import Data.Sv.Structure.Separator (Separator, HasSeparator (separator), comma)+import Data.Sv.Structure.Headedness (Headedness (Headed), HasHeadedness (headedness)) --- | Parse a 'ByteString' as an Sv.+-- | A 'ParseOptions' informs the parser how to parse your file. ----- This version uses Trifecta, hence it assumes its input is UTF-8 encoded.-parseSv :: ParseOptions ByteString -> ByteString -> Either ByteString (Sv ByteString)-parseSv = parseSv' trifecta+-- A default is provided as 'defaultParseOptions', seen below.+data ParseOptions =+  ParseOptions {+  -- | Which separator does the file use? Usually this is 'comma', but it can+  -- also be 'pipe', or any other 'Word8' ('Separator' = 'Word8')+    _separator :: Separator --- | Parse some text as an Sv.------ This version lets you choose which parsing library to use by providing an--- 'SvParser'. Common selections are 'trifecta' and 'attoparsecByteString'.-parseSv' :: SvParser s -> ParseOptions s -> s -> Either s (Sv s)-parseSv' svp opts s =-  let enc = view encodeString opts-  in  first enc $ runSvParser svp opts s+  -- | Whether there is a header row with column names or not.+  , _headedness :: Headedness+  } --- | Load a file and parse it as an 'Sv'.------ This version uses Trifecta, hence it assumes its input is UTF-8 encoded.-parseSvFromFile :: MonadIO m => ParseOptions ByteString -> FilePath -> m (Either ByteString (Sv ByteString))-parseSvFromFile = parseSvFromFile' trifecta+instance HasHeadedness ParseOptions where+  headedness f (ParseOptions s h) = ParseOptions s <$> f h --- | Load a file and parse it as an 'Sv'.------ This version lets you choose which parsing library to use by providing an--- 'SvParser'. Common selections are 'trifecta' and 'attoparsecByteString'.-parseSvFromFile' :: MonadIO m => SvParser s -> ParseOptions s -> FilePath -> m (Either s (Sv s))-parseSvFromFile' svp opts fp =-  let enc = view encodeString opts-  in  liftIO (first enc <$> runSvParserFromFile svp opts fp)+instance HasSeparator ParseOptions where+  separator f (ParseOptions s h) = (\y -> ParseOptions y h) <$> f s --- | Which parsing library should be used to parse the document?------ The parser is written in terms of the @parsers@ library, meaning it can be--- instantiated to several different parsing libraries. By default, we use--- 'trifecta', because "Text.Trifecta"s error messages are so helpful.--- 'attoparsecByteString' is faster though, if your input is ASCII and-  -- you care a lot about speed.+-- | Default parsing options. ----- It is worth noting that Trifecta assumes UTF-8 encoding of the input data.--- UTF-8 is backwards-compatible with 7-bit ASCII, so this will work for many--- documents. However, not all documents are ASCII or UTF-8. For example, our--- <https://github.com/qfpl/sv/blob/master/examples/csv/species.csv species.csv>--- test file is Windows-1252, which is a non-ISO extension--- of latin1 8-bit ASCII. For documents encoded as Windows-1252, Trifecta's--- assumption is invalid and parse errors result.--- 'Attoparsec' works fine for this character encoding, but it wouldn't work--- well on a UTF-8 encoded document including non-ASCII characters.-data SvParser s = SvParser-  { runSvParser :: ParseOptions s -> s -> Either String (Sv s)-  , runSvParserFromFile :: ParseOptions s -> FilePath -> IO (Either String (Sv s))-  }---- | An 'SvParser' that uses "Text.Trifecta". Trifecta assumes its input is UTF-8, and--- provides helpful clang-style error messages.-trifecta :: SvParser ByteString-trifecta = SvParser-  { runSvParser = \opts bs -> trifectaResultToEither $ Tri.parseByteString (separatedValues opts) mempty bs-  , runSvParserFromFile = \opts fp -> trifectaResultToEither <$> Tri.parseFromFileEx (separatedValues opts) fp-  }+-- The default is a comma separator, with a header at the top of the file.+defaultParseOptions :: ParseOptions+defaultParseOptions = ParseOptions defaultSeparator defaultHeadedness --- | An 'SvParser' that uses "Data.Attoparsec.ByteString". This is the fastest--- provided 'SvParser', but it has poorer error messages.-attoparsecByteString :: SvParser ByteString-attoparsecByteString = SvParser-  { runSvParser = \opts bs -> BS.parseOnly (separatedValues opts) bs-  , runSvParserFromFile = \opts fp -> BS.parseOnly (separatedValues opts) <$> BS.readFile fp-  }+-- | The default separator is comma.+defaultSeparator :: Separator+defaultSeparator = comma --- | An 'SvParser' that uses "Data.Attoparsec.Text". This is helpful if--- your input is in the form of 'Text'.-attoparsecText :: SvParser Text-attoparsecText = SvParser-  { runSvParser = \opts t -> Text.parseOnly (separatedValues opts) t-  , runSvParserFromFile = \opts fp -> Text.parseOnly (separatedValues opts) <$> Text.readFile fp-  }+-- | The default is that a header is present.+defaultHeadedness :: Headedness+defaultHeadedness = Headed
− src/Data/Sv/Parse/Internal.hs 
@@ -1,170 +0,0 @@-{-|-Module      : Data.Sv.Parse.Internal-Copyright   : (C) CSIRO 2017-2018-License     : BSD3-Maintainer  : George Wilson <george.wilson@data61.csiro.au>-Stability   : experimental-Portability : non-portable--This module contains internal implementation details of sv's parser.-As the Internal name suggests, this file is exempt from the PVP. Depend-on this module at your own risk!--}--module Data.Sv.Parse.Internal (-  separatedValues-  , header-  , field-  , singleQuotedField-  , doubleQuotedField-  , unquotedField-  , spaced-  , spacedField-  , record-  , records-  , ending-) where--import Control.Applicative (Alternative ((<|>), empty), optional)-import Control.Lens (review, view)-import Data.CharSet (CharSet, (\\))-import qualified Data.CharSet as CharSet (fromList, insert, singleton)-import Data.Functor (($>), (<$>), void)-import Data.List.NonEmpty (NonEmpty ((:|)))-import Data.Maybe (fromMaybe)-import Data.Semigroup ((<>))-import qualified Data.Vector as V-import Text.Parser.Char (CharParsing, char, notChar, noneOfSet, oneOfSet, string)-import Text.Parser.Combinators (between, choice, eof, many, notFollowedBy, sepEndBy, try)--import Data.Sv.Syntax.Sv (Sv (Sv), Header, mkHeader, noHeader, Headedness (Unheaded, Headed), headedness, Separator)-import Data.Sv.Syntax.Field (Field (Unquoted, Quoted))-import Data.Sv.Syntax.Record (Record (Record), Records (Records, EmptyRecords))-import Data.Sv.Parse.Options (ParseOptions, separator, endOnBlankLine, encodeString)-import Data.Vector.NonEmpty as V-import Text.Escape (Unescaped (Unescaped))-import Text.Newline (Newline (CR, CRLF, LF))-import Text.Space (HorizontalSpace (Space, Tab), Spaces, Spaced, betwixt)-import Text.Quote (Quote (SingleQuote, DoubleQuote), quoteChar)---- | This function is in newer versions of the parsers package, but in--- order to maintain compatibility with older versions I've left it here.-sepEndByNonEmpty :: Alternative m => m a -> m sep -> m (NonEmpty a)-sepEndByNonEmpty p sep = (:|) <$> p <*> ((sep *> sepEndBy p sep) <|> pure [])---- | Parse a field surrounded by single quotes-singleQuotedField :: CharParsing m => (String -> s) -> m (Field s)-singleQuotedField = quotedField SingleQuote---- | Parse a field surrounded by double quotes-doubleQuotedField :: CharParsing m => (String -> s) -> m (Field s)-doubleQuotedField = quotedField DoubleQuote---- | Given a quote, parse its escaped form (which is it repeated twice)-escapeQuote :: CharParsing m => Quote -> m Char-escapeQuote q =-  let c = review quoteChar q-  in  try (string (two c)) $> c--two :: a -> [a]-two a = [a,a]--quotedField :: CharParsing m => Quote -> (String -> s) -> m (Field s)-quotedField quote str =-  let q = review quoteChar quote-      c = char q-      cc = escapeQuote quote-  in  Quoted quote . Unescaped . str <$> between c c (many (cc <|> notChar q))---- | Parse a field that is not surrounded by quotes-unquotedField :: CharParsing m => Separator -> (String -> s) -> m (Field s)-unquotedField sep str =-  let spaceSet = CharSet.fromList " \t" \\ CharSet.singleton sep-      oneSpace = oneOfSet spaceSet-      nonSpaceFieldChar = noneOfSet (newlineOr sep <> spaceSet)-      terminalWhitespace = many oneSpace *> fieldEnder-      fieldEnder = void (oneOfSet (newlineOr sep)) <|> eof-  in  Unquoted . str <$>-    many (-      nonSpaceFieldChar-      <|> (notFollowedBy (try terminalWhitespace)) *> oneSpace-    )---- | Parse a field, be it quoted or unquoted-field :: CharParsing m => Separator -> (String -> s) -> m (Field s)-field sep str =-  choice [-    singleQuotedField str-  , doubleQuotedField str-  , unquotedField sep str-  ]---- | Parse a field with its surrounding spacing-spacedField :: CharParsing m => Separator -> (String -> s) -> m (Spaced (Field s))-spacedField sep str = spaced sep (field sep str)--newlineOr :: Char -> CharSet-newlineOr c = CharSet.insert c newlines--newlines :: CharSet-newlines = CharSet.fromList "\r\n"--newline :: CharParsing m => m Newline-newline =-  CRLF <$ try (string "\r\n")-    <|> CR <$ char '\r'-    <|> LF <$ char '\n'--space :: CharParsing m => Separator -> m HorizontalSpace-space sep =-  let removeIfSep c s = if sep == c then empty else char c $> s-  in  removeIfSep ' ' Space <|> removeIfSep '\t' Tab--spaces :: CharParsing m => Separator -> m Spaces-spaces = fmap V.fromList . many . space---- | Combinator to parse some data surrounded by spaces-spaced :: CharParsing m => Separator -> m a -> m (Spaced a)-spaced sep p = betwixt <$> spaces sep <*> p <*> spaces sep---- | Parse an entire record, or "row"-record :: CharParsing m => ParseOptions s -> m (Record s)-record opts =-  let sep = view separator opts-      str = view encodeString opts-  in  Record . V.fromNel <$> (spacedField sep str `sepEndByNonEmpty` char sep)---- | Parse many records, or "rows"-records :: CharParsing m => ParseOptions s -> m (Records s)-records opts =-  let manyV = fmap V.fromList . many-  in  fromMaybe EmptyRecords <$>-    optional (Records <$> firstRecord opts <*> manyV (subsequentRecord opts))--firstRecord :: CharParsing m => ParseOptions s -> m (Record s)-firstRecord opts = notFollowedBy (try (ending opts)) *> record opts--subsequentRecord :: CharParsing m => ParseOptions s -> m (Newline, Record s)-subsequentRecord opts =-  (,)-    <$> (notFollowedBy (try (ending opts)) *> newline) -- ((if view endOnBlankLine opts then (void newline) else empty) <|> eof))-    <*> record opts---- | Parse zero or many newlines-ending :: CharParsing m => ParseOptions s -> m [Newline]-ending opts =-  let end = if view endOnBlankLine opts then pure [] else many newline-  in  [] <$ eof-    <|> try (pure <$> newline <* eof)-    <|> (:) <$> newline <*> ((:) <$> newline <*> end)---- | Maybe parse the header row of a CSV file, depending on the given 'Headedness'-header :: CharParsing m => ParseOptions s -> m (Maybe (Header s))-header opts = case view headedness opts of-  Unheaded -> pure noHeader-  Headed -> mkHeader <$> record opts <*> newline---- | Parse an 'Sv'-separatedValues :: CharParsing m => ParseOptions s -> m (Sv s)-separatedValues opts =-  Sv (view separator opts) <$> header opts <*> records opts <*> ending opts
− src/Data/Sv/Parse/Options.hs 
@@ -1,97 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE DefaultSignatures #-}--{-|-Module      : Data.Sv.Parse.Options-Copyright   : (C) CSIRO 2017-2018-License     : BSD3-Maintainer  : George Wilson <george.wilson@data61.csiro.au>-Stability   : experimental-Portability : non-portable--Configuration to tell the parser what your file looks like.--}--module Data.Sv.Parse.Options (-  ParseOptions (ParseOptions, _headedness, _endOnBlankLine, _parseSeparator, _encodeString)-, HasParseOptions (parseOptions, endOnBlankLine, encodeString)-, HasSeparator (..)-, HasHeadedness (..)-, defaultParseOptions-, defaultHeadedness-, defaultSeparator-) where--import Control.Lens (Lens, lens)-import Data.ByteString.UTF8 (ByteString, fromString)--import Data.Sv.Syntax.Sv (HasSeparator (separator), HasHeadedness (headedness), Headedness (Headed), Separator, comma)---- | An 'ParseOptions' informs the parser how to parse your file. The type--- parameter will be some sort of string; often 'Data.ByteString.ByteString'.------ A default is provided as 'defaultParseOptions', seen below.-data ParseOptions s =-  ParseOptions {-  -- | Which separator does the file use? Usually this is 'comma', but it can-  -- also be 'pipe', or any other 'Char' ('Separator' = 'Char')-    _parseSeparator :: Separator--  -- | Whether there is a header row with column names or not.-  , _headedness :: Headedness--  -- | If a blank line is encountered, should the parse finish, or treat it as-  -- an empty row and continue?-  , _endOnBlankLine :: Bool--  -- | How should I turn a String into this type? This is a detail used by the parser.-  , _encodeString :: String -> s-  }--instance Functor ParseOptions where-  fmap f (ParseOptions s h e enc) = ParseOptions s h e (f . enc)---- | Classy lenses for 'ParseOptions'-class (HasSeparator s, HasHeadedness s) => HasParseOptions s t a b | s -> a, t -> b, s b -> t, t a -> s where-  parseOptions :: Lens s t (ParseOptions a) (ParseOptions b)-  encodeString :: Lens s t (String -> a) (String -> b)-  {-# INLINE encodeString #-}-  endOnBlankLine :: s ~ t => Lens s t Bool Bool-  {-# INLINE endOnBlankLine #-}-  encodeString = parseOptions . encodeString-  default endOnBlankLine :: (s ~ t, a ~ b) => Lens s t Bool Bool-  endOnBlankLine = parseOptions . endOnBlankLine--instance HasParseOptions (ParseOptions a) (ParseOptions b) a b where-  parseOptions = id-  {-# INLINE parseOptions #-}-  encodeString = lens _encodeString (\c s -> c { _encodeString = s })-  {-# INLINE encodeString #-}-  endOnBlankLine = lens _endOnBlankLine (\c b -> c { _endOnBlankLine = b })-  {-# INLINE endOnBlankLine #-}--instance HasSeparator (ParseOptions s) where-  separator =-    lens _parseSeparator (\c s -> c { _parseSeparator = s })-  {-# INLINE separator #-}--instance HasHeadedness (ParseOptions s) where-  headedness =-    lens _headedness (\c h -> c { _headedness = h })-  {-# INLINE headedness #-}---- | 'defaultParseOptions' is used to parse a CSV file featuring a header row, using--- Trifecta as the parsing library. It uses UTF-8 'ByteString's-defaultParseOptions :: ParseOptions ByteString-defaultParseOptions = ParseOptions defaultSeparator defaultHeadedness False fromString---- | The default separator. Alias for 'comma'.-defaultSeparator :: Separator-defaultSeparator = comma---- | The default is that a header is present.-defaultHeadedness :: Headedness-defaultHeadedness = Headed
− src/Data/Sv/Print.hs 
@@ -1,104 +0,0 @@-{-|-Module      : Data.Sv.Print-Copyright   : (C) CSIRO 2017-2018-License     : BSD3-Maintainer  : George Wilson <george.wilson@data61.csiro.au>-Stability   : experimental-Portability : non-portable--Printing is the process of turning an 'Data.Sv.Syntax.Sv.Sv' into a textual-representation, such as a 'Data.ByteString.ByteString'.--If you want to turn your data type into a textual representation, you should-look instead at "Data.Sv.Encode"--}--module Data.Sv.Print (-  printSv-, printSvLazy-, printSv'-, printSvLazy'-, printSvText-, printSvTextLazy-, writeSvToFile-, writeSvToHandle-, writeSvToFile'-, writeSvToHandle'-, module Data.Sv.Print.Options-) where--import Data.ByteString (ByteString)-import qualified Data.ByteString.Lazy as LBS-import Data.ByteString.Builder as Builder-import Data.Semigroup ((<>))-import Data.Text (Text)-import System.IO (BufferMode (BlockBuffering), Handle, hClose, hSetBinaryMode, hSetBuffering, openFile, IOMode (WriteMode))--import Data.Sv.Print.Options-import Data.Sv.Print.Internal-import Data.Sv.Syntax.Sv (Sv (Sv))---- | Converts an 'Sv' to a ByteString 'Builder'. Useful if you want to concatenate other--- text before or after.-svToBuilder :: PrintOptions s -> Sv s -> Builder-svToBuilder opts (Sv sep h rs e) =-  foldMap (printHeader opts sep) h <> printRecords opts sep rs <> foldMap printNewline e---- | Writes an sv to a file handle. This goes directly from a 'Builder', so it is--- more efficient than calling 'printSv' or 'printSvLazy' and writing the--- result to the handle.-writeSvToHandle :: Handle -> Sv ByteString -> IO ()-writeSvToHandle = writeSvToHandle' defaultPrintOptions---- | Writes an sv to a file. This goes directly from a 'Builder', so it is--- more efficient than calling 'printSv' or 'printSvLazy' and writing the--- result to a file.-writeSvToFile :: FilePath -> Sv ByteString -> IO ()-writeSvToFile = writeSvToFile' defaultPrintOptions---- | Writes an sv to a file handle. This goes directly from a 'Builder', so it is--- more efficient than calling 'printSv' or 'printSvLazy' and writing the--- result to the handle.------ This version is polymorphic, but as a penalty you have to tell me how to--- get a Bytestring 'Builder'.-writeSvToHandle' :: PrintOptions s -> Handle -> Sv s -> IO ()-writeSvToHandle' opts h sv = hPutBuilder h (svToBuilder opts sv)---- | Writes an sv to a file. This goes directly from a 'Builder', so it is--- more efficient than calling 'printSv' or 'printSvLazy' and writing the--- result to a file.------ This version is polymorphic, but as a penalty you have to tell me how to--- get a Bytestring 'Builder'.-writeSvToFile' :: PrintOptions s -> FilePath -> Sv s -> IO ()-writeSvToFile' opts fp sv = do-  h <- openFile fp WriteMode-  hSetBuffering h (BlockBuffering Nothing)-  hSetBinaryMode h True-  writeSvToHandle' opts h sv-  hClose h---- | Print an Sv to a 'Data.ByteString.ByteString' value.-printSv :: Sv ByteString -> ByteString-printSv = printSv' defaultPrintOptions---- | Print an Sv to a lazy 'Data.ByteString.Lazy.ByteString' value.-printSvLazy :: Sv ByteString -> LBS.ByteString-printSvLazy = printSvLazy' defaultPrintOptions---- | Converts the given 'Sv' into a strict 'Data.ByteString.ByteString'-printSv' :: PrintOptions s -> Sv s -> ByteString-printSv' opts = LBS.toStrict . printSvLazy' opts---- | Converts the given 'Sv' into a lazy 'Data.ByteString.Lazy.ByteString'-printSvLazy' :: PrintOptions s -> Sv s -> LBS.ByteString-printSvLazy' opts = toLazyByteString . svToBuilder opts---- | Print an Sv containing 'Text' to a 'Data.ByteString.ByteString'-printSvText :: Sv Text -> ByteString-printSvText = printSv' textPrintOptions---- | Print an Sv containing 'Text' to a 'Data.ByteString.Lazy.ByteString'-printSvTextLazy :: Sv Text -> LBS.ByteString-printSvTextLazy = printSvLazy' textPrintOptions
− src/Data/Sv/Print/Internal.hs 
@@ -1,73 +0,0 @@-{-|-Module      : Data.Sv.Print.Internal-Copyright   : (C) CSIRO 2017-2018-License     : BSD3-Maintainer  : George Wilson <george.wilson@data61.csiro.au>-Stability   : experimental-Portability : non-portable--This module is considered an implementation detail.-As the "Internal" module name suggests, this module is exempt from-the PVP, so depend on it at your own risk!-These functions exist to be called by "Data.Sv.Print".--}--module Data.Sv.Print.Internal (-  printNewline-  , printField-  , printSpaced-  , printRecord-  , printRecords-  , printHeader-) where--import Control.Lens (review, view)-import Data.Bifoldable (bifoldMap)-import Data.ByteString.Builder as Builder-import Data.Semigroup ((<>))-import Data.Semigroup.Foldable (intercalate1)--import Data.Sv.Print.Options-import Data.Sv.Syntax.Field (Field (Quoted, Unquoted), SpacedField)-import Data.Sv.Syntax.Record (Record (Record), Records (Records, EmptyRecords))-import Data.Sv.Syntax.Sv (Header (Header), Separator)-import Text.Newline-import Text.Space (spaceToChar, Spaced (Spaced))-import Text.Quote---- | Convert a 'Newline' to a ByteString 'Builder'-printNewline :: Newline -> Builder-printNewline = Builder.lazyByteString . newlineToString---- | Convert a 'Field' to a ByteString 'Builder'-printField :: PrintOptions s -> Field s -> Builder-printField opts f =-  case f of-    Unquoted s ->-      view build opts s-    Quoted q s ->-      let qc = quoteToString q-          contents = view build opts $ view escape opts (review quoteChar q) s-      in  qc <> contents <> qc---- | Convert a 'SpacedField' to a ByteString 'Builder'-printSpaced :: PrintOptions s -> SpacedField s -> Builder-printSpaced opts (Spaced b t a) =-  let spc = foldMap (Builder.charUtf8 . spaceToChar)-  in  spc b <> printField opts a <> spc t---- | Convert a 'Record' to a ByteString 'Builder'-printRecord :: PrintOptions s -> Separator -> Record s -> Builder-printRecord opts sep (Record fs) =-  intercalate1 (Builder.charUtf8 sep) (fmap (printSpaced opts) fs)---- | Convert 'Records' to a ByteString 'Builder'.-printRecords :: PrintOptions s -> Separator -> Records s -> Builder-printRecords opts sep rs = case rs of-  EmptyRecords -> mempty-  Records a as ->-    printRecord opts sep a <> foldMap (bifoldMap printNewline (printRecord opts sep)) as---- | Convert 'Header' to a ByteString 'Builder'.-printHeader :: PrintOptions s -> Separator -> Header s -> Builder-printHeader opts sep (Header r n) = printRecord opts sep r <> printNewline n
− src/Data/Sv/Print/Options.hs 
@@ -1,80 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE FlexibleInstances #-}--{-|-Module      : Data.Sv.Print.Options-Copyright   : (C) CSIRO 2017-2018-License     : BSD3-Maintainer  : George Wilson <george.wilson@data61.csiro.au>-Stability   : experimental-Portability : non-portable--}--module Data.Sv.Print.Options (-  PrintOptions (..)-  , HasPrintOptions (..)-  , defaultPrintOptions-  , utf8PrintOptions-  , utf8LazyPrintOptions-  , textPrintOptions-  , stringPrintOptions-) where--import Control.Lens-import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as BL-import Data.ByteString.Builder (Builder)-import qualified Data.ByteString.Builder as Builder-import Data.Text (Text)-import qualified Data.Text.Encoding as Text--import Text.Escape (Escaper', escapeUtf8, escapeUtf8Lazy, escapeText, escapeString)---- | Options to configure the printing process-data PrintOptions a =-  PrintOptions {-    -- | How do I convert these values into ByteString 'Builder's? This depends-    -- not only on type, but on character encoding. Default: 'utf8PrintOptions'-    _build :: a -> Builder-    -- | How do I escape quotes which appear in this value? Default: 'escapeUtf8'-  , _escape :: Escaper' a-  }---- | Classy optics for 'PrintOptions'-class HasPrintOptions c a | c -> a where-  printOptions :: Lens' c (PrintOptions a)-  build :: Lens' c (a -> Builder)-  {-# INLINE build #-}-  escape :: Lens' c (Escaper' a)-  {-# INLINE escape #-}-  build = printOptions . build-  escape = printOptions . escape--instance HasPrintOptions (PrintOptions a) a where-  printOptions = id-  {-# INLINE printOptions #-}-  build f (PrintOptions x1 x2) = fmap (\ y -> PrintOptions y x2) (f x1)-  {-# INLINE build #-}-  escape f (PrintOptions x1 x2) = fmap (PrintOptions x1) (f x2)-  {-# INLINE escape #-}---- | Print options for 'Sv's containing UTF-8 bytestrings-defaultPrintOptions :: PrintOptions BS.ByteString-defaultPrintOptions = utf8PrintOptions---- | Print options for 'Sv's containing UTF-8 bytestrings-utf8PrintOptions :: PrintOptions BS.ByteString-utf8PrintOptions = PrintOptions Builder.byteString escapeUtf8---- | Print options for 'Sv's containing UTF-8 lazy bytestrings-utf8LazyPrintOptions :: PrintOptions BL.ByteString-utf8LazyPrintOptions = PrintOptions Builder.lazyByteString escapeUtf8Lazy---- | Print options for 'Sv's containing 'Text'-textPrintOptions :: PrintOptions Text-textPrintOptions = PrintOptions (Builder.byteString . Text.encodeUtf8) escapeText---- | Print options for 'Sv's containing 'String's-stringPrintOptions :: PrintOptions String-stringPrintOptions = PrintOptions Builder.stringUtf8 escapeString
+ src/Data/Sv/Structure.hs view
@@ -0,0 +1,14 @@+{-|+Module      : Data.Sv.Structure+Copyright   : (C) CSIRO 2017-2018+License     : BSD3+Maintainer  : George Wilson <george.wilson@data61.csiro.au>+Stability   : experimental+Portability : non-portable+-}++module Data.Sv.Structure (+  module Data.Sv.Structure.Core+) where++import Data.Sv.Structure.Core
− src/Data/Sv/Syntax.hs 
@@ -1,18 +0,0 @@-{-|-Module      : Data.Sv.Syntax-Copyright   : (C) CSIRO 2017-2018-License     : BSD3-Maintainer  : George Wilson <george.wilson@data61.csiro.au>-Stability   : experimental-Portability : non-portable--}--module Data.Sv.Syntax (-  module Data.Sv.Syntax.Field-, module Data.Sv.Syntax.Record-, module Data.Sv.Syntax.Sv-) where--import Data.Sv.Syntax.Field-import Data.Sv.Syntax.Record-import Data.Sv.Syntax.Sv
− src/Data/Sv/Syntax/Field.hs 
@@ -1,116 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE DeriveGeneric #-}--{-|-Module      : Data.Sv.Syntax.Field-Copyright   : (C) CSIRO 2017-2018-License     : BSD3-Maintainer  : George Wilson <george.wilson@data61.csiro.au>-Stability   : experimental-Portability : non-portable--}--module Data.Sv.Syntax.Field (-    Field (Unquoted, Quoted)-  , SpacedField-  , Spaced (Spaced)-  , HasFields (fields)-  , AsField (_Field, _Unquoted, _Quoted)-  , unescapedField-  , foldField-  , fieldContents-) where--import Control.DeepSeq (NFData)-import Control.Lens (Lens, Prism', Traversal, lens, prism)-import Data.Foldable (Foldable (foldMap))-import Data.Functor (Functor (fmap))-import Data.Traversable (Traversable (traverse))-import GHC.Generics (Generic)--import Text.Escape (Unescaped (Unescaped, getRawUnescaped))-import Text.Quote (Quote)-import Text.Space (Spaced (Spaced))---- | A 'Field' is a single cell from a CSV document.------ Its value is either 'Quoted', which indicates the type of quote--- surrounding the value, or it is 'Unquoted', containing only the value.-data Field s =-    Unquoted s-  | Quoted Quote (Unescaped s)-  deriving (Eq, Ord, Show, Generic)--instance NFData s => NFData (Field s)--instance Functor Field where-  fmap f fi = case fi of-    Unquoted s -> Unquoted (f s)-    Quoted q v -> Quoted q (fmap f v)--instance Foldable Field where-  foldMap f fi = case fi of-    Unquoted s -> f s-    Quoted _ v -> foldMap f v--instance Traversable Field where-  traverse f fi = case fi of-    Unquoted s -> Unquoted <$> f s-    Quoted q v -> Quoted q <$> traverse f v---- | 'Field's are often surrounded by spaces-type SpacedField a = Spaced (Field a)---- | Classy prisms for 'Field'-class (HasFields s s a a) => AsField s a | s -> a where-  _Field :: Prism' s (Field a)-  _Unquoted :: Prism' s a-  _Quoted :: Prism' s (Quote, Unescaped a)-  _Unquoted = _Field . _Unquoted-  {-# INLINE _Unquoted #-}-  _Quoted = _Field . _Quoted-  {-# INLINE _Quoted #-}--instance AsField (Field a) a where-  _Field = id-  {-# INLINE _Field #-}-  _Unquoted = prism Unquoted-    (\x -> case x of-      Unquoted y -> Right y-      _          -> Left x-    )-  {-# INLINE _Unquoted #-}-  _Quoted = prism (uncurry Quoted)-    (\x -> case x of-      Quoted y z -> Right (y,z)-      _          -> Left x-    )-  {-# INLINE _Quoted #-}---- | Classy 'Traversal'' for things containing 'Field's-class HasFields c d s t | c -> s, d -> t, c t -> d, d s -> c where-  fields :: Traversal c d (Field s) (Field t)--instance HasFields (Field s) (Field t) s t where-  fields = id-  {-# INLINE fields #-}---- | Build a quoted field with a normal string-unescapedField :: Quote -> s -> Field s-unescapedField q s = Quoted q (Unescaped s)---- | The catamorphism for @Field'@-foldField :: (s -> b) -> (Quote -> Unescaped s -> b) -> Field s -> b-foldField u q fi = case fi of-  Unquoted s -> u s-  Quoted a b -> q a b---- | Lens into the contents of a Field, regardless of whether it's quoted or unquoted-fieldContents :: Lens (Field s) (Field t) s t-fieldContents =-  lens (foldField id (const getRawUnescaped)) $ \f b -> case f of-    Unquoted _ -> Unquoted b-    Quoted q _ -> Quoted q (Unescaped b)
− src/Data/Sv/Syntax/Record.hs 
@@ -1,176 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE DeriveGeneric #-}--{-|-Module      : Data.Sv.Syntax.Record-Copyright   : (C) CSIRO 2017-2018-License     : BSD3-Maintainer  : George Wilson <george.wilson@data61.csiro.au>-Stability   : experimental-Portability : non-portable--This module contains datatypes for Records. A record is a "line" or "row"-of a CSV document--}-module Data.Sv.Syntax.Record (-  Record (Record, _fields)-  -- Optics-  , HasRecord (record, spacedFields)-  , recordSpacedFieldsIso-  , emptyRecord-  , singleField-  , recordNel-  , Records (EmptyRecords, Records)-  , HasRecords (records, traverseRecords, traverseNewlines)-  , _EmptyRecords-  , _NonEmptyRecords-  , mkRecords-  , singleRecord-  , recordList-) where--import Control.DeepSeq (NFData)-import Control.Lens (Lens, Lens', Iso, Prism, Prism', Traversal', _1, _2, beside, iso, prism, prism', toListOf)-import Data.Foldable (Foldable (foldMap))-import Data.Functor (Functor (fmap))-import Data.List.NonEmpty (NonEmpty ((:|)))-import Data.Semigroup (Semigroup)-import Data.Traversable (Traversable (traverse))-import GHC.Generics (Generic)--import Data.Sv.Syntax.Field (SpacedField, Field (Unquoted), HasFields (fields))-import Data.Vector.NonEmpty (NonEmptyVector)-import Data.Vector (Vector)-import qualified Data.Vector as V-import qualified Data.Vector.NonEmpty as V-import Text.Newline (Newline)-import Text.Space (Spaced, spacedValue)---- | A @Record@ is a non-empty collection of Fields, implicitly separated--- by a separator (often a comma).-newtype Record s =-  Record {-    _fields :: NonEmptyVector (Spaced (Field s))-  }-  deriving (Eq, Ord, Show, Semigroup, Generic)--instance NFData s => NFData (Record s)---- | A 'Record' is isomorphic to a 'NonEmpty' list of 'SpacedField's-recordSpacedFieldsIso :: Iso (Record s) (Record a) (NonEmptyVector (Spaced (Field s))) (NonEmptyVector (Spaced (Field a)))-recordSpacedFieldsIso = iso _fields Record-{-# INLINE recordSpacedFieldsIso #-}---- | Classy lenses for 'Record'-class HasRecord s t a b | s -> a, t -> b where-  record :: Lens s t (Record a) (Record b)-  spacedFields :: Lens s t (NonEmptyVector (Spaced (Field a))) (NonEmptyVector (Spaced (Field b)))-  {-# INLINE spacedFields #-}-  spacedFields = record . spacedFields--instance HasRecord (Record a) (Record b) a b where-  record = id-  {-# INLINE record #-}-  spacedFields = recordSpacedFieldsIso-  {-# INLINE spacedFields #-}--instance HasFields (Record a) (Record b) a b where-  fields = spacedFields . traverse . spacedValue--instance Functor Record where-  fmap f = Record . fmap (fmap (fmap f)) . _fields--instance Foldable Record where-  foldMap f = foldMap (foldMap (foldMap f)) . _fields--instance Traversable Record where-  traverse f = fmap Record . traverse (traverse (traverse f)) . _fields---- | Build an empty record.------ According to RFC 4180, a record must have at least one field.--- But a field can be the empty string. So this is the closest we can get to--- an empty record.------ Note that this does not make 'Record' a 'Monoid'. It is not a lawful unit--- for the 'Semigroup' operation.-emptyRecord :: Monoid s => Record s-emptyRecord = singleField (Unquoted mempty)---- | Build a 'Record' with just one 'Field'-singleField :: Field s -> Record s-singleField = Record . pure . pure---- | Build a 'Record' given a 'NonEmpty' list of its fields-recordNel :: NonEmpty (SpacedField s) -> Record s-recordNel = Record . V.fromNel---- | A collection of records, separated by newlines.-data Records s =-  EmptyRecords-  | Records (Record s) (Vector (Newline, Record s))-    deriving (Eq, Ord, Show, Generic)--instance NFData s => NFData (Records s)---- | Prism for an empty 'Records'-_EmptyRecords :: Prism' (Records s) ()-_EmptyRecords =-  prism' (const EmptyRecords) $ \r ->-    case r of-      EmptyRecords -> Just ()-      Records _ _  -> Nothing---- | Prism for a non-empty 'Records'-_NonEmptyRecords :: Prism (Records s) (Records t) (Record s, Vector (Newline, Record s)) (Record t, Vector (Newline, Record t))-_NonEmptyRecords =-  prism (uncurry Records) $ \r ->-    case r of-      EmptyRecords -> Left EmptyRecords-      Records a as -> Right (a,as)---- | Classy lenses for 'Records'-class HasRecords c s | c -> s where-  records :: Lens' c (Records s)-  traverseRecords :: Traversal' c (Record s)-  traverseRecords = records . _NonEmptyRecords . beside id (traverse . _2)-  {-# INLINE traverseRecords #-}-  traverseNewlines :: Traversal' c Newline-  traverseNewlines = records . _NonEmptyRecords . _2 . traverse . _1--instance HasRecords (Records s) s where-  records = id-  {-# INLINE records #-}--instance Functor Records where-  fmap f rs = case rs of-    EmptyRecords -> EmptyRecords-    Records a as -> Records (fmap f a) (fmap (fmap (fmap f)) as)--instance Foldable Records where-  foldMap f rs = case rs of-    EmptyRecords -> mempty-    Records a as -> foldMap f a `mappend` foldMap (foldMap (foldMap f)) as--instance Traversable Records where-  traverse f rs = case rs of-    EmptyRecords -> pure EmptyRecords-    Records a as -> Records <$> traverse f a <*> traverse (traverse (traverse f)) as---- | Convenience constructor for 'Records'.------ This puts the same newline between all the records.-mkRecords :: Newline -> NonEmpty (Record s) -> Records s-mkRecords n (r:|rs) = Records r (V.fromList (fmap (n,) rs))---- | A record collection conaining one record-singleRecord :: Record s -> Records s-singleRecord s = Records s V.empty---- | Collect the list of 'Record's from anything that 'HasRecords'-recordList :: HasRecords c s => c -> [Record s]-recordList = toListOf traverseRecords
− src/Data/Sv/Syntax/Sv.hs 
@@ -1,219 +0,0 @@-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE FlexibleInstances#-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE DeriveGeneric #-}--{-|-Module      : Data.Sv.Syntax.Sv-Copyright   : (C) CSIRO 2017-2018-License     : BSD3-Maintainer  : George Wilson <george.wilson@data61.csiro.au>-Stability   : experimental-Portability : non-portable--This file defines a datatype for a complete Sv document.-The datatype preserves information such as whitespace so that the original-text can be recovered.--In the usual workflow, this type is only an intermediate stage between-parsing and decoding. You can program against it directly using the provided-functions and optics if you'd like. For an example of this see-<https://github.com/qfpl/sv/blob/master/examples/src/Data/Sv/Example/Requote.hs Requote.hs>--}--module Data.Sv.Syntax.Sv (-  Sv (Sv, _separatorSv, _maybeHeader, _records, _finalNewlines)-  , HasSv (sv, maybeHeader, traverseHeader, finalNewlines)-  , HasRecords (records, traverseNewlines, traverseRecords)-  , mkSv-  , emptySv-  , recordList-  , Header (Header, _headerRecord)-  , HasHeader (header, headerRecord, headerNewline)-  , noHeader-  , mkHeader-  , Headedness (Unheaded, Headed)-  , HasHeadedness (headedness)-  , getHeadedness-  , Separator-  , HasSeparator (separator)-  , comma-  , pipe-  , tab-) where--import Control.DeepSeq (NFData)-import Control.Lens (Lens, Lens', Traversal')-import Data.Foldable (Foldable (foldMap))-import Data.Functor (Functor (fmap), (<$>))-import Data.Monoid ((<>))-import Data.Traversable (Traversable (traverse))-import GHC.Generics (Generic)--import Data.Sv.Syntax.Field (HasFields (fields))-import Data.Sv.Syntax.Record (Record, Records (EmptyRecords), HasRecord (record), HasRecords (records, traverseNewlines, traverseRecords), recordList)-import Text.Newline (Newline)---- | 'Sv' is a whitespace-preserving data type for separated values.---   Often the separator is a comma, but this type does not make that---   assumption so that it can be used for pipe- or tab-separated values---   as well.-data Sv s =-  Sv {-    _separatorSv :: Separator-  , _maybeHeader :: Maybe (Header s)-  , _records :: Records s-  , _finalNewlines :: [Newline]-  }-  deriving (Eq, Ord, Show, Generic)--instance NFData s => NFData (Sv s)---- | Classy lenses for 'Sv'-class (HasRecords c s, HasSeparator c) => HasSv c s | c -> s where-  sv :: Lens' c (Sv s)-  maybeHeader :: Lens' c (Maybe (Header s))-  {-# INLINE maybeHeader #-}-  traverseHeader :: Traversal' c (Header s)-  {-# INLINE traverseHeader #-}-  finalNewlines :: Lens' c [Newline]-  {-# INLINE finalNewlines #-}-  maybeHeader = sv . maybeHeader-  traverseHeader = maybeHeader . traverse-  finalNewlines = sv . finalNewlines--instance HasRecords (Sv s) s where-  records f (Sv x1 x2 x3 x4) =-    fmap (\y -> Sv x1 x2 y x4) (f x3)-  {-# INLINE records #-}--instance HasSv (Sv s) s where-  sv = id-  {-# INLINE sv #-}-  maybeHeader f (Sv x1 x2 x3 x4) =-    fmap (\y -> Sv x1 y x3 x4) (f x2)-  {-# INLINE maybeHeader #-}-  finalNewlines f (Sv x1 x2 x3 x4) =-    fmap (Sv x1 x2 x3) (f x4)-  {-# INLINE finalNewlines #-}---- | Convenience constructor for Sv-mkSv :: Separator -> Maybe (Header s) -> [Newline] -> Records s -> Sv s-mkSv c h ns rs = Sv c h rs ns---- | An empty Sv-emptySv :: Separator -> Sv s-emptySv c = Sv c Nothing EmptyRecords []--instance Functor Sv where-  fmap f (Sv s h rs e) = Sv s (fmap (fmap f) h) (fmap f rs) e--instance Foldable Sv where-  foldMap f (Sv _ h rs _) = foldMap (foldMap f) h <> foldMap f rs--instance Traversable Sv where-  traverse f (Sv s h rs e) = Sv s <$> traverse (traverse f) h <*> traverse f rs <*> pure e---- | Determine the 'Headedness' of an 'Sv'-getHeadedness :: Sv s -> Headedness-getHeadedness = maybe Unheaded (const Headed) . _maybeHeader---- | A 'Header' is present in many CSV documents, usually listing the names--- of the columns. We keep this separate from the regular records.-data Header s =-  Header {-    _headerRecord :: Record s-  , _headerNewline :: Newline-  }-  deriving (Eq, Ord, Show, Functor, Foldable, Traversable, Generic)--instance NFData s => NFData (Header s)---- | Classy lenses for 'Header'-class HasHeader s t a b | s -> a, t -> b, s b -> t, t a -> s where-  header :: Lens s t (Header a) (Header b)-  headerNewline :: (s ~ t) => Lens s t Newline Newline-  {-# INLINE headerNewline #-}-  headerRecord :: Lens s t (Record a) (Record b)-  {-# INLINE headerRecord #-}-  default headerNewline :: (a ~ b) => Lens s t Newline Newline-  headerNewline = header . headerNewline-  headerRecord = header . headerRecord--instance HasHeader (Header a) (Header b) a b where-  header = id-  {-# INLINE header #-}-  headerNewline f (Header x1 x2)-    = fmap (Header x1) (f x2)-  {-# INLINE headerNewline #-}-  headerRecord f (Header x1 x2)-    = fmap (\y -> Header y x2) (f x1)-  {-# INLINE headerRecord #-}--instance HasRecord (Header a) (Header b) a b where-  record = headerRecord-  {-# INLINE record #-}--instance HasFields (Header a) (Header b) a b where-  fields = headerRecord . fields---- | Used to build 'Sv's that don't have a header-noHeader :: Maybe (Header s)-noHeader = Nothing---- | Convenience constructor for 'Header', usually when you're building 'Sv's-mkHeader :: Record s -> Newline -> Maybe (Header s)-mkHeader r n = Just (Header r n)---- | Does the 'Sv' have a 'Header' or not? A header is a row at the beginning--- of a file which contains the string names of each of the columns.------ If a header is present, it must not be decoded with the rest of the data.-data Headedness =-  Unheaded | Headed-  deriving (Eq, Ord, Show)---- | Classy lens for 'Headedness'-class HasHeadedness c where-  headedness :: Lens' c Headedness--instance HasHeadedness Headedness where-  headedness = id---- | By what are your values separated? The answer is often 'comma', but not always.------ A 'Separator' is just a 'Char'. It could be a sum type instead, since it--- will usually be comma or pipe, but our preference has been to be open here--- so that you can use whatever you'd like. There are test cases, for example,--- ensuring that you're free to use null-byte separated values if you so desire.-type Separator = Char---- | Classy lens for 'Separator'-class HasSeparator c where-  separator :: Lens' c Separator--instance HasSeparator Char where-  separator = id-  {-# INLINE separator #-}--instance HasSeparator (Sv s) where-  separator f (Sv x1 x2 x3 x4) =-    fmap (\y -> Sv y x2 x3 x4) (f x1)-  {-# INLINE separator #-}---- | The venerable comma separator. Used for CSV documents.-comma :: Separator-comma = ','---- | The pipe separator. Used for PSV documents.-pipe :: Separator-pipe = '|'---- | Tab is a separator too - why not?-tab :: Separator-tab = '\t'
− src/Data/Vector/NonEmpty.hs 
@@ -1,79 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}--{-|-Module      : Data.Vector.NonEmpty-Copyright   : (C) CSIRO 2017-2018-License     : BSD3-Maintainer  : George Wilson <george.wilson@data61.csiro.au>-Stability   : experimental-Portability : non-portable--}--module Data.Vector.NonEmpty (-  NonEmptyVector (NonEmptyVector)-, fromNel-, toNel-, headNev-, tailNev-) where--import Control.DeepSeq (NFData)-import Control.Lens (Lens', lens)-import Data.Functor.Apply (Apply((<.>)))-import Data.Foldable (toList)-import Data.List.NonEmpty (NonEmpty ((:|)))-import Data.Semigroup (Semigroup ((<>)))-import Data.Semigroup.Foldable (Foldable1 (foldMap1))-import Data.Semigroup.Traversable (Traversable1 (traverse1))-import Data.Vector (Vector)-import qualified Data.Vector as V-import GHC.Generics (Generic)---- | A non-empty value of 'Vector'-data NonEmptyVector a =-  NonEmptyVector a (Vector a)-  deriving (Eq, Ord, Show, Generic)--instance NFData a => NFData (NonEmptyVector a) where---- | Convert a 'NonEmpty' list to a 'NonEmptyVector'-fromNel :: NonEmpty a -> NonEmptyVector a-fromNel (a :| as) = NonEmptyVector a (V.fromList as)---- | Convert a 'NonEmptyVector' to a 'NonEmpty' list-toNel :: NonEmptyVector a -> NonEmpty a-toNel (NonEmptyVector a as) = a :| V.toList as--instance Functor NonEmptyVector where-  fmap f (NonEmptyVector a as) = NonEmptyVector (f a) (fmap f as)--instance Apply NonEmptyVector where-  (<.>) = (<*>)--instance Applicative NonEmptyVector where-  pure a = NonEmptyVector a V.empty-  ff <*> fa = fromNel (toNel ff <*> toNel fa)--instance Foldable NonEmptyVector where-  foldMap f (NonEmptyVector a as) = f a `mappend` foldMap f as--instance Foldable1 NonEmptyVector where-  foldMap1 f (NonEmptyVector a as) = foldMap1 f (a :| toList as)--instance Traversable NonEmptyVector where-  traverse f (NonEmptyVector a as) = NonEmptyVector <$> f a <*> traverse f as--instance Traversable1 NonEmptyVector where-  traverse1 f = fmap fromNel . traverse1 f . toNel--instance Semigroup (NonEmptyVector a) where-  NonEmptyVector a as <> NonEmptyVector b bs =-    NonEmptyVector a (V.concat [as, V.singleton b, bs])---- | Get or set the head of a 'NonEmptyVector'-headNev :: Lens' (NonEmptyVector a) a-headNev = lens (\(NonEmptyVector h _) -> h) (\(NonEmptyVector _ t) h -> NonEmptyVector h t)---- | Get or set the head of a 'NonEmptyVector'-tailNev :: Lens' (NonEmptyVector a) (Vector a)-tailNev = lens (\(NonEmptyVector _ t) -> t) (\(NonEmptyVector h _) t -> NonEmptyVector h t)
− src/Text/Escape.hs 
@@ -1,124 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE DeriveGeneric #-}--{-|-Module      : Text.Escape-Copyright   : (C) CSIRO 2017-2018-License     : BSD3-Maintainer  : George Wilson <george.wilson@data61.csiro.au>-Stability   : experimental-Portability : non-portable--Quote characters can be escaped in CSV documents by using two quote characters-instead of one. sv's parser will unescape these sequences as it parses them, so-it wraps them in the newtype 'Unescaped'--Encoding requires you to provide an 'Escaper', which is a function to escape-strings on the way out.--}--module Text.Escape (-  Unescaped (Unescaped, getRawUnescaped)-  , Escaper-  , Escaper'-  , escapeString-  , escapeText-  , escapeUtf8-  , escapeUtf8Lazy-  , escapeChar-) where--import Control.DeepSeq (NFData)-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as L-import qualified Data.ByteString.UTF8 as UTF8-import qualified Data.ByteString.Lazy.UTF8 as UTF8L-import Data.Foldable (Foldable)-import Data.Functor (Functor)-import Data.Monoid (Monoid)-import Data.Semigroup (Semigroup ((<>)))-import Data.Text (Text)-import qualified Data.Text as Text-import Data.Traversable (Traversable)-import GHC.Generics (Generic)---- | Wrapper for text that is known to be in an unescaped form-newtype Unescaped a =-  Unescaped { getRawUnescaped :: a }-  deriving (Eq, Ord, Show, Semigroup, Monoid, Functor, Foldable, Traversable, Generic)--instance NFData a => NFData (Unescaped a)---- | A function that, given a char, escapes all occurrences of that char.------ This version allows the escaping to be type-changing. For example, escaping--- a single char can result in a string with two characters.-type Escaper s t = Char -> Unescaped s -> t---- | A function that, given a char, escapes all occurrences of that char.-type Escaper' a = Char -> Unescaped a -> a---- | Replaces all occurrences of the given character with two occurrences of that--- character, non-recursively, in the given 'String'.------ >>> escapeString ''' "hello 'string'"--- "hello ''string''"----escapeString :: Escaper' String-escapeString c = concatMap (doubleChar c) . getRawUnescaped---- | Replaces all occurrences of the given character with two occurrences of that--- character in the given 'Text'------ @--- {- LANGUAGE OverloadedStrings -}------ >>> escapeText ''' "hello 'text'"--- "hello ''text''"--- @-escapeText :: Escaper' Text-escapeText c =-  let ct = Text.singleton c-  in  Text.replace ct (ct <> ct) . getRawUnescaped---- | Replaces all occurrences of the given character with two occurrences of that--- character in the given ByteString, which is assumed to be UTF-8 compatible.------ @--- {- LANGUAGE OverloadedStrings -}--- >>> escapeUtf8 ''' "hello 'bytestring'"--- "hello ''bytestring''"--- @-escapeUtf8 :: Escaper' B.ByteString-escapeUtf8 c =-  UTF8.fromString . concatMap (doubleChar c) . UTF8.toString . getRawUnescaped---- | Replaces all occurrences of the given character with two occurrences of that--- character in the given lazy ByteString, which is assumed to be UTF-8 compatible.------ @--- {- LANGUAGE OverloadedStrings -}------ >>> escapeUtf8Lazy ''' "hello 'lazy bytestring'"--- "hello ''lazy bytestring''"--- @-escapeUtf8Lazy :: Escaper' L.ByteString-escapeUtf8Lazy c =-  UTF8L.fromString . concatMap (doubleChar c) . UTF8L.toString . getRawUnescaped---- | Escape a character, which must return a string.------ >>> escapeChar ''' '''--- "''"------ >>> escapeChar ''' 'z'--- "z"----escapeChar :: Escaper Char String-escapeChar c = doubleChar c . getRawUnescaped--doubleChar :: Char -> Char -> String-doubleChar q z = if z == q then [q,q] else [z]
− src/Text/Newline.hs 
@@ -1,84 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--{-|-Module      : Text.Newline-Copyright   : (C) CSIRO 2017-2018-License     : BSD3-Maintainer  : George Wilson <george.wilson@data61.csiro.au>-Stability   : experimental-Portability : non-portable--A sum type for line endings--}--module Text.Newline (-  Newline (CR, LF, CRLF)-  , AsNewline(_Newline, _CR, _LF, _CRLF)-  , newlineToString-  , parseNewline-) where--import Control.DeepSeq (NFData (rnf))-import Control.Lens (Prism', prism, prism')-import Data.String (IsString (fromString))-import Data.Text (Text)---- | 'Newline' is a sum type for line endings-data Newline =-  -- | > "\r"-  CR-  -- | > "\n"-  | LF-  -- | > "\rn"-  | CRLF-  deriving (Eq, Ord, Show)--instance NFData Newline where-  rnf x = seq x ()---- | 'AsNewline' is a classy prism for 'Newline'-class AsNewline r where-  _Newline :: Prism' r Newline-  _CR :: Prism' r ()-  _LF :: Prism' r ()-  _CRLF :: Prism' r ()-  _CR = _Newline . _CR-  _LF = _Newline . _LF-  _CRLF = _Newline . _CRLF--instance AsNewline Newline where-  _Newline = id-  _CR =-    prism (const CR) $ \x -> case x of-      CR -> Right ()-      _  -> Left x-  _LF =-    prism (const LF) $ \x -> case x of-      LF -> Right ()-      _  -> Left x-  _CRLF =-    prism (const CRLF) $ \x -> case x of-      CRLF -> Right ()-      _    -> Left x--instance AsNewline Text where-  _Newline = prism' newlineToString parseNewline---- | Convert a 'Newline' to a 'String'. Since this uses 'Data.String.IsString',--- it works for other data types, like 'Data.Text.Text' or--- 'Data.ByteString.ByteString'.-newlineToString :: IsString s => Newline -> s-newlineToString n = fromString $-  case n of-    CR -> "\r"-    LF -> "\n"-    CRLF -> "\r\n"---- | Try to parse text into a 'Newline'-parseNewline :: Text -> Maybe Newline-parseNewline ""   = Nothing-parseNewline "\r" = Just CR-parseNewline "\n" = Just LF-parseNewline "\r\n" = Just CRLF-parseNewline _ = Nothing-
− src/Text/Quote.hs 
@@ -1,72 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeFamilies #-}--{-|-Module      : Text.Quote-Copyright   : (C) CSIRO 2017-2018-License     : BSD3-Maintainer  : George Wilson <george.wilson@data61.csiro.au>-Stability   : experimental-Portability : non-portable--A sum type for quote characters--}--module Text.Quote (-  Quote (SingleQuote, DoubleQuote)-  , AsQuote (_Quote, _SingleQuote, _DoubleQuote)-  , quoteChar-  , quoteToString-) where--import Control.DeepSeq (NFData (rnf))-import Control.Lens (Prism', prism, prism', review)-import Data.String (IsString (fromString))---- | A sum type for quote characters. Either single or double quotes.-data Quote =-    SingleQuote-  | DoubleQuote-  deriving (Eq, Ord, Show)--instance NFData Quote where-  rnf x = seq x ()---- | Classy prisms for 'Quote'-class AsQuote r where-  _Quote :: Prism' r Quote-  _SingleQuote :: Prism' r ()-  _DoubleQuote :: Prism' r ()-  _SingleQuote = _Quote . _SingleQuote-  _DoubleQuote = _Quote . _DoubleQuote--instance AsQuote Quote where-  _Quote = id-  _SingleQuote = prism (const SingleQuote) $ \x -> case x of-    SingleQuote -> Right ()-    DoubleQuote -> Left x-  _DoubleQuote = prism (const DoubleQuote) $ \x -> case x of-    SingleQuote -> Left x-    DoubleQuote -> Right ()--instance AsQuote Char where-  _Quote = quoteChar---- | Convert a Quote to the Char it represents.-quoteChar :: Prism' Char Quote-quoteChar =-  prism'-    (\q -> case q of-      SingleQuote -> '\''-      DoubleQuote -> '"')-    (\c -> case c of-      '\'' -> Just SingleQuote-      '"'  -> Just DoubleQuote-      _    -> Nothing)---- | Convert a 'Quote' to a 'String'. Since this uses 'Data.String.IsString',--- it works for other data types, like 'Data.Text.Text' or--- 'Data.ByteString.ByteString'.-quoteToString :: IsString a => Quote -> a-quoteToString = fromString . pure . review quoteChar
− src/Text/Space.hs 
@@ -1,190 +0,0 @@-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE DeriveGeneric #-}--{-|-Module      : Text.Space-Copyright   : (C) CSIRO 2017-2018-License     : BSD3-Maintainer  : George Wilson <george.wilson@data61.csiro.au>-Stability   : experimental-Portability : non-portable--A sum type for space characters--}--module Text.Space-  ( HorizontalSpace (Space, Tab)-  , AsHorizontalSpace (_HorizontalSpace, _Space, _Tab)-  , Spaces-  , single-  , manySpaces-  , tab-  , spaceToChar-  , charToSpace-  , spacesText-  , spacesString-  , Spaced (Spaced, _before, _after, _value)-  , HasSpaced (spaced, spacedValue, before, after)-  , betwixt-  , uniform-  , unspaced-  , removeSpaces-  )-where--import Control.DeepSeq (NFData (rnf))-import Control.Lens (Lens, Prism', prism, prism')-import Data.Semigroup (Semigroup ((<>)))-import Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.Vector as V-import GHC.Generics (Generic)---- | 'HorizontalSpace' is a subset of 'Char'. To move back and forth betwen--- it and 'Char', 'String', or 'Data.Text.Text', use '_HorizontalSpace'-data HorizontalSpace =-  Space-  | Tab-  deriving (Eq, Ord, Show)--instance NFData HorizontalSpace where-  rnf x = seq x ()---- | Classy prisms for 'HorizontalSpace's-class AsHorizontalSpace r where-  _HorizontalSpace :: Prism' r HorizontalSpace-  _Space :: Prism' r ()-  _Tab :: Prism' r ()-  _Space = _HorizontalSpace . _Space-  _Tab = _HorizontalSpace . _Tab--instance AsHorizontalSpace HorizontalSpace where-  _HorizontalSpace = id-  _Space =-    prism (const Space) $ \x ->-      case x of-        Space -> Right ()-        _     -> Left x-  _Tab =-    prism (const Tab) $ \x ->-      case x of-        Tab -> Right ()-        _   -> Left x--instance AsHorizontalSpace Char where-  _HorizontalSpace = prism' spaceToChar charToSpace---- | Helpful alias for lists of 'Space's-type Spaces = V.Vector HorizontalSpace---- | One space-single :: Spaces-single = V.singleton Space---- | As many spaces as you'd like-manySpaces :: Int -> Spaces-manySpaces = flip V.replicate Space---- | One tab-tab :: Spaces-tab = V.singleton Tab---- | Turn a 'Space' into a 'Char'. To go the other way, see 'charToSpace'-spaceToChar :: HorizontalSpace -> Char-spaceToChar Space = ' '-spaceToChar Tab = '\t'---- | Try to turn a 'Char' into a Space. To go the other way, see 'spaceToChar'-charToSpace :: Char -> Maybe HorizontalSpace-charToSpace c = case c of-  ' '  -> Just Space-  '\t' -> Just Tab-  _    -> Nothing---- | Parse 'Text' into 'Spaces', or turn spaces into 'Data.Text.Text'-spacesText :: Prism' Text Spaces-spacesText =-  prism'-    (Text.pack . foldMap (pure . spaceToChar))-    (fmap V.fromList . traverse charToSpace . Text.unpack)---- | Parse 'String' into 'Spaces', or convert 'Spaces' into 'String'-spacesString :: Prism' String Spaces-spacesString =-  prism'-    (fmap spaceToChar . V.toList)-    (fmap V.fromList . traverse charToSpace)---- | 'Spaced' is a value with zero or many horizontal spaces around it on--- both sides.-data Spaced a =-  Spaced {-    _before :: Spaces-  , _after :: Spaces-  , _value :: a-  }-  deriving (Eq, Ord, Show, Generic)--instance NFData a => NFData (Spaced a)---- | Classy lenses for 'Spaced'-class HasSpaced s t a b | s -> a, t -> b, s b -> t, t a -> s where-  spaced :: Lens s t (Spaced a) (Spaced b)-  after :: (s ~ t) => Lens s t Spaces Spaces-  {-# INLINE after #-}-  before :: (s ~ t) => Lens s t Spaces Spaces-  {-# INLINE before #-}-  spacedValue :: Lens s t a b-  {-# INLINE spacedValue #-}-  default after :: (s ~ t, a ~ b) => Lens s t Spaces Spaces-  after = spaced . after-  default before :: (s ~ t, a ~ b) => Lens s t Spaces Spaces-  before = spaced . before-  default spacedValue :: (s ~ t, a ~ b) => Lens s t a b-  spacedValue = spaced . spacedValue--instance HasSpaced (Spaced a) (Spaced b) a b where-  {-# INLINE after #-}-  {-# INLINE before #-}-  {-# INLINE spacedValue #-}-  spaced = id-  before f (Spaced x y z) = fmap (\w -> Spaced w y z) (f x)-  spacedValue f (Spaced x y z) = fmap (Spaced x y) (f z)-  after f (Spaced x y z) = fmap (\w -> Spaced x w z) (f y)--instance Functor Spaced where-  fmap f (Spaced b t a) = Spaced b t (f a)---- | Appends the right parameter on the inside of the left parameter------ > Spaced "   " () " " *> Spaced "\t\t\t" () "\t \t" == Spaced "   \t\t\t" () "\t \t "-instance Applicative Spaced where-  pure = unspaced-  Spaced b t f <*> Spaced b' t' a = Spaced (b <> b') (t' <> t) (f a)--instance Foldable Spaced where-  foldMap f = f . _value--instance Traversable Spaced where-  traverse f (Spaced b t a) = fmap (Spaced b t) (f a)---- | 'betwixt' is just the constructor for 'Spaced' with a different--- argument order, which is sometimes useful.-betwixt :: Spaces -> a -> Spaces -> Spaced a-betwixt b a t = Spaced b t a---- | Places its argument in a 'Spaced' with no spaces.-unspaced :: a -> Spaced a-unspaced = uniform mempty---- | 'uniform' puts the same spacing both before and after something.-uniform :: Spaces -> a -> Spaced a-uniform s a = Spaced s s a---- | Remove spaces from the argument-removeSpaces :: Spaced a -> Spaced a-removeSpaces = unspaced . _value
sv.cabal view
@@ -1,5 +1,5 @@ name:                sv-version:             0.1+version:             1.0 license:             BSD3 license-file:        LICENCE author:              George Wilson@@ -18,21 +18,17 @@   sv uses an Applicative combinator style for decoding and encoding, rather   than a type class based approach. This means we can have multiple decoders   for the same type, multiple combinators of the same type, and we never have-  to worry about orphan instances. These decoders can be stiched together from+  to worry about orphan instances. These decoders can be stitched together from   provided primitives and combinators, or you can build one from a parser   from your favourite parser combinator library.   .+  For parsing, sv uses <https://hackage.haskell.org/package/hw-dsv hw-dsv>, a high performance streaming CSV parser based on rank-select data structures.+  sv works with UTF-8, and should work with CP-1252 as well. It does not work+  with UTF-16 or UTF-32.+  .   sv returns values for all errors that occur - not just the first. Errors have   more structure than just a string, indicating what went wrong.   .-  sv's parser is exposed so you can use it independently of the decoding, and-  encoding and printing are similarly standalone.-  .-  sv focuses on correctness, on flexible and composable data types,-  and on useful and informative error values.-  Speed is also important to us, but it is not as important as these other-  qualities.-  .   sv tries not to be opinionated about how your data should look. We intend for   the user to have a great degree of freedom to build the right decoder for   their dataset.@@ -51,9 +47,24 @@   * Encoding data to a CSV: <https://github.com/qfpl/sv/blob/master/examples/src/Data/Sv/Example/Encoding.hs Encoding.hs>   * Handling NULL and Unknown occuring in a column of numbers: <https://github.com/qfpl/sv/blob/master/examples/src/Data/Sv/Example/Numbers.hs Numbers.hs>   * Dealing with non-rectangular data: <https://github.com/qfpl/sv/blob/master/examples/src/Data/Sv/Example/Ragged.hs Ragged.hs>-  * Handling multiple logical documents in one file: <https://github.com/qfpl/sv/blob/master/examples/src/Data/Sv/Example/Concat.hs Concat.hs>   * Integrating with an existing attoparsec parser to read date stamps: <https://github.com/qfpl/sv/blob/master/examples/src/Data/Sv/Example/TableTennis.hs TableTennis.hs>-  * Fixing inconsistent formatting with lenses: <https://github.com/qfpl/sv/blob/master/examples/src/Data/Sv/Example/Requote.hs Requote.hs>+  .+  To get the best performance, the hw-dsv parser and its dependencies+  underlying sv should be compiled with the flag @+bmi2@ to enable . These+  libraries are:  @bits-extra@, @hw-rankselect@, @hw-rankselect-base@, and+  @hw-dsv@. A simple way to set the flags for all of them when building with+  cabal is to include a cabal.project file in your project containing+  something like the following:+  .+  >packages: .+  >package bits-extra+  >  flags: +bmi2+  >package hw-rankselect+  >  flags: +bmi2+  >package hw-rankselect-base+  >  flags: +bmi2+  >package hw-dsv+  >  flags: +bmi2  homepage:            https://github.com/qfpl/sv bug-reports:         https://github.com/qfpl/sv/issues@@ -63,7 +74,8 @@ tested-with:         GHC == 7.10.3                      , GHC == 8.0.2                      , GHC == 8.2.2-                     , GHC == 8.4.1+                     , GHC == 8.4.3+                     , GHC == 8.6.1  source-repository    head   type:              git@@ -72,56 +84,26 @@ library   exposed-modules:     Data.Sv                        , Data.Sv.Decode-                       , Data.Sv.Decode.Error-                       , Data.Sv.Decode.Type                        , Data.Sv.Encode-                       , Data.Sv.Encode.Options-                       , Data.Sv.Encode.Type                        , Data.Sv.Parse-                       , Data.Sv.Parse.Internal-                       , Data.Sv.Parse.Options-                       , Data.Sv.Print-                       , Data.Sv.Print.Internal-                       , Data.Sv.Print.Options-                       , Data.Sv.Syntax-                       , Data.Sv.Syntax.Field-                       , Data.Sv.Syntax.Record-                       , Data.Sv.Syntax.Sv-                       , Data.Vector.NonEmpty-                       , Text.Escape-                       , Text.Newline-                       , Text.Quote-                       , Text.Space-  -- other-modules:+                       , Data.Sv.Structure+  other-modules:       Data.Sv.Alien.Cassava   -- other-extensions:    -  build-depends:       ansi-wl-pprint >= 0.6.6 && < 0.7+  build-depends:       base >=4.8 && <5                        , attoparsec >= 0.12.1.4 && < 0.14-                       , base >=4.8 && <5                        , bifunctors >= 5.1 && < 6                        , bytestring >= 0.9.1.10 && < 0.11-                       , charset >=0.3 && <=0.4-                       , containers >= 0.4 && < 0.6-                       , contravariant >= 1.2 && < 1.5-                       , deepseq >= 1.1 && < 1.5-                       , lens >= 4 && < 5-                       , mtl >= 2.0.1 && < 2.3-                       , parsec >= 3.1 && < 3.2-                       , parsers >=0.12 && <0.13-                       , profunctors >= 5.2.1 && < 6-                       , readable >= 0.3 && < 0.4+                       , contravariant >= 1.2 && < 1.6+                       , hw-dsv >= 0.2.1 && < 0.3                        , semigroupoids >= 5 && <6-                       , semigroups >= 0.18 && < 0.19-                       , text >= 1.0 && < 1.3+                       , sv-core >= 0.1 && < 0.2                        , transformers >= 0.2 && < 0.6-                       , trifecta >= 1.5 && < 1.8                        , utf8-string >= 1 && < 1.1                        , validation >= 1 && < 1.1-                       , vector >= 0.10 && < 0.13-                       , void >= 0.6 && < 1   hs-source-dirs:      src   default-language:    Haskell2010   ghc-options:-                       -Wall+                       -Wall -O2  test-suite             tasty   type:@@ -129,30 +111,29 @@   main-is:                        tasty.hs   other-modules:-                       Data.Sv.DecodeTest+                       Data.Sv.CassavaTest+                       , Data.Sv.DecodeTest                        , Data.Sv.EncodeTest-                       , Data.Sv.Generators-                       , Data.Sv.ParseTest-                       , Data.Sv.PrintTest-                       , Data.Sv.RoundTrips+                       , Data.Sv.RoundTripsDecodeEncode   default-language:                        Haskell2010   build-depends:-                       ansi-wl-pprint >= 0.6.6 && < 0.7-                       , base >=4.8 && <5+                       base >=4.8 && <5                        , bytestring >= 0.9.1.10 && < 0.11-                       , contravariant >= 1.2 && < 1.5-                       , hedgehog >= 0.5 && < 0.6+                       , cassava >= 0.4.1 && < 0.6+                       , contravariant >= 1.2 && < 1.6+                       , hedgehog >= 0.5 && < 0.7                        , lens >= 4 && < 5                        , parsers >=0.12 && <0.13+                       , Only >= 0.1 && < 0.2                        , semigroupoids >= 5 && <6                        , semigroups >= 0.18 && < 0.19                        , sv-                       , tasty >= 0.11 && < 1.1-                       , tasty-hedgehog >= 0.1 && < 0.2+                       , tasty >= 0.11 && < 1.2+                       , tasty-hedgehog >= 0.1 && < 0.3                        , tasty-hunit >= 0.9 && < 0.11                        , text >= 1.0 && < 1.3-                       , trifecta >= 1.5 && < 1.8+                       , trifecta >= 1.5 && < 2.1                        , utf8-string >= 1 && < 1.1                        , validation >= 1 && < 1.1                        , vector >= 0.10 && < 0.13
+ test/Data/Sv/CassavaTest.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Data.Sv.CassavaTest (test_CassavaAgreement) where++import qualified Data.ByteString as BS+import qualified Data.Csv as Csv+import Data.Sv (Validation (Failure, Success), Headedness (Unheaded), ParseOptions (_headedness), defaultParseOptions)+import qualified Data.Sv as Sv (parseDecode)+import Data.Sv.Decode (Decode')+import qualified Data.Sv.Decode as Sv+import Data.Vector as V+import Data.Tuple.Only (Only (Only, fromOnly))+import Hedgehog (Gen, (===), failure, forAll, property)+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import Test.Tasty (TestName, TestTree, testGroup)+import Test.Tasty.Hedgehog (testProperty)++test_CassavaAgreement :: TestTree+test_CassavaAgreement =+  testGroup "cassava agreement"+    [ cassavaAgreement "int" Sv.int (Gen.int (Range.linear (-10000000) 10000000))+    , cassavaAgreement "char" Sv.char (Gen.unicode)+    , cassavaAgreement "integer" Sv.integer (Gen.integral (Range.linear (-10000000) 10000000))+    , cassavaAgreement "string" Sv.string (Gen.string (Range.linear 1 500) Gen.unicode)+    , cassavaAgreement "bytestring" Sv.byteString (Gen.utf8 (Range.linear 1 500) Gen.unicode)+    , cassavaAgreement "float" Sv.float (Gen.float (Range.exponentialFloat (-10000000) 10000000))+    , cassavaAgreement "double" Sv.double (Gen.double (Range.exponentialFloat (-10000000) 10000000))+    ]++opts :: ParseOptions+opts = defaultParseOptions { _headedness = Unheaded }++-- | Test that decoding with sv gets the same result as decoding with cassava+cassavaAgreement :: forall a . (Csv.FromField a, Csv.ToField a, Show a, Eq a) => TestName -> Decode' BS.ByteString a -> Gen a -> TestTree+cassavaAgreement name dec gen = testProperty name $ property $ do+  a <- forAll gen+  let oa = Only a+  let sa = Csv.encode [oa]+  let cassava :: Either String [a]+      cassava = fmap fromOnly . V.toList <$> Csv.decode Csv.NoHeader sa+      sv = Sv.parseDecode dec opts sa+  case cassava of+    Left _ -> failure+    Right csa -> case sv of+      Failure _ -> failure+      Success sva -> do+        csa === sva+        sva === pure a
test/Data/Sv/DecodeTest.hs view
@@ -6,14 +6,18 @@ module Data.Sv.DecodeTest (test_Decode) where  import Control.Applicative (liftA2)-import Control.Lens ((&), (.~))-import Data.ByteString-import Data.Functor.Alt+import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Char8 as BS8+import Data.Functor.Alt ((<!>)) import Data.List.NonEmpty (NonEmpty ((:|)))-import Data.Semigroup+import Text.Read (readMaybe)+import Data.Semigroup (Semigroup)+import Data.Semigroupoid (Semigroupoid (o)) import qualified Data.Vector as V import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase, (@?=))+import Data.Text  import Data.Sv import qualified Data.Sv.Decode as D@@ -23,30 +27,31 @@   testGroup "Decode" [     intOrStringTest   , varyingLengthTest+  , semigroupoidTest   ]  data IntOrString =   I Int | S String   deriving (Eq, Ord, Show) -intOrString :: Decode ByteString ByteString IntOrString+intOrString :: D.Decode' ByteString IntOrString intOrString = I <$> D.int <!> S <$> D.string  data V3 a =   V3 a a a   deriving (Eq, Ord, Show, Functor, Foldable, Traversable) -v3 :: Semigroup e => Decode e s a -> Decode e s (V3 a)+v3 :: Semigroup e => D.Decode e s a -> D.Decode e s (V3 a) v3 f = sequenceA (V3 f f f) -v3ios :: Decode ByteString ByteString (V3 IntOrString)+v3ios :: D.Decode ByteString ByteString (V3 IntOrString) v3ios = v3 intOrString -csv1 :: ByteString-csv1 = intercalate "\r\n" [-    "\"3\", \"4\", \"5\""-  , "\"quoted text\", unquoted text, 100"-  , "7, unquoted text, 5"+csv1 :: LBS.ByteString+csv1 = LBS.intercalate "\n" [+    "\"3\",\"4\",\"5\""+  , "\"quoted text\",unquoted text,100"+  , "7,unquoted text,5"   ]  csv1' :: [V3 IntOrString]@@ -56,16 +61,16 @@   , V3 (I 7) (S "unquoted text") (I 5)   ] -opts :: ParseOptions ByteString-opts = defaultParseOptions & headedness .~ Unheaded+opts :: ParseOptions+opts = ParseOptions comma Unheaded  intOrStringTest :: TestTree intOrStringTest =     testCase "parse successfully" $       parseDecode v3ios opts csv1 @?= pure csv1' -varyingLength :: ByteString-varyingLength = intercalate "\r\n" [+varyingLength :: LBS.ByteString+varyingLength = LBS.intercalate "\r\n" [     "one"   , "one,two"   , "one,two,three"@@ -73,15 +78,46 @@   , "one,two,three,four,five"   ] -str2 :: Decode' ByteString (ByteString, ByteString)+str2 :: D.Decode' ByteString (ByteString, ByteString) str2 = liftA2 (,) D.contents D.contents  varyingLengthTest :: TestTree varyingLengthTest =   testCase "varyingLength has all the right errors" $     parseDecode str2 opts varyingLength @?=-      Failure (DecodeErrors (D.UnexpectedEndOfRow :| [-        D.ExpectedEndOfRow (V.fromList $ fmap pure [Unquoted "three"])-      , D.ExpectedEndOfRow (V.fromList $ fmap pure [Unquoted "three", Unquoted "four"])-      , D.ExpectedEndOfRow (V.fromList $ fmap pure [Unquoted "three", Unquoted "four", Unquoted "five"])+      Failure (DecodeErrors (UnexpectedEndOfRow :| [+        ExpectedEndOfRow (V.fromList ["three"])+      , ExpectedEndOfRow (V.fromList ["three", "four"])+      , ExpectedEndOfRow (V.fromList ["three", "four", "five"])       ]))++semiTestString1 :: LBS.ByteString+semiTestString1 = "hello,5,6.6,goodbye"++semiTestString2 :: LBS.ByteString+semiTestString2 = "hello,no,6.6,goodbye"++semiTestString3 :: LBS.ByteString+semiTestString3 = "hello,5,false,goodbye"++parseDecoder :: D.Decode' ByteString Int+parseDecoder = D.contents D.>>==+  \bs -> validateMaybe (D.BadDecode bs) . readMaybe . BS8.unpack $ bs++data Semi = Semi Text Int Double Text deriving (Eq, Show)++semiD :: D.Decode' ByteString Semi+semiD = Semi <$> D.utf8 <*> (parseDecoder `o` D.contents) <*> D.double <*> D.utf8++semigroupoidTest :: TestTree+semigroupoidTest = testGroup "Semigroupoid Decode"+  [ testCase "Does the right thing in the case of success" $+      parseDecode semiD opts semiTestString1 @?=+        pure [Semi "hello" 5 6.6 "goodbye"]+  , testCase "Does the right thing in the case of left failure" $+      parseDecode semiD opts semiTestString2 @?=+        Failure (DecodeErrors (pure (BadDecode "no")))+  , testCase "Does the right thing in the case of right failure" $+      parseDecode semiD opts semiTestString3 @?=+        Failure (DecodeErrors (pure (BadDecode "Couldn't parse \"false\" as a double")))+  ]
test/Data/Sv/EncodeTest.hs view
@@ -49,9 +49,9 @@ decidableTests =   testGroup "decidable" [     testCase "encode an Int" $-      encodeRow intOrString opts i @?= "\"5\""+      encodeRow intOrString opts i @?= "5"   , testCase "encode a String" $-      encodeRow intOrString opts s @?= "\"hello\""+      encodeRow intOrString opts s @?= "hello"   ]  intEmptyAndString :: Encode IntAndString@@ -64,16 +64,16 @@ divisibleTests =   testGroup "divisible" [     testCase "encode an IntAndString" $-      encodeRow intAndString opts ias @?= "\"10\",\"goodbye\""+      encodeRow intAndString opts ias @?= "10,goodbye"   , testCase "encode an IntAndString with an empty between" $-      encodeRow intEmptyAndString opts ias @?= "\"10\",\"\",\"goodbye\""+      encodeRow intEmptyAndString opts ias @?= "10,,goodbye"   ]  encodeTests :: TestTree encodeTests =   testCase "multiple lines" $     encode (divided intAndString intOrString) opts [(IAS 3 "book", I 4), (IAS 7 "film", S "ok")]-      @?= "\"3\",\"book\",\"4\"\r\n\"7\",\"film\",\"ok\""+      @?= "3,book,4\n7,film,ok"  escapeTests :: TestTree escapeTests =
− test/Data/Sv/Generators.hs 
@@ -1,115 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Data.Sv.Generators (-  genSv-  , genSvWithHeadedness-  , genNewline-  , genSep-  , genQuote-  , genSpaced-  , genField-  , genSpacedField-  , genRecord-  , genRecords-  , genHeader-  , genCsvString-) where--import Control.Applicative ((<$>), liftA2, liftA3)-import Data.ByteString (ByteString)-import qualified Data.ByteString.Lazy as LBS-import Data.ByteString.Builder (Builder)-import qualified Data.ByteString.Builder as Builder-import Data.List.NonEmpty (NonEmpty ((:|)))-import Data.Semigroup (Semigroup ((<>)))-import qualified Data.Vector as V-import Hedgehog-import qualified Hedgehog.Gen as Gen-import qualified Hedgehog.Range as Range--import Data.Sv.Syntax.Sv (Sv (Sv), Header (Header), Headedness, getHeadedness, Separator)-import Data.Sv.Syntax.Field (Field (Quoted, Unquoted))-import Data.Sv.Syntax.Record (Record, Records (EmptyRecords, Records), recordNel)-import Text.Escape (Unescaped (Unescaped))-import Text.Newline (Newline (CRLF, LF))-import Text.Space (Spaces, Spaced (Spaced))-import Text.Quote (Quote (SingleQuote, DoubleQuote))--genSv :: Gen Separator -> Gen Spaces -> Gen s -> Gen (Sv s)-genSv sep spc s =-  let rs = genRecords spc s-      e  = Gen.list (Range.linear 0 5) genNewline-      h = Gen.maybe (genHeader spc s genNewline)-  in  Sv <$> sep <*> h <*> rs <*> e--genSvWithHeadedness :: Gen Separator -> Gen Spaces -> Gen s -> Gen (Sv s, Headedness)-genSvWithHeadedness sep spc s = fmap (\c -> (c, getHeadedness c)) (genSv sep spc s)--genNewline :: Gen Newline-genNewline =-  -- TODO put CR back in-  Gen.element [CRLF, LF]--genSep :: Gen Separator-genSep =-  Gen.element ['|', ',', '\t', '\x1F4A9']--genSpaced :: Gen Spaces -> Gen s -> Gen (Spaced s)-genSpaced spc str =-  liftA3 Spaced spc spc str--genQuote :: Gen Quote-genQuote =-  Gen.element [SingleQuote, DoubleQuote]--genUnescaped :: Gen a -> Gen (Unescaped a)-genUnescaped = fmap Unescaped--genField :: Gen s -> Gen (Field s)-genField s =-  Gen.choice [-    Unquoted <$> s-  , liftA2 Quoted genQuote (genUnescaped s)-  ]--genSpacedField :: Gen Spaces -> Gen s -> Gen (Spaced (Field s))-genSpacedField spc s = genSpaced spc (genField s)--genRecord :: Gen Spaces -> Gen s -> Gen (Record s)-genRecord spc s =-  recordNel <$> Gen.nonEmpty (Range.linear 1 10) (genSpacedField spc s)--genHeader :: Gen Spaces -> Gen s -> Gen Newline -> Gen (Header s)-genHeader spc s n =-  Header <$> genRecord spc s <*> n--genRecords :: Gen Spaces -> Gen s -> Gen (Records s)-genRecords spc s =-  let rec = genRecord spc s-      nlr = liftA2 (,) genNewline rec-  in  maybe EmptyRecords (uncurry Records) <$>-    Gen.maybe (-      liftA2 (,)-        rec-        (V.fromList <$> Gen.list (Range.linear 0 1000) nlr)-      )--genCsvString :: Gen ByteString-genCsvString =-  let intercalate' :: (Semigroup m, Monoid m) => m -> NonEmpty m -> m-      intercalate' _ (x:|[]) = x-      intercalate' m (x:|y:zs) = x <> m <> intercalate' m (y:|zs)-      genNewlineString :: Gen Builder-      genNewlineString = Gen.element (fmap Builder.string7 ["\n", "\r", "\r\n"])-      genCsvRowString = intercalate' "," <$> Gen.nonEmpty (Range.linear 1 100) genCsvField-      enquote c s = fmap (\z -> c <> z <> c) s-      genCsvFieldString :: Gen Builder-      genCsvFieldString = Builder.byteString <$>-        Gen.utf8 (Range.linear 1 50) (Gen.filter (`notElem` [',','"','\'','\n','\r']) Gen.unicode)-      genCsvField =-        Gen.choice [-          enquote "\"" genCsvFieldString-        , enquote "'" genCsvFieldString-        , genCsvFieldString-        ]-  in  fmap (LBS.toStrict . Builder.toLazyByteString) $ intercalate' <$> genNewlineString <*> Gen.nonEmpty (Range.linear 0 100) genCsvRowString
− test/Data/Sv/ParseTest.hs 
@@ -1,215 +0,0 @@-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE OverloadedStrings #-}--module Data.Sv.ParseTest (test_Parse) where--import Control.Lens ((&), (.~))-import Data.ByteString (ByteString)-import qualified Data.ByteString.UTF8 as UTF8-import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty)-import Data.Either (isLeft)-import Data.Foldable (fold)-import Data.Semigroup (Semigroup ((<>)))-import Data.Text (Text, pack)-import Hedgehog-import Test.Tasty (TestName, TestTree, testGroup)-import Test.Tasty.Hedgehog (testProperty)-import Test.Tasty.HUnit (Assertion, assertBool, testCase, (@?=))-import Text.Newline (Newline (CR, LF, CRLF), newlineToString)-import Text.Parser.Char (CharParsing)-import Text.Trifecta (Result (Success, Failure), parseByteString, _errDoc)--import Data.Sv.Generators (genCsvString)-import Data.Sv.Parse (ParseOptions, defaultParseOptions, headedness, separator, encodeString)-import Data.Sv.Parse.Internal (doubleQuotedField, record, separatedValues, singleQuotedField, spaced, spacedField)-import Data.Sv.Syntax.Sv (Sv, mkSv, comma, pipe, tab, Headedness (Unheaded), Separator)-import Data.Sv.Syntax.Field (Field (Quoted, Unquoted), SpacedField)-import Data.Sv.Syntax.Record (Record (Record), recordNel, mkRecords, Records (EmptyRecords))-import Text.Escape (Unescaped (Unescaped))-import Text.Space (Spaced (Spaced), manySpaces, unspaced)-import Text.Quote (Quote (SingleQuote, DoubleQuote), quoteToString)--test_Parse :: TestTree-test_Parse =-  testGroup "Parse" [-    singleQuotedFieldTest-  , doubleQuotedFieldTest-  , fieldTest-  , recordTest-  , csvTest-  , psvTest-  , tsvTest-  , nsvTest-  , crsvTest-  , bssvTest-  , randomCsvTest-  ]--r2e :: Result a -> Either String a-r2e r = case r of-  Success a -> Right a-  Failure e -> Left (show (_errDoc e))--(@?=/) ::-  (Show a, Show b, Eq a, Eq b)-  => Either a b-  -> b-  -> Assertion-(@?=/) l r = l @?= pure r--qd, qs :: a -> Field a-qd = Quoted DoubleQuote . Unescaped-qs = Quoted SingleQuote . Unescaped-qsr :: s -> Record s-qsr = Record . pure . nospc . qs-uq :: s -> SpacedField s-uq = unspaced . Unquoted-uqa :: NonEmpty s -> Record s-uqa = recordNel . fmap uq-uqaa :: [NonEmpty s] -> [Record s]-uqaa = fmap uqa-nospc :: Field s -> SpacedField s-nospc = unspaced--quotedFieldTest :: (forall m . CharParsing m => m (SpacedField Text)) -> TestName -> Quote -> TestTree-quotedFieldTest parser name quote =-  let p :: [ByteString] -> Either String (SpacedField Text)-      p = r2e . parseByteString parser mempty . mconcat-      q = quoteToString quote-      qq = Quoted quote . Unescaped-  in testGroup name [-    testCase "empty" $-      p [q,q] @?=/ nospc (qq "")-  , testCase "text" $-      p [q,"hello text",q]-        @?=/ nospc (qq "hello text")-  , testCase "capture space" $-      p ["   ", q, " spaced text  ", q, "     "]-        @?=/ Spaced (manySpaces 3) (manySpaces 5) (qq " spaced text  ")-  , testCase "no closing quote" $-      assertBool "wasn't left" (isLeft (p [q, "no closing quote"   ]))-  , testCase "no opening quote" $-      assertBool "wasn't left" (isLeft (p [   "no opening quote", q]))-  , testCase "no quotes" $-      assertBool "wasn't left" (isLeft (p [   "no quotes"          ]))-  , testCase "quoted field can handle escaped quotes" $-     p [q,"yes", q, q, "no", q] @?=/ nospc (Quoted quote (Unescaped ("yes" <> quoteToString quote <> "no")))-  ]--singleQuotedFieldTest, doubleQuotedFieldTest :: TestTree-singleQuotedFieldTest = quotedFieldTest (spaced comma (singleQuotedField pack)) "singleQuotedField" SingleQuote-doubleQuotedFieldTest = quotedFieldTest (spaced comma (doubleQuotedField pack)) "doubleQuotedField" DoubleQuote--fieldTest :: TestTree-fieldTest =-  let p :: ByteString -> Either String (SpacedField Text)-      p = r2e . parseByteString (spacedField comma pack) mempty-  in  testGroup "field" [-    testCase "doublequoted" $-      p "\"hello\"" @?=/ nospc (qd "hello")-  , testCase "singlequoted" $-      p "'goodbye'" @?=/ nospc (qs "goodbye")-  , testCase "unquoted" $-      p "yes" @?=/ uq "yes"-  , testCase "spaced doublequoted" $-      p "       \" spaces  \"    " @?=/ Spaced (manySpaces 7) (manySpaces 4) (qd " spaces  ")-  , testCase "spaced singlequoted" $-      p "        ' more spaces ' " @?=/ Spaced (manySpaces 8) (manySpaces 1) (qs " more spaces ")-  , testCase "spaced unquoted" $-      p "  some text   " @?=/ Spaced (manySpaces 2) (manySpaces 3) (Unquoted "some text")-  , testCase "fields can include the separator in single quotes" $-      p "'hello,there,'" @?=/ nospc (qs "hello,there,")-  , testCase "fields can include the separator in double quotes" $-      p "\"court,of,the,,,,crimson,king\"" @?=/ nospc (qd "court,of,the,,,,crimson,king")-  , testCase "unquoted fields stop at the separator (1)" $-      p "close,to,the,edge" @?=/ uq "close"-  , testCase "unquoted fields stop at the separator (2)" $-      p ",close,to,the,edge" @?=/ uq ""-  ]--recordTest :: TestTree-recordTest =-  let opts :: ParseOptions Text-      opts = defaultParseOptions & encodeString .~ pack-      p :: ByteString -> Either String (Record Text)-      p = r2e . parseByteString (record opts) mempty-  in  testGroup "record" [-    testCase "single field" $-      p "Yes" @?=/ uqa (pure "Yes")-  , testCase "fields" $-      p "Anderson,Squire,Wakeman,Howe,Bruford" @?=/ uqa ("Anderson":|["Squire", "Wakeman", "Howe", "Bruford"])-  , testCase "commas" $-      p ",,," @?=/ uqa ("":|["","",""])-  , testCase "record ends at newline" $-      p "a,b,c\nd,e,f" @?=/ uqa ("a":|["b","c"])-  , testCase "record ends at carriage return" $-      p "g,h,i\rj,k,l" @?=/ uqa ("g":|["h","i"])-  , testCase "record ends at carriage return followed by newline" $-      p "m,n,o\r\np,q,r" @?=/ uqa ("m":|["n","o"])-  ]--separatedValuesTest :: Separator -> Newline -> Int -> TestTree-separatedValuesTest sep nl newlines =-  let opts = defaultParseOptions & separator .~ sep & headedness .~ Unheaded & encodeString .~ pack-      p :: ByteString -> Either String (Sv Text)-      p = r2e . parseByteString (separatedValues opts) mempty-      ps = p . fold-      mkSv' :: [Record s] -> [Newline] -> Sv s-      mkSv' rs e = mkSv sep Nothing e $ maybe EmptyRecords (mkRecords nl) $ nonEmpty rs-      s = UTF8.fromString [sep]-      nls = newlineToString nl-      terminator = replicate newlines nl-      termStr = foldMap newlineToString terminator-  in  testGroup "separatedValues" [-    testCase "empty" $-      ps ["", termStr] @?=/ mkSv' [] terminator-  , testCase "single empty quotes field" $ -      ps ["''", termStr] @?=/ mkSv' [qsr ""] terminator-  , testCase "single field, single record" $-      ps ["one", termStr] @?=/ mkSv' [uqa (pure "one")] terminator-  , testCase "single field, multiple records" $-      ps ["one",nls,"un",termStr] @?=/ mkSv' [uqa (pure "one"), uqa (pure "un")] terminator-  , testCase "multiple fields, single record" $-      ps ["one", s, "two",termStr] @?=/ mkSv' (uqaa (pure ("one":|["two"]))) terminator-  , testCase "multiple fields, multiple records" $-      ps ["one", s, "two", s, "three", nls, "un", s, "deux", s, "trois",termStr]-        @?=/ mkSv' (uqaa ["one":|["two", "three"] , "un":|["deux", "trois"]]) terminator-  ]--svTest :: String -> Separator -> TestTree-svTest name sep =-  testGroup name $ separatedValuesTest sep <$> [CR, LF, CRLF] <*> [0,1,2]--csvTest :: TestTree-csvTest = svTest "csv" comma--psvTest :: TestTree-psvTest = svTest "psv" pipe--tsvTest :: TestTree-tsvTest = svTest "tsv" tab--nsvTest :: TestTree-nsvTest = svTest "NULL separated values" '\0'--crsvTest :: TestTree-crsvTest =-  testGroup "carriage return separated values" $-    separatedValuesTest '\r' <$> [LF] <*> [0,1,2]--bssvTest :: TestTree-bssvTest = svTest "backspace separated values" '\BS'--prop_randomCsvTest :: Property-prop_randomCsvTest = property $ do-  str <- forAll genCsvString-  let opts = separatedValues (defaultParseOptions & headedness .~ Unheaded & encodeString .~ id)-      x :: Either String (Sv String)-      x = r2e (parseByteString opts mempty str)-  case x of-    Left _ -> failure-    Right _ -> success--randomCsvTest :: TestTree-randomCsvTest =-  testProperty "parse random CSV" prop_randomCsvTest
− test/Data/Sv/PrintTest.hs 
@@ -1,32 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Data.Sv.PrintTest (test_Print) where--import Data.ByteString (ByteString)-import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit ((@?=), testCase)--import Data.Sv.Print (printSv)-import Data.Sv.Syntax.Field (Field (Quoted))-import Data.Sv.Syntax.Record (Records (EmptyRecords), singleField, singleRecord)-import Data.Sv.Syntax.Sv (Sv (Sv), noHeader, comma)-import Text.Quote (Quote (SingleQuote))--test_Print :: TestTree-test_Print =-  testGroup "Print" [-    csvPrint-  ]--csvPrint :: TestTree-csvPrint =-  testGroup "csvPrint" [-    testCase "empty" $-      let subject :: Sv ByteString-          subject = Sv comma noHeader EmptyRecords []-      in  printSv subject @?= ""-  , testCase "empty quotes" $-      let subject :: Sv ByteString-          subject = Sv comma noHeader (singleRecord (singleField (Quoted SingleQuote mempty))) []-      in printSv subject @?= ("''" :: ByteString)-  ]
− test/Data/Sv/RoundTrips.hs 
@@ -1,190 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}--module Data.Sv.RoundTrips (test_Roundtrips) where--import Control.Lens ((&), (.~))-import Data.ByteString (ByteString)-import qualified Data.ByteString.Builder as Builder-import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.UTF8 as UTF8-import Data.Semigroup ((<>))-import Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.Vector as V-import Hedgehog ((===), Property, Gen, forAll, property)-import qualified Hedgehog.Gen as Gen-import qualified Hedgehog.Range as Range-import Test.Tasty (TestName, TestTree, testGroup)-import Test.Tasty.Hedgehog (testProperty)-import Test.Tasty.HUnit ((@?=), testCase)-import Text.Parser.Char (CharParsing)-import Text.Trifecta (parseByteString)--import Data.Sv-import qualified Data.Sv.Decode as D-import qualified Data.Sv.Encode as E-import Data.Sv.Decode.Error (trifectaResultToEither)-import Data.Sv.Generators-import Data.Sv.Syntax (Sv, Headedness, SpacedField, comma)-import Data.Sv.Parse (defaultParseOptions, headedness, encodeString, separatedValues)-import Data.Sv.Parse.Internal (spacedField)-import Data.Sv.Print (defaultPrintOptions, printSvText)-import Data.Sv.Print.Internal (printSpaced)-import Text.Space (HorizontalSpace (Space, Tab), Spaces)- -test_Roundtrips :: TestTree-test_Roundtrips =-  testGroup "Round trips" [-    csvRoundTrip-  , fieldRoundTrip-  , testGroup "decode/encode isomorphisms" [-      bool-    , char-    , int-    , integer-    , float-    , double-    , string-    , byteString-    , lazyByteString-    , text-    ]-  , testGroup "decode/encode normalising" [-      boolSI-    , floatSI-    , doubleSI-    ]--  ]--printAfterParseRoundTrip :: (forall m. CharParsing m => m a) -> (a -> ByteString) -> TestName -> ByteString -> TestTree-printAfterParseRoundTrip parser display name s =-  testCase name $-    fmap display (trifectaResultToEither $ parseByteString parser mempty s) @?= Right s--fieldRoundTrip :: TestTree-fieldRoundTrip =-  let sep = comma-      test =-        printAfterParseRoundTrip-        (spacedField sep UTF8.fromString :: CharParsing m => m (SpacedField ByteString))-        (BL.toStrict . Builder.toLazyByteString . printSpaced defaultPrintOptions)-  in  testGroup "field" [-    test "empty" ""-  , test "unquoted" "wobble"-  , test "unquoted with space" "  wiggle "-  , test "single quoted" "'tortoise'"-  , test "single quoted with space" " 'turtle'   "-  , test "single quoted with escape outer" "\'\'\'c\'\'\'"-  , test "single quoted with escape in the middle" "\'  The char \'\'c\'\' is nice.\'"-  , test "double quoted" "\"honey badger\""-  , test "double quoted with space" "   \" sun bear\" "-  , test "double quoted with escape outer" "\"\"\"laser\"\"\""-  , test "double quoted with escape in the middle" "\"John \"\"The Duke\"\" Wayne\""-  ]--csvRoundTrip :: TestTree-csvRoundTrip = testProperty "roundtrip" prop_csvRoundTrip--prop_csvRoundTrip :: Property-prop_csvRoundTrip =-  let genSpace :: Gen HorizontalSpace-      genSpace = Gen.element [Space, Tab]-      genSpaces :: Gen Spaces-      genSpaces = V.fromList <$> Gen.list (Range.linear 0 10) genSpace-      genText :: Gen Text-      genText  = Gen.text (Range.linear 1 100) Gen.alphaNum-      gen = genSvWithHeadedness (pure comma) genSpaces genText-      mkOpts h = defaultParseOptions & headedness .~ h & encodeString .~ Text.pack-      parseCsv :: CharParsing m => Headedness -> m (Sv Text)-      parseCsv = separatedValues . mkOpts-      parse h = parseByteString (parseCsv h) mempty-  in  property $ do-    (c,h) <- forAll gen-    trifectaResultToEither (fmap printSvText (parse h (printSvText c))) === pure (printSvText c)--encOpts :: EncodeOptions-encOpts = defaultEncodeOptions & quote .~ Nothing--parOpts :: ParseOptions ByteString-parOpts = defaultParseOptions & headedness .~ Unheaded---- Round-trips an encode/decode pair. This version checks whether the pair--- form an isomorphism-roundTripCodecIso :: (Eq a, Show a) => TestName -> Decode' ByteString a -> Encode a -> [(ByteString, a)] -> TestTree-roundTripCodecIso name dec enc bsas = testGroup name . flip foldMap bsas $ \(bs,a) ->-  [ testCase (UTF8.toString bs <> ": encode . decode") $-      Success (BL.fromStrict bs) @?= (encode enc encOpts <$> parseDecode dec parOpts bs)-  , testCase (UTF8.toString bs <> ": decode . encode") $-      Success [a] @?= (parseDecode dec parOpts $ BL.toStrict $ encodeRow enc encOpts a)-  ]---- Round-trips an encode/decode pair. This version checks whether the pair--- form a split-idempotent. That is to say, one direction is identity, the other is--- idempotent.-roundTripCodecSplitIdempotent :: (Eq a, Show a) => TestName -> Decode' ByteString a -> Encode a -> [(ByteString, a)] -> TestTree-roundTripCodecSplitIdempotent name dec enc bsas =-    let deco = parseDecode dec parOpts-        enco = encode enc encOpts-        encdec = fmap enco . deco-    in  testGroup name . flip foldMap bsas $ \(bs,a) ->-      [ testCase (UTF8.toString bs <> ": decode . encode . decode") $-          Success (Success [a]) @?= (deco . BL.toStrict <$> encdec bs)-      , testCase (UTF8.toString bs <> ": decode . encode") $-          Success [a] @?= (parseDecode dec parOpts $ BL.toStrict $ enco [a])-      ]--byteString :: TestTree-byteString = roundTripCodecIso "bytestring" D.contents E.byteString-  [ ("hello","hello")]--lazyByteString :: TestTree-lazyByteString = roundTripCodecIso "lazy bytestring" D.lazyByteString E.lazyByteString [("hello","hello")]--bool :: TestTree-bool = roundTripCodecIso "bool" D.boolean E.booltruefalse [("true", True), ("false", False)]--char :: TestTree-char = roundTripCodecIso "char" D.char E.char [(UTF8.fromString "c", 'c'), (UTF8.fromString "💩", '💩')]--string :: TestTree-string = roundTripCodecIso "string" D.string E.string [(UTF8.fromString "hello", "hello"), (UTF8.fromString "💩💩💩💩", "💩💩💩💩")]--int :: TestTree-int = roundTripCodecIso "int" D.int E.int [("5", 5)]--integer :: TestTree-integer = roundTripCodecIso "integer" D.integer E.integer-  [ ("5", 5)-  , ("1000000", 1000000)-  ]--float :: TestTree-float = roundTripCodecIso "float" D.float E.float-  [ ("5.0", 5)-  , ("10.5", 10.5)-  , ("12345.678", 12345.678)-  ]--double :: TestTree-double = roundTripCodecIso "double" D.double E.double [("5.0", 5)]--text :: TestTree-text = roundTripCodecIso "text" D.utf8 E.text [(UTF8.fromString "hello", "hello"), (UTF8.fromString "💩💩💩💩", "💩💩💩💩")]--boolSI :: TestTree-boolSI = roundTripCodecSplitIdempotent "bool" D.boolean E.bool10-  [ ("1", True)-  , ("0", False)-  ]--floatSI :: TestTree-floatSI = roundTripCodecSplitIdempotent "float" D.float E.float-  [ ("5", 5)-  ]--doubleSI :: TestTree-doubleSI = roundTripCodecSplitIdempotent "double" D.double E.double-  [ ("5", 5)-  ]
+ test/Data/Sv/RoundTripsDecodeEncode.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}++module Data.Sv.RoundTripsDecodeEncode (test_Roundtrips) where++import Control.Lens ((&), (.~))+import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.UTF8 as UTF8+import Data.Semigroup ((<>))+import Test.Tasty (TestName, TestTree, testGroup)+import Test.Tasty.HUnit ((@?=), testCase)++import Data.Sv+import qualified Data.Sv.Decode as D+import qualified Data.Sv.Encode as E++test_Roundtrips :: TestTree+test_Roundtrips =+  testGroup "Round trips" [+    testGroup "decode/encode isomorphisms" [+      bool+    , char+    , int+    , integer+    , float+    , double+    , string+    , byteString+    , lazyByteString+    , text+    ]+  , testGroup "decode/encode normalising" [+      boolSI+    , floatSI+    , doubleSI+    ]++  ]++encOpts :: EncodeOptions+encOpts = defaultEncodeOptions & quoting .~ Never++parOpts :: ParseOptions+parOpts = defaultParseOptions & headedness .~ Unheaded++lbUtf8 :: LBS.ByteString -> String+lbUtf8 = UTF8.toString . LBS.toStrict++utf8lb :: String -> LBS.ByteString+utf8lb = LBS.fromStrict . UTF8.fromString++-- Round-trips an encode/decode pair. This version checks whether the pair+-- form an isomorphism+roundTripCodecIso :: (Eq a, Show a) => TestName -> Decode' ByteString a -> Encode a -> [(LBS.ByteString, a)] -> TestTree+roundTripCodecIso name dec enc bsas = testGroup name . flip foldMap bsas $ \(bs,a) ->+  [ testCase (lbUtf8 bs <> ": encode . decode") $+      Success bs @?= (encode enc encOpts <$> parseDecode dec parOpts bs)+  , testCase (lbUtf8 bs <> ": decode . encode") $+      Success [a] @?= (parseDecode dec parOpts $ encodeRow enc encOpts a)+  ]++-- Round-trips an encode/decode pair. This version checks whether the pair+-- form a split-idempotent. That is to say, one direction is identity, the other is+-- idempotent.+roundTripCodecSplitIdempotent :: (Eq a, Show a) => TestName -> Decode' ByteString a -> Encode a -> [(LBS.ByteString, a)] -> TestTree+roundTripCodecSplitIdempotent name dec enc bsas =+    let deco = parseDecode dec parOpts+        enco = encode enc encOpts+        encdec = fmap enco . deco+    in  testGroup name . flip foldMap bsas $ \(bs,a) ->+      [ testCase (lbUtf8 bs <> ": decode . encode . decode") $+          Success (Success [a]) @?= (deco <$> encdec bs)+      , testCase (lbUtf8 bs <> ": decode . encode") $+          Success [a] @?= (parseDecode dec parOpts $ enco [a])+      ]++byteString :: TestTree+byteString = roundTripCodecIso "bytestring" D.contents E.byteString+  [ ("hello","hello")]++lazyByteString :: TestTree+lazyByteString = roundTripCodecIso "lazy bytestring" D.lazyByteString E.lazyByteString [("hello","hello")]++bool :: TestTree+bool = roundTripCodecIso "bool" D.boolean E.booltruefalse [("true", True), ("false", False)]++char :: TestTree+char = roundTripCodecIso "char" D.char E.char [(utf8lb "c", 'c'), (utf8lb "💩", '💩')]++string :: TestTree+string = roundTripCodecIso "string" D.string E.string [(utf8lb "hello", "hello"), (utf8lb "💩💩💩💩", "💩💩💩💩")]++int :: TestTree+int = roundTripCodecIso "int" D.int E.int [("5", 5)]++integer :: TestTree+integer = roundTripCodecIso "integer" D.integer E.integer+  [ ("5", 5)+  , ("1000000", 1000000)+  ]++float :: TestTree+float = roundTripCodecIso "float" D.float E.float+  [ ("5.0", 5)+  , ("10.5", 10.5)+  , ("12345.678", 12345.678)+  ]++double :: TestTree+double = roundTripCodecIso "double" D.double E.double [("5.0", 5)]++text :: TestTree+text = roundTripCodecIso "text" D.utf8 E.text [(utf8lb "hello", "hello"), (utf8lb "💩💩💩💩", "💩💩💩💩")]++boolSI :: TestTree+boolSI = roundTripCodecSplitIdempotent "bool" D.boolean E.bool10+  [ ("1", True)+  , ("0", False)+  ]++floatSI :: TestTree+floatSI = roundTripCodecSplitIdempotent "float" D.float E.float+  [ ("5", 5)+  ]++doubleSI :: TestTree+doubleSI = roundTripCodecSplitIdempotent "double" D.double E.double+  [ ("5", 5)+  ]
test/tasty.hs view
@@ -2,18 +2,16 @@  import Test.Tasty (defaultMain, testGroup) +import Data.Sv.CassavaTest (test_CassavaAgreement) import Data.Sv.DecodeTest (test_Decode) import Data.Sv.EncodeTest (test_Encode)-import Data.Sv.ParseTest (test_Parse)-import Data.Sv.PrintTest (test_Print)-import Data.Sv.RoundTrips (test_Roundtrips)+import Data.Sv.RoundTripsDecodeEncode (test_Roundtrips)  main :: IO () main =   defaultMain $ testGroup "Tests" [-    test_Parse-  , test_Print-  , test_Decode+    test_Decode   , test_Encode   , test_Roundtrips+  , test_CassavaAgreement   ]