svfactor (empty) → 0.1

raw patch · 27 files changed

+2426/−0 lines, 27 filesdep +attoparsecdep +basedep +bifunctorssetup-changed

Dependencies added: attoparsec, base, bifunctors, bytestring, charset, deepseq, hedgehog, lens, parsec, parsers, semigroupoids, semigroups, svfactor, tasty, tasty-hedgehog, tasty-hunit, text, transformers, trifecta, utf8-string, vector

Files

• LICENCE +31/−0
• Setup.hs +2/−0
• changelog.md +5/−0
• src/Data/Svfactor.hs +18/−0
• src/Data/Svfactor/Parse.hs +123/−0
• src/Data/Svfactor/Parse/Internal.hs +170/−0
• src/Data/Svfactor/Parse/Options.hs +97/−0
• src/Data/Svfactor/Print.hs +105/−0
• src/Data/Svfactor/Print/Internal.hs +75/−0
• src/Data/Svfactor/Print/Options.hs +80/−0
• src/Data/Svfactor/Structure/Headedness.hs +30/−0
• src/Data/Svfactor/Syntax.hs +18/−0
• src/Data/Svfactor/Syntax/Field.hs +117/−0
• src/Data/Svfactor/Syntax/Record.hs +178/−0
• src/Data/Svfactor/Syntax/Sv.hs +178/−0
• src/Data/Svfactor/Text/Escape.hs +124/−0
• src/Data/Svfactor/Text/Newline.hs +84/−0
• src/Data/Svfactor/Text/Quote.hs +73/−0
• src/Data/Svfactor/Text/Separator.hs +54/−0
• src/Data/Svfactor/Text/Space.hs +194/−0
• src/Data/Svfactor/Vector/NonEmpty.hs +87/−0
• svfactor.cabal +123/−0
• test/Data/Svfactor/Generators.hs +115/−0
• test/Data/Svfactor/ParseTest.hs +215/−0
• test/Data/Svfactor/PrintTest.hs +32/−0
• test/Data/Svfactor/RoundTripsParsePrint.hs +83/−0
• test/tasty.hs +15/−0

@@ -0,0 +1,31 @@+Copyright (c) 2017-2018, Commonwealth Scientific and Industrial Research Organisation+(CSIRO) ABN 41 687 119 230.++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 QFPL 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.

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

@@ -0,0 +1,5 @@+# Revision history for svfactor++## 0.1 -- 2018-07-19++* First version. Released on an unsuspecting world.

@@ -0,0 +1,18 @@+{-|+Module      : Data.Svfactor+Copyright   : (C) CSIRO 2017-2018+License     : BSD3+Maintainer  : George Wilson <george.wilson@data61.csiro.au>+Stability   : experimental+Portability : non-portable+-}++module Data.Svfactor (+  module Data.Svfactor.Parse+, module Data.Svfactor.Print+, module Data.Svfactor.Syntax+) where++import Data.Svfactor.Parse+import Data.Svfactor.Print+import Data.Svfactor.Syntax

@@ -0,0 +1,123 @@+{-|+Module      : Data.Svfactor.Parse+Copyright   : (C) CSIRO 2017-2018+License     : BSD3+Maintainer  : George Wilson <george.wilson@data61.csiro.au>+Stability   : experimental+Portability : non-portable+-}++module Data.Svfactor.Parse (+  parseSv+, parseSv'+, parseSvFromFile+, parseSvFromFile'+, separatedValues++, module Data.Svfactor.Parse.Options+, SvParser (..)+, trifecta+, trifectaResultToEither+, attoparsecByteString+, attoparsecText+) where++import Control.Applicative ((<$>))+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.Monoid (mempty)+import Data.Text (Text)+import qualified Data.Text.IO as Text+import qualified Text.Trifecta as Trifecta++import Data.Svfactor.Syntax.Sv (Sv)+import Data.Svfactor.Parse.Internal (separatedValues)+import Data.Svfactor.Parse.Options++-- | Parse a 'ByteString' as an Sv.+--+-- This version uses Trifecta, hence it assumes its input is UTF-8 encoded.+parseSv :: ParseOptions ByteString -> ByteString -> Either ByteString (Sv ByteString)+parseSv = parseSv' trifecta++-- | 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++-- | 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++-- | 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)++-- | 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.+--+-- 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 $ Trifecta.parseByteString (separatedValues opts) mempty bs+  , runSvParserFromFile = \opts fp -> trifectaResultToEither <$> Trifecta.parseFromFileEx (separatedValues opts) fp+  }++-- | 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+  }++-- | 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+  }++-- | 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+

@@ -0,0 +1,170 @@+{-|+Module      : Data.Svfactor.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 svfactor's parser.+As the Internal name suggests, this file is exempt from the PVP. Depend+on this module at your own risk!+-}++module Data.Svfactor.Parse.Internal (+  separatedValues+  , header+  , field+  , singleQuotedField+  , doubleQuotedField+  , unquotedField+  , spaced+  , spacedField+  , record+  , records+  , ending+) where++import Control.Applicative (Applicative ((<*>), pure), (*>), (<*), (<$), 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.Svfactor.Syntax.Sv (Sv (Sv), Header, mkHeader, noHeader, Headedness (Unheaded, Headed), headedness, Separator)+import Data.Svfactor.Syntax.Field (Field (Unquoted, Quoted))+import Data.Svfactor.Syntax.Record (Record (Record), Records (Records, EmptyRecords))+import Data.Svfactor.Parse.Options (ParseOptions, separator, endOnBlankLine, encodeString)+import Data.Svfactor.Vector.NonEmpty as V+import Data.Svfactor.Text.Escape (Unescaped (Unescaped))+import Data.Svfactor.Text.Newline (Newline (CR, CRLF, LF))+import Data.Svfactor.Text.Space (HorizontalSpace (Space, Tab), Spaces, Spaced, betwixt)+import Data.Svfactor.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

@@ -0,0 +1,97 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DefaultSignatures #-}++{-|+Module      : Data.Svfactor.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.Svfactor.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.Svfactor.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

@@ -0,0 +1,105 @@+{-|+Module      : Data.Svfactor.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.Svfactor.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.Svfactor.Encode"+-}++module Data.Svfactor.Print (+  printSv+, printSvLazy+, printSv'+, printSvLazy'+, printSvText+, printSvTextLazy+, writeSvToFile+, writeSvToHandle+, writeSvToFile'+, writeSvToHandle'+, module Data.Svfactor.Print.Options+) where++import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as LBS+import Data.ByteString.Builder as BSB+import Data.Foldable (Foldable (foldMap))+import Data.Semigroup ((<>))+import Data.Text (Text)+import System.IO (BufferMode (BlockBuffering), Handle, hClose, hSetBinaryMode, hSetBuffering, openFile, IOMode (WriteMode))++import Data.Svfactor.Print.Options+import Data.Svfactor.Print.Internal+import Data.Svfactor.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

@@ -0,0 +1,75 @@+{-|+Module      : Data.Svfactor.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.Svfactor.Print".+-}++module Data.Svfactor.Print.Internal (+  printNewline+  , printField+  , printSpaced+  , printRecord+  , printRecords+  , printHeader+) where++import Control.Lens (review, view)+import Data.Bifoldable (bifoldMap)+import Data.ByteString.Builder as BSB+import Data.Foldable (Foldable (foldMap))+import Data.Monoid (Monoid (mempty))+import Data.Semigroup ((<>))+import Data.Semigroup.Foldable (intercalate1)++import Data.Svfactor.Print.Options+import Data.Svfactor.Syntax.Field (Field (Quoted, Unquoted), SpacedField)+import Data.Svfactor.Syntax.Record (Record (Record), Records (Records, EmptyRecords))+import Data.Svfactor.Syntax.Sv (Header (Header), Separator)+import Data.Svfactor.Text.Newline+import Data.Svfactor.Text.Space (spaceToChar, Spaced (Spaced))+import Data.Svfactor.Text.Quote++-- | Convert a 'Newline' to a ByteString 'Builder'+printNewline :: Newline -> Builder+printNewline = BSB.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 (BSB.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 (BSB.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

@@ -0,0 +1,80 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}++{-|+Module      : Data.Svfactor.Print.Options+Copyright   : (C) CSIRO 2017-2018+License     : BSD3+Maintainer  : George Wilson <george.wilson@data61.csiro.au>+Stability   : experimental+Portability : non-portable+-}++module Data.Svfactor.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 LBS+import Data.ByteString.Builder (Builder)+import qualified Data.ByteString.Builder as Builder+import Data.Text (Text)+import qualified Data.Text.Encoding as Text++import Data.Svfactor.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 LBS.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

@@ -0,0 +1,30 @@+{-|+Module      : Data.Svfactor.Structure.Headedness+Copyright   : (C) CSIRO 2017-2018+License     : BSD3+Maintainer  : George Wilson <george.wilson@data61.csiro.au>+Stability   : experimental+Portability : non-portable+-}++module Data.Svfactor.Structure.Headedness (+  Headedness (Headed, Unheaded)+, HasHeadedness (headedness)+) where++import Control.Lens (Lens')++-- | 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

@@ -0,0 +1,18 @@+{-|+Module      : Data.Svfactor.Syntax+Copyright   : (C) CSIRO 2017-2018+License     : BSD3+Maintainer  : George Wilson <george.wilson@data61.csiro.au>+Stability   : experimental+Portability : non-portable+-}++module Data.Svfactor.Syntax (+  module Data.Svfactor.Syntax.Field+, module Data.Svfactor.Syntax.Record+, module Data.Svfactor.Syntax.Sv+) where++import Data.Svfactor.Syntax.Field+import Data.Svfactor.Syntax.Record+import Data.Svfactor.Syntax.Sv

@@ -0,0 +1,117 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveGeneric #-}++{-|+Module      : Data.Svfactor.Syntax.Field+Copyright   : (C) CSIRO 2017-2018+License     : BSD3+Maintainer  : George Wilson <george.wilson@data61.csiro.au>+Stability   : experimental+Portability : non-portable+-}++module Data.Svfactor.Syntax.Field (+    Field (Unquoted, Quoted)+  , SpacedField+  , Spaced (Spaced)+  , HasFields (fields)+  , AsField (_Field, _Unquoted, _Quoted)+  , unescapedField+  , foldField+  , fieldContents+) where++import Control.Applicative ((<$>))+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 Data.Svfactor.Text.Escape (Unescaped (Unescaped, getRawUnescaped))+import Data.Svfactor.Text.Quote (Quote)+import Data.Svfactor.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)

@@ -0,0 +1,178 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE DeriveGeneric #-}++{-|+Module      : Data.Svfactor.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.Svfactor.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.Applicative (Applicative (..), (<$>))+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.Monoid (Monoid (..))+import Data.Semigroup (Semigroup)+import Data.Traversable (Traversable (traverse))+import Data.Vector (Vector)+import qualified Data.Vector as V+import GHC.Generics (Generic)++import Data.Svfactor.Syntax.Field (SpacedField, Field (Unquoted), HasFields (fields))+import Data.Svfactor.Vector.NonEmpty (NonEmptyVector)+import qualified Data.Svfactor.Vector.NonEmpty as V+import Data.Svfactor.Text.Newline (Newline)+import Data.Svfactor.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

@@ -0,0 +1,178 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances#-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveGeneric #-}++{-|+Module      : Data.Svfactor.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.++You can program against it using the provided functions and optics.+For an example of this see+<https://github.com/qfpl/svfactor/blob/master/examples/src/Data/Svfactor/Example/Requote.hs Requote.hs>+-}++module Data.Svfactor.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.Applicative (Applicative ((<*>), pure), (<$>))+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.Svfactor.Structure.Headedness (Headedness (Headed, Unheaded), HasHeadedness (headedness))+import Data.Svfactor.Syntax.Field (HasFields (fields))+import Data.Svfactor.Syntax.Record (Record, Records (EmptyRecords), HasRecord (record), HasRecords (records, traverseNewlines, traverseRecords), recordList)+import Data.Svfactor.Text.Newline (Newline)+import Data.Svfactor.Text.Separator (Separator, HasSeparator (separator), comma, pipe, tab)++-- | '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)++instance HasSeparator (Sv s) where+  separator f (Sv x1 x2 x3 x4) =+    fmap (\y -> Sv y x2 x3 x4) (f x1)+  {-# INLINE separator #-}

@@ -0,0 +1,124 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveGeneric #-}++{-|+Module      : Data.Svfactor.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 Data.Svfactor.Text.Escape (+  Unescaped (Unescaped, getRawUnescaped)+  , Escaper+  , Escaper'+  , escapeString+  , escapeText+  , escapeUtf8+  , escapeUtf8Lazy+  , escapeChar+) where++import Control.DeepSeq (NFData)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+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' BS.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' LBS.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]

@@ -0,0 +1,84 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Module      : Data.Svfactor.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 Data.Svfactor.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+

@@ -0,0 +1,73 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}++{-|+Module      : Data.Svfactor.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 Data.Svfactor.Text.Quote (+  Quote (SingleQuote, DoubleQuote)+  , AsQuote (_Quote, _SingleQuote, _DoubleQuote)+  , quoteChar+  , quoteToString+) where++import Control.Applicative (pure)+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

@@ -0,0 +1,54 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE DeriveGeneric #-}++{-|+Module      : Data.Svfactor.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 Data.Svfactor.Text.Separator+  ( Separator+  , HasSeparator (..)+  , comma, pipe, tab+  )+where++import Control.Lens (Lens')++-- | 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 #-}++-- | 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'

@@ -0,0 +1,194 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE DeriveGeneric #-}++{-|+Module      : Data.Svfactor.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 Data.Svfactor.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.Applicative (Applicative (..))+import Control.DeepSeq (NFData (rnf))+import Control.Lens (Lens, Prism', prism, prism')+import Data.Foldable (Foldable (..))+import Data.Monoid (mempty)+import Data.Semigroup (Semigroup ((<>)))+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Traversable (Traversable (..))+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

@@ -0,0 +1,87 @@+{-# 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.Svfactor.Vector.NonEmpty (+  NonEmptyVector (NonEmptyVector)+, fromNel+, toNel+, toVector+, headNev+, tailNev+) where++import Control.Applicative (Applicative (..), (<$>))+import Control.DeepSeq (NFData)+import Control.Lens (Lens', lens)+import Data.Functor.Apply (Apply((<.>)))+import Data.Foldable (Foldable (..), toList)+import Data.List.NonEmpty (NonEmpty ((:|)))+import Data.Monoid (mappend)+import Data.Traversable (Traversable (..))+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++-- | Convert a 'NonEmptyVector' back to a 'Vector'+toVector :: NonEmptyVector a -> Vector a+toVector (NonEmptyVector a as) = V.cons a 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)

@@ -0,0 +1,123 @@+name:                svfactor+version:             0.1+license:             BSD3+license-file:        LICENCE+author:              George Wilson+maintainer:          george@qfpl.io+copyright:           Copyright (c) 2018, Commonwealth Scientific and Industrial Research Organisation (CSIRO) ABN 41 687 119 230.+category:            CSV, Text, Web+synopsis:+  Syntax-preserving CSV manipulation++description:+  <<http://i.imgur.com/uZnp9ke.png>>+  .+  svfactor is a library for parsing, manipulating, and printing CSV and+  similar formats (such as PSV, TSV, and many more).+  .+  svfactor retains all syntactic information including newlines, and+  provides lenses, prisms, and traversals to query and manipulate this+  structure.+  This should make it useful for writing custom CSV transformations and+  sanitisation tools. For example, one could easily use it to rewrite all+  CRLF newlines to LF.+  It also extends RFC4180 by allowing optional spacing surrounding fields.+  .+  svfactor's parser is exposed so you can use it independently and printing is similarly standalone.+  .+  Please note that there are __known performance problems with svfactor__.+  .+  Examples:+  .+  * Handling multiple logical documents in one file: <https://github.com/qfpl/svfactor/blob/master/examples/src/Data/Svfactor/Example/Concat.hs Concat.hs>+  * Fixing inconsistent formatting with lenses: <https://github.com/qfpl/svfactor/blob/master/examples/src/Data/Svfactor/Example/Requote.hs Requote.hs>++homepage:            https://github.com/qfpl/svfactor+bug-reports:         https://github.com/qfpl/svfactor/issues+build-type:          Simple+extra-source-files:  changelog.md+cabal-version:       >=1.10+tested-with:         GHC == 7.8.4+                     , GHC == 7.10.3+                     , GHC == 8.0.2+                     , GHC == 8.2.2+                     , GHC == 8.4.3++source-repository    head+  type:              git+  location:          git@github.com/qfpl/svfactor.git++library+  exposed-modules:     Data.Svfactor+                       , Data.Svfactor.Parse+                       , Data.Svfactor.Parse.Internal+                       , Data.Svfactor.Parse.Options+                       , Data.Svfactor.Print+                       , Data.Svfactor.Print.Internal+                       , Data.Svfactor.Print.Options+                       , Data.Svfactor.Syntax+                       , Data.Svfactor.Syntax.Field+                       , Data.Svfactor.Syntax.Record+                       , Data.Svfactor.Syntax.Sv+                       , Data.Svfactor.Text.Escape+                       , Data.Svfactor.Text.Newline+                       , Data.Svfactor.Text.Space+                       , Data.Svfactor.Text.Quote+                       , Data.Svfactor.Text.Separator+                       , Data.Svfactor.Structure.Headedness+                       , Data.Svfactor.Vector.NonEmpty++  -- other-modules:+  -- other-extensions:    +  build-depends:       attoparsec >= 0.12.1.4 && < 0.14+                       , base >=4.7 && <5+                       , bifunctors >= 5.1 && < 6+                       , bytestring >= 0.9.1.10 && < 0.11+                       , charset >=0.3 && <=0.4+                       , deepseq >= 1.1 && < 1.5+                       , lens >= 4 && < 5+                       , parsec >= 3.1 && < 3.2+                       , parsers >=0.12 && <0.13+                       , semigroupoids >= 5 && <6+                       , semigroups >= 0.18 && < 0.19+                       , text >= 1.0 && < 1.3+                       , transformers >= 0.2 && < 0.6+                       , trifecta >= 1.5 && < 2.1+                       , utf8-string >= 1 && < 1.1+                       , vector >= 0.10 && < 0.13+  hs-source-dirs:      src+  default-language:    Haskell2010+  ghc-options:+                       -Wall -O2++test-suite             tasty+  type:+                       exitcode-stdio-1.0+  main-is:+                       tasty.hs+  other-modules:+                       Data.Svfactor.Generators+                       , Data.Svfactor.ParseTest+                       , Data.Svfactor.PrintTest+                       , Data.Svfactor.RoundTripsParsePrint+  default-language:+                       Haskell2010+  build-depends:+                       base >=4.7 && <5+                       , bytestring >= 0.9.1.10 && < 0.11+                       , hedgehog >= 0.5 && < 0.7+                       , lens >= 4 && < 5+                       , parsers >=0.12 && <0.13+                       , semigroups >= 0.18 && < 0.19+                       , svfactor+                       , 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 && < 2.1+                       , utf8-string >= 1 && < 1.1+                       , vector >= 0.10 && < 0.13+  ghc-options:+                       -Wall+  hs-source-dirs:+                       test

@@ -0,0 +1,115 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Svfactor.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 BSB+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.Svfactor.Syntax.Sv (Sv (Sv), Header (Header), Headedness, getHeadedness, Separator)+import Data.Svfactor.Syntax.Field (Field (Quoted, Unquoted))+import Data.Svfactor.Syntax.Record (Record, Records (EmptyRecords, Records), recordNel)+import Data.Svfactor.Text.Escape (Unescaped (Unescaped))+import Data.Svfactor.Text.Newline (Newline (CRLF, LF))+import Data.Svfactor.Text.Space (Spaces, Spaced (Spaced))+import Data.Svfactor.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 BSB.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 = BSB.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 . BSB.toLazyByteString) $ intercalate' <$> genNewlineString <*> Gen.nonEmpty (Range.linear 0 100) genCsvRowString

@@ -0,0 +1,215 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE OverloadedStrings #-}++module Data.Svfactor.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.Parser.Char (CharParsing)+import Text.Trifecta (Result (Success, Failure), parseByteString, _errDoc)++import Data.Svfactor.Generators (genCsvString)+import Data.Svfactor.Parse (ParseOptions, defaultParseOptions, headedness, separator, encodeString)+import Data.Svfactor.Parse.Internal (doubleQuotedField, record, separatedValues, singleQuotedField, spaced, spacedField)+import Data.Svfactor.Syntax.Sv (Sv, mkSv, comma, pipe, tab, Headedness (Unheaded), Separator)+import Data.Svfactor.Syntax.Field (Field (Quoted, Unquoted), SpacedField)+import Data.Svfactor.Syntax.Record (Record (Record), recordNel, mkRecords, Records (EmptyRecords))+import Data.Svfactor.Text.Escape (Unescaped (Unescaped))+import Data.Svfactor.Text.Newline (Newline (CR, LF, CRLF), newlineToString)+import Data.Svfactor.Text.Space (Spaced (Spaced), manySpaces, unspaced)+import Data.Svfactor.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

@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Svfactor.PrintTest (test_Print) where++import Data.ByteString (ByteString)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit ((@?=), testCase)++import Data.Svfactor.Print (printSv)+import Data.Svfactor.Syntax.Field (Field (Quoted))+import Data.Svfactor.Syntax.Record (Records (EmptyRecords), singleField, singleRecord)+import Data.Svfactor.Syntax.Sv (Sv (Sv), noHeader, comma)+import Data.Svfactor.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)+  ]

@@ -0,0 +1,83 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}++module Data.Svfactor.RoundTripsParsePrint (test_Roundtrips) where++import Control.Lens ((&), (.~))+import Data.ByteString (ByteString)+import qualified Data.ByteString.Builder as BSB+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.UTF8 as UTF8+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.Svfactor.Parse (trifectaResultToEither)+import Data.Svfactor.Generators+import Data.Svfactor.Syntax (Sv, Headedness, SpacedField, comma)+import Data.Svfactor.Parse (defaultParseOptions, headedness, encodeString, separatedValues)+import Data.Svfactor.Parse.Internal (spacedField)+import Data.Svfactor.Print (defaultPrintOptions, printSvText)+import Data.Svfactor.Print.Internal (printSpaced)+import Data.Svfactor.Text.Space (HorizontalSpace (Space, Tab), Spaces)+ +test_Roundtrips :: TestTree+test_Roundtrips =+  testGroup "Round trips" [+    csvRoundTrip+  , fieldRoundTrip+  ]++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))+        (LBS.toStrict . BSB.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)

@@ -0,0 +1,15 @@+module Main (main) where++import Test.Tasty (defaultMain, testGroup)++import Data.Svfactor.ParseTest (test_Parse)+import Data.Svfactor.PrintTest (test_Print)+import Data.Svfactor.RoundTripsParsePrint (test_Roundtrips)++main :: IO ()+main =+  defaultMain $ testGroup "Tests" [+    test_Parse+  , test_Print+  , test_Roundtrips+  ]