Skip to content

Commit cb80c1a

Browse files
brandonchinn178brandonchinn178
authored
Improve errors (#11)
* Break out KDL.DecoderSpec * Special case rendering parse errors * Show filepath in error message in decodeFileWith * Update changelog
1 parent 6ecd0a9 commit cb80c1a

9 files changed

Lines changed: 177 additions & 116 deletions

File tree

‎CHANGELOG.md‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,8 @@
11
## Unreleased
22

3+
* Improve rendering parse errors
4+
* Include filepath in error messages when `decodeFileWith` fails
5+
36
## v0.2.1
47

58
* Add `KDL.Applicative`

‎kdl-hs.cabal‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -61,12 +61,15 @@ test-suite kdl-tests
6161
main-is: Main.hs
6262
other-modules:
6363
KDL.ApplicativeSpec
64-
KDL.ParserSpec
64+
KDL.DecoderSpec
6565
KDL.Decoder.ArrowSpec
6666
KDL.Decoder.MonadSpec
67+
KDL.ParserSpec
68+
KDL.TestUtils.Error
6769
build-depends:
6870
base
6971
, containers
72+
, filepath
7073
, kdl-hs
7174
, skeletest
7275
, temporary

‎src/KDL/Decoder/Arrow.hs‎

Lines changed: 12 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -92,6 +92,7 @@ import Control.Monad (unless, when)
9292
import Control.Monad.Trans.Class qualified as Trans
9393
import Control.Monad.Trans.State.Strict (StateT)
9494
import Control.Monad.Trans.State.Strict qualified as StateT
95+
import Data.Bifunctor (first)
9596
import Data.Bits (finiteBitSize)
9697
import Data.Int (Int64)
9798
import Data.List (partition)
@@ -134,22 +135,27 @@ import Prelude qualified
134135

135136
-- | Decode the given KDL configuration with the given decoder.
136137
decodeWith :: DocumentDecoder a -> Text -> Either DecodeError a
137-
decodeWith decoder = decodeFromParseResult decoder . parse
138+
decodeWith decoder = decodeFromParseResult decoder Nothing . parse
138139

139140
-- | Read KDL configuration from the given file path and decode it with the given decoder.
140141
decodeFileWith :: DocumentDecoder a -> FilePath -> IO (Either DecodeError a)
141-
decodeFileWith decoder = fmap (decodeFromParseResult decoder) . parseFile
142+
decodeFileWith decoder fp = decodeFromParseResult decoder (Just fp) <$> parseFile fp
142143

143144
-- | Decode an already-parsed 'Document' with the given decoder.
144145
decodeDocWith :: DocumentDecoder a -> Document -> Either DecodeError a
145146
decodeDocWith (UnsafeDocumentDecoder decoder) doc =
146147
runDecodeM . runDecodeStateM doc emptyDecodeHistory $
147148
decoder.run ()
148149

149-
decodeFromParseResult :: DocumentDecoder a -> Either Text Document -> Either DecodeError a
150-
decodeFromParseResult decoder = \case
151-
Left e -> runDecodeM . decodeThrow $ DecodeError_ParseError e
152-
Right doc -> decodeDocWith decoder doc
150+
decodeFromParseResult ::
151+
DocumentDecoder a ->
152+
Maybe FilePath ->
153+
Either Text Document ->
154+
Either DecodeError a
155+
decodeFromParseResult decoder mPath =
156+
first (\e -> e{filepath = mPath}) . \case
157+
Left e -> runDecodeM . decodeThrow $ DecodeError_ParseError e
158+
Right doc -> decodeDocWith decoder doc
153159

154160
{----- Decoder -----}
155161

‎src/KDL/Decoder/Internal/DecodeM.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
{-# LANGUAGE DuplicateRecordFields #-}
22
{-# LANGUAGE LambdaCase #-}
3+
{-# LANGUAGE OverloadedRecordDot #-}
34
{-# LANGUAGE OverloadedStrings #-}
45
{-# LANGUAGE RecordWildCards #-}
56
{-# LANGUAGE NoFieldSelectors #-}
@@ -70,7 +71,7 @@ runDecodeM (DecodeM f) = f Left Left Right
7071
-- This error is non-fatal and can be handled by '<|>'. See 'makeFatal'
7172
-- for more information.
7273
decodeThrow :: BaseDecodeError -> DecodeM a
73-
decodeThrow e = DecodeM $ \_ onFail _ -> onFail $ DecodeError [([], e)]
74+
decodeThrow e = DecodeM $ \_ onFail _ -> onFail $ DecodeError Nothing [([], e)]
7475

7576
-- | Throw a 'DecodeError_Custom' error.
7677
failM :: Text -> DecodeM a
@@ -91,4 +92,4 @@ makeNonFatal (DecodeM f) = DecodeM $ \_ onFail onSuccess -> f onFail onFail onSu
9192
addContext :: ContextItem -> DecodeM a -> DecodeM a
9293
addContext ctxItem (DecodeM f) = DecodeM $ \onFatal onFail onSuccess -> f (onFatal . addCtx) (onFail . addCtx) onSuccess
9394
where
94-
addCtx (DecodeError es) = DecodeError [(ctxItem : ctx, msg) | (ctx, msg) <- es]
95+
addCtx e = e{errors = [(ctxItem : ctx, msg) | (ctx, msg) <- e.errors]}

‎src/KDL/Decoder/Internal/Error.hs‎

Lines changed: 23 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
{-# LANGUAGE DuplicateRecordFields #-}
22
{-# LANGUAGE LambdaCase #-}
3+
{-# LANGUAGE OverloadedRecordDot #-}
34
{-# LANGUAGE OverloadedStrings #-}
45
{-# LANGUAGE RecordWildCards #-}
56
{-# LANGUAGE NoFieldSelectors #-}
@@ -12,6 +13,7 @@ module KDL.Decoder.Internal.Error (
1213
renderDecodeError,
1314
) where
1415

16+
import Control.Applicative ((<|>))
1517
import Data.Map qualified as Map
1618
import Data.Text (Text)
1719
import Data.Text qualified as Text
@@ -24,12 +26,15 @@ import KDL.Types (
2426
Value,
2527
)
2628

27-
data DecodeError = DecodeError [(Context, BaseDecodeError)]
29+
data DecodeError = DecodeError
30+
{ filepath :: Maybe FilePath
31+
, errors :: [(Context, BaseDecodeError)]
32+
}
2833
deriving (Show, Eq)
2934
instance Semigroup DecodeError where
30-
DecodeError e1 <> DecodeError e2 = DecodeError (e1 <> e2)
35+
DecodeError fp1 e1 <> DecodeError fp2 e2 = DecodeError (fp1 <|> fp2) (e1 <> e2)
3136
instance Monoid DecodeError where
32-
mempty = DecodeError []
37+
mempty = DecodeError Nothing []
3338

3439
type Context = [ContextItem]
3540

@@ -60,13 +65,24 @@ data BaseDecodeError
6065
deriving (Show, Eq)
6166

6267
renderDecodeError :: DecodeError -> Text
63-
renderDecodeError = Text.intercalate "\n" . map renderCtxErrors . groupCtxErrors
68+
renderDecodeError decodeError =
69+
Text.intercalate "\n"
70+
. addPath decodeError.filepath
71+
. map renderCtxErrors
72+
. groupCtxErrors
73+
$ decodeError.errors
6474
where
6575
-- Group errors with the same contexts together
66-
groupCtxErrors (DecodeError es) = Map.toAscList $ Map.fromListWith (<>) [(ctx, [e]) | (ctx, e) <- es]
76+
groupCtxErrors es = Map.toAscList $ Map.fromListWith (<>) [(ctx, [e]) | (ctx, e) <- es]
6777

68-
renderCtxErrors (ctx, errs) =
69-
Text.intercalate "\n" $ ("At: " <> renderCtxItems ctx) : renderErrors errs
78+
addPath = \case
79+
Nothing -> id
80+
Just fp -> let msg = "Failed to decode " <> Text.pack fp <> ":" in (msg :)
81+
82+
renderCtxErrors = \case
83+
-- Special case parse errors, which shouldn't have a context
84+
(_, [DecodeError_ParseError msg]) -> msg
85+
(ctx, errs) -> Text.intercalate "\n" $ ("At: " <> renderCtxItems ctx) : renderErrors errs
7086

7187
renderCtxItems items
7288
| null items = "<root>"

‎test/KDL/Decoder/ArrowSpec.hs‎

Lines changed: 2 additions & 50 deletions
Original file line numberDiff line numberDiff line change
@@ -5,14 +5,15 @@
55
module KDL.Decoder.ArrowSpec (spec) where
66

77
import Control.Arrow (returnA)
8-
import Control.Monad (forM_, unless, when)
8+
import Control.Monad (forM_, unless)
99
import Data.Int (Int64)
1010
import Data.Map qualified as Map
1111
import Data.Proxy (Proxy (..))
1212
import Data.Text (Text)
1313
import Data.Text qualified as Text
1414
import Data.Typeable (typeRep)
1515
import KDL.Arrow qualified as KDL
16+
import KDL.TestUtils.Error (decodeErrorMsg)
1617
import KDL.Types (
1718
Entry (..),
1819
Identifier (..),
@@ -22,12 +23,6 @@ import KDL.Types (
2223
ValueData (..),
2324
)
2425
import Skeletest
25-
import Skeletest.Predicate qualified as P
26-
27-
decodeErrorMsg :: [Text] -> Predicate IO (Either KDL.DecodeError a)
28-
decodeErrorMsg msgs = P.left (KDL.renderDecodeError P.>>> P.eq msg)
29-
where
30-
msg = Text.intercalate "\n" msgs
3126

3227
spec :: Spec
3328
spec = do
@@ -38,49 +33,6 @@ spec = do
3833

3934
apiSpec :: Spec
4035
apiSpec = do
41-
describe "decodeWith" $ do
42-
it "fails with helpful error if parsing fails" $ do
43-
let config = "foo hello= 123"
44-
decoder = KDL.document $ KDL.node @Node "foo"
45-
KDL.decodeWith decoder config
46-
`shouldSatisfy` decodeErrorMsg
47-
[ "At: <root>"
48-
, " 1:10:"
49-
, " |"
50-
, " 1 | foo hello= 123"
51-
, " | ^^"
52-
, " unexpected \"= \""
53-
, " expecting Node Child, Node Space, or Node Terminator"
54-
]
55-
56-
it "fails with user-defined error" $ do
57-
let config = "foo -1"
58-
decoder =
59-
KDL.document . KDL.argAtWith "foo" $
60-
KDL.withDecoder KDL.number $ \x -> do
61-
when (x < 0) $ do
62-
KDL.failM $ "Got negative number: " <> (Text.pack . show) x
63-
pure x
64-
KDL.decodeWith decoder config
65-
`shouldSatisfy` decodeErrorMsg
66-
[ "At: foo #0 > arg #0"
67-
, " Got negative number: -1.0"
68-
]
69-
70-
it "shows context in deeply nested error" $ do
71-
let config = "foo; foo { bar { baz; baz; baz; baz a=1; }; }"
72-
decoder =
73-
KDL.document
74-
. (KDL.many . KDL.nodeWith "foo" . KDL.children)
75-
. (KDL.many . KDL.nodeWith "bar" . KDL.children)
76-
. (KDL.many . KDL.nodeWith "baz")
77-
$ KDL.optional (KDL.prop @Text "a")
78-
KDL.decodeWith decoder config
79-
`shouldSatisfy` decodeErrorMsg
80-
[ "At: foo #1 > bar #0 > baz #3 > prop a"
81-
, " Expected text, got: 1"
82-
]
83-
8436
describe "NodeListDecoder" $ do
8537
describe "node" $ do
8638
it "decodes a node" $ do

‎test/KDL/Decoder/MonadSpec.hs‎

Lines changed: 2 additions & 50 deletions
Original file line numberDiff line numberDiff line change
@@ -3,11 +3,12 @@
33

44
module KDL.Decoder.MonadSpec (spec) where
55

6-
import Control.Monad (forM_, unless, when)
6+
import Control.Monad (forM_, unless)
77
import Data.Map qualified as Map
88
import Data.Text (Text)
99
import Data.Text qualified as Text
1010
import KDL qualified
11+
import KDL.TestUtils.Error (decodeErrorMsg)
1112
import KDL.Types (
1213
Entry (..),
1314
Identifier (..),
@@ -17,12 +18,6 @@ import KDL.Types (
1718
ValueData (..),
1819
)
1920
import Skeletest
20-
import Skeletest.Predicate qualified as P
21-
22-
decodeErrorMsg :: [Text] -> Predicate IO (Either KDL.DecodeError a)
23-
decodeErrorMsg msgs = P.left (KDL.renderDecodeError P.>>> P.eq msg)
24-
where
25-
msg = Text.intercalate "\n" msgs
2621

2722
spec :: Spec
2823
spec = do
@@ -32,49 +27,6 @@ spec = do
3227

3328
apiSpec :: Spec
3429
apiSpec = do
35-
describe "decodeWith" $ do
36-
it "fails with helpful error if parsing fails" $ do
37-
let config = "foo hello= 123"
38-
decoder = KDL.document $ KDL.node @Node "foo"
39-
KDL.decodeWith decoder config
40-
`shouldSatisfy` decodeErrorMsg
41-
[ "At: <root>"
42-
, " 1:10:"
43-
, " |"
44-
, " 1 | foo hello= 123"
45-
, " | ^^"
46-
, " unexpected \"= \""
47-
, " expecting Node Child, Node Space, or Node Terminator"
48-
]
49-
50-
it "fails with user-defined error" $ do
51-
let config = "foo -1"
52-
decoder =
53-
KDL.document . KDL.argAtWith "foo" $
54-
KDL.withDecoder KDL.number $ \x -> do
55-
when (x < 0) $ do
56-
KDL.failM $ "Got negative number: " <> (Text.pack . show) x
57-
pure x
58-
KDL.decodeWith decoder config
59-
`shouldSatisfy` decodeErrorMsg
60-
[ "At: foo #0 > arg #0"
61-
, " Got negative number: -1.0"
62-
]
63-
64-
it "shows context in deeply nested error" $ do
65-
let config = "foo; foo { bar { baz; baz; baz; baz a=1; }; }"
66-
decoder =
67-
KDL.document
68-
. (KDL.many . KDL.nodeWith "foo" . KDL.children)
69-
. (KDL.many . KDL.nodeWith "bar" . KDL.children)
70-
. (KDL.many . KDL.nodeWith "baz")
71-
$ KDL.optional (KDL.prop @Text "a")
72-
KDL.decodeWith decoder config
73-
`shouldSatisfy` decodeErrorMsg
74-
[ "At: foo #1 > bar #0 > baz #3 > prop a"
75-
, " Expected text, got: 1"
76-
]
77-
7830
describe "NodeListDecoder" $ do
7931
describe "node" $ do
8032
it "decodes a node" $ do

0 commit comments

Comments
 (0)
⚡