diff --git a/LICENCE b/LICENCE --- a/LICENCE +++ b/LICENCE @@ -1,4 +1,4 @@ -Copyright (c) 2017-2018, Commonwealth Scientific and Industrial Research Organisation +Copyright (c) 2017-2019, Commonwealth Scientific and Industrial Research Organisation (CSIRO) ABN 41 687 119 230. All rights reserved. diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,10 @@ # Revision history for sv-core +## 0.4.1 -- 2019-04-02 + +* Add `displayErrors`, which pretty prints `DecodeErrors`. +* Add `dieOnError`, which calls `exitFailure` in the case of `DecodeErrors` + ## 0.4 -- 2019-01-14 * Use attoparsec for decoding in `double`, which is faster and more accurate diff --git a/src/Data/Sv/Decode/Core.hs b/src/Data/Sv/Decode/Core.hs --- a/src/Data/Sv/Decode/Core.hs +++ b/src/Data/Sv/Decode/Core.hs @@ -4,7 +4,7 @@ {-| Module : Data.Sv.Decode.Core -Copyright : (C) CSIRO 2017-2018 +Copyright : (C) CSIRO 2017-2019 License : BSD3 Maintainer : George Wilson Stability : experimental diff --git a/src/Data/Sv/Decode/Error.hs b/src/Data/Sv/Decode/Error.hs --- a/src/Data/Sv/Decode/Error.hs +++ b/src/Data/Sv/Decode/Error.hs @@ -1,6 +1,9 @@ +{-# language OverloadedStrings #-} +{-# language ScopedTypeVariables #-} + {-| Module : Data.Sv.Decode.Error -Copyright : (C) CSIRO 2017-2018 +Copyright : (C) CSIRO 2017-2019 License : BSD3 Maintainer : George Wilson Stability : experimental @@ -22,6 +25,12 @@ , badParse , badDecode +-- * Display +, displayErrors +, displayErrors' +, dieOnError +, dieOnError' + -- * Conversions , validateEither , validateEitherWith @@ -32,9 +41,22 @@ , bindValidation ) where +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as Char8 +import Data.Foldable (toList) +import Data.List (intersperse) +import Data.Semigroup (Semigroup ((<>))) +import Data.Semigroup.Foldable (Foldable1 (foldMap1)) +import Data.String (IsString) +import qualified Data.Text.Encoding as T +import qualified Data.Text.Lazy as LT +import qualified Data.Text.Lazy.IO as LT +import Data.Text.Lazy.Builder (Builder) +import qualified Data.Text.Lazy.Builder as Builder import Data.Validation (Validation (Failure), bindValidation) import Data.Vector (Vector) import qualified Text.Trifecta.Result as Trifecta +import System.Exit (exitFailure) import Data.Sv.Decode.Type @@ -107,3 +129,77 @@ trifectaResultToEither r = case r of Trifecta.Failure e -> Left . show . Trifecta._errDoc $ e Trifecta.Success a -> Right a + +-- | Pretty print errors as a string. Each error is on its own line. +displayErrors :: DecodeErrors ByteString -> LT.Text +displayErrors = displayErrors' buildBytestring + +-- | Pretty print errors as a string. Each error is on its own line. +-- +-- This version lets you work with any 'String' type in your errors. +displayErrors' :: forall e. (e -> Builder) -> DecodeErrors e -> LT.Text +displayErrors' build (DecodeErrors errs) = + let + indent :: Builder -> Builder + indent x = " " <> x + + displayErr :: DecodeError e -> Builder + displayErr e = indent $ case e of + BadParse msg -> "Parsing the document failed. The error was: " <> build msg + UnexpectedEndOfRow -> "Expected more fields, but the row ended." + ExpectedEndOfRow extras -> + "Expected fewer fields in the row. The extra fields contained: " <> + commaSep (bquote <$> toList extras) + UnknownCategoricalValue found required -> + "Unknown categorical value found: " <> bquote found <> ". Expected one of: " <> + (commaSep . fmap bquote . mconcat) required + MissingColumn name -> "Could not find required column " <> bquote name + MissingHeader -> "A header row was required, but one was not found." + BadConfig msg -> "sv was misconfigured: " <> build msg + BadDecode msg -> "Decoding a field failed: " <> build msg + + displayAndCount = count . displayErr + Counted body c = foldMap1 displayAndCount errs + spaceSep = mconcat . intersperse " " + commaSep = mconcat . intersperse ", " + quote s = "\"" <> s <> "\"" + bquote = quote . build + pluralise n s = + if n == 1 + then s + else Builder.fromString (show n) <> " " <> s <> "s" + heading = spaceSep ["The following", pluralise c "error", "occurred:"] + in + Builder.toLazyText $ heading <> "\n" <> body + +-- | If the 'DecodeValidation' is a 'Failure', print a pretty error message +-- and call 'exitFailure' +dieOnError :: DecodeValidation ByteString a -> IO a +dieOnError = dieOnError' buildBytestring + +-- | If the 'DecodeValidation' is a 'Failure', print a pretty error message +-- and call 'exitFailure' +-- +-- This version lets you work with different String types. +dieOnError' :: (e -> Builder) -> DecodeValidation e a -> IO a +dieOnError' build e = case e of + Failure errs -> do + LT.putStrLn $ displayErrors' build errs + exitFailure + Success a -> pure a + +---- internal + +buildBytestring :: ByteString -> Builder +buildBytestring bs = case T.decodeUtf8' bs of + Left _ -> Builder.fromString $ Char8.unpack bs + Right b -> Builder.fromText b + +data Counted e = Counted e Integer + +count :: e -> Counted e +count e = Counted e 1 + +instance (Semigroup e, IsString e) => Semigroup (Counted e) where + Counted b c <> Counted b' c' = + Counted (b <> "\n" <> b') (c+c') diff --git a/src/Data/Sv/Decode/Type.hs b/src/Data/Sv/Decode/Type.hs --- a/src/Data/Sv/Decode/Type.hs +++ b/src/Data/Sv/Decode/Type.hs @@ -4,7 +4,7 @@ {-| Module : Data.Sv.Decode.Type -Copyright : (C) CSIRO 2017-2018 +Copyright : (C) CSIRO 2017-2019 License : BSD3 Maintainer : George Wilson Stability : experimental diff --git a/src/Data/Sv/Encode/Core.hs b/src/Data/Sv/Encode/Core.hs --- a/src/Data/Sv/Encode/Core.hs +++ b/src/Data/Sv/Encode/Core.hs @@ -3,7 +3,7 @@ {-| Module : Data.Sv.Encode.Core -Copyright : (C) CSIRO 2017-2018 +Copyright : (C) CSIRO 2017-2019 License : BSD3 Maintainer : George Wilson Stability : experimental diff --git a/src/Data/Sv/Encode/Options.hs b/src/Data/Sv/Encode/Options.hs --- a/src/Data/Sv/Encode/Options.hs +++ b/src/Data/Sv/Encode/Options.hs @@ -1,6 +1,6 @@ {-| Module : Data.Sv.Encode.Options -Copyright : (C) CSIRO 2017-2018 +Copyright : (C) CSIRO 2017-2019 License : BSD3 Maintainer : George Wilson Stability : experimental diff --git a/src/Data/Sv/Encode/Type.hs b/src/Data/Sv/Encode/Type.hs --- a/src/Data/Sv/Encode/Type.hs +++ b/src/Data/Sv/Encode/Type.hs @@ -2,7 +2,7 @@ {-| Module : Data.Sv.Encode.Type -Copyright : (C) CSIRO 2017-2018 +Copyright : (C) CSIRO 2017-2019 License : BSD3 Maintainer : George Wilson Stability : experimental diff --git a/src/Data/Sv/Structure/Core.hs b/src/Data/Sv/Structure/Core.hs --- a/src/Data/Sv/Structure/Core.hs +++ b/src/Data/Sv/Structure/Core.hs @@ -1,6 +1,6 @@ {-| Module : Data.Sv.Structure.Core -Copyright : (C) CSIRO 2017-2018 +Copyright : (C) CSIRO 2017-2019 License : BSD3 Maintainer : George Wilson Stability : experimental diff --git a/src/Data/Sv/Structure/Headedness.hs b/src/Data/Sv/Structure/Headedness.hs --- a/src/Data/Sv/Structure/Headedness.hs +++ b/src/Data/Sv/Structure/Headedness.hs @@ -1,6 +1,6 @@ {-| Module : Data.Sv.Structure.Headedness -Copyright : (C) CSIRO 2017-2018 +Copyright : (C) CSIRO 2017-2019 License : BSD3 Maintainer : George Wilson Stability : experimental diff --git a/src/Data/Sv/Structure/Newline.hs b/src/Data/Sv/Structure/Newline.hs --- a/src/Data/Sv/Structure/Newline.hs +++ b/src/Data/Sv/Structure/Newline.hs @@ -1,6 +1,6 @@ {-| Module : Data.Sv.Structure.Newline -Copyright : (C) CSIRO 2017-2018 +Copyright : (C) CSIRO 2017-2019 License : BSD3 Maintainer : George Wilson Stability : experimental diff --git a/src/Data/Sv/Structure/Separator.hs b/src/Data/Sv/Structure/Separator.hs --- a/src/Data/Sv/Structure/Separator.hs +++ b/src/Data/Sv/Structure/Separator.hs @@ -1,6 +1,6 @@ {-| Module : Data.Sv.Structure.Separator -Copyright : (C) CSIRO 2017-2018 +Copyright : (C) CSIRO 2017-2019 License : BSD3 Maintainer : George Wilson Stability : experimental diff --git a/sv-core.cabal b/sv-core.cabal --- a/sv-core.cabal +++ b/sv-core.cabal @@ -1,10 +1,10 @@ name: sv-core -version: 0.4 +version: 0.4.1 license: BSD3 license-file: LICENCE author: George Wilson maintainer: george@qfpl.io -copyright: Copyright (c) 2017-2018, Commonwealth Scientific and Industrial Research Organisation (CSIRO) ABN 41 687 119 230. +copyright: Copyright (c) 2017-2019, Commonwealth Scientific and Industrial Research Organisation (CSIRO) ABN 41 687 119 230. category: CSV, Text, Web synopsis: Encode and decode separated values (CSV, PSV, ...) @@ -29,7 +29,7 @@ , GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.4 - , GHC == 8.6.3 + , GHC == 8.6.4 source-repository head type: git @@ -96,7 +96,7 @@ , text >= 1.0 && < 1.3 , validation >= 1 && < 1.1 , vector >= 0.10 && < 0.13 - , QuickCheck >= 2.10 && < 2.13 + , QuickCheck >= 2.10 && < 2.14 ghc-options: -Wall hs-source-dirs: