yaml-marked 0.1.0.0 → 0.2.0.0

raw patch · 9 files changed

+126/−14 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• src/Data/Aeson/Compat.hs +16/−0
• src/Data/Aeson/Compat/Key.hs +6/−2
• src/Data/Yaml/Marked.hs +3/−0
• src/Data/Yaml/Marked/Internal.hs +9/−2
• src/Data/Yaml/Marked/Parse.hs +33/−7
• src/Data/Yaml/Marked/Value.hs +1/−1
• test/Data/Yaml/Marked/DecodeSpec.hs +52/−1
• yaml-marked.cabal +1/−1

@@ -1,5 +1,10 @@ ## [_Unreleased_](https://github.com/pbrisbin/yaml-marked/compare/v0.1.0.0...main) +## [v0.2.0.0](https://github.com/pbrisbin/yaml-marked/compare/v0.1.0.0...v0.2.0.0)++- Prepend errors with JSON path information+- Add `markedJSONPath`+ ## [v0.1.0.0](https://github.com/pbrisbin/yaml-marked/tree/v0.1.0.0)  First tagged release.

@@ -3,16 +3,32 @@ module Data.Aeson.Compat #if MIN_VERSION_aeson(2, 0, 0)   ( module Data.Aeson+  , parseEither   ) where  import Data.Aeson++#if MIN_VERSION_aeson(2, 1, 0)+import Prelude+import Data.Aeson.Types (Parser, IResult(..), iparse)++parseEither :: (a -> Parser b) -> a -> Either String b+parseEither f a = case iparse f a of+  IError _ x -> Left x+  ISuccess b -> Right b #else+import Data.Aeson.Types (parseEither)+#endif++#else   ( Key   , module Data.Aeson+  , parseEither   ) where  import Data.Aeson import Data.Text (Text)+import Data.Aeson.Types (parseEither)  type Key = Text #endif

@@ -4,13 +4,14 @@   ( Key   , fromText   , toText+  , toString   ) where  #if MIN_VERSION_aeson(2, 0, 0) import Data.Aeson.Key #else-import Prelude (id)-import Data.Text (Text)+import Prelude+import Data.Text (Text, unpack)  type Key = Text @@ -19,4 +20,7 @@  toText :: Key -> Text toText = id++toString :: Key -> String+toString = unpack . toText #endif

@@ -9,12 +9,14 @@  import Prelude +import Data.Aeson (JSONPath) import Numeric.Natural import Text.Libyaml (Event, MarkedEvent (..), YamlMark (..))  data Marked a = Marked   { markedItem :: a   , markedPath :: FilePath+  , markedJSONPath :: Maybe JSONPath   , markedLocationStart :: Location   -- ^ Location of the first character of the item   --@@ -59,6 +61,7 @@   Marked     { markedItem = yamlEvent     , markedPath = fp+    , markedJSONPath = Nothing     , markedLocationStart = locationFromYamlMark yamlStartMark     , markedLocationEnd = locationFromYamlMark yamlEndMark     }

@@ -121,6 +121,7 @@     Marked       { markedItem = Null       , markedPath = fp+      , markedJSONPath = Nothing       , markedLocationStart = Location 0 0 0       , markedLocationEnd = Location 0 0 0       }@@ -213,10 +214,12 @@   peekC >>= \case     Just me | EventSequenceEnd <- markedItem me -> do       dropC 1+      path <- asks reverse       let res =             Marked               { markedItem = Array $ V.fromList $ front []               , markedPath = markedPath me+              , markedJSONPath = Just path               , markedLocationStart = startLocation               , markedLocationEnd = fromMaybe startLocation mEndLocation               }@@ -238,10 +241,12 @@ parseMapping startLocation mEndLocation mergedKeys a front =   headC >>= \case     Just me | EventMappingEnd <- markedItem me -> do+      path <- asks reverse       let res =             Marked               { markedItem = Object front               , markedPath = markedPath me+              , markedJSONPath = Just path               , markedLocationStart = startLocation               , markedLocationEnd = fromMaybe startLocation mEndLocation               }@@ -255,7 +260,7 @@           | EventAlias an <- markedItem me' ->               lookupAliasKey an         _ -> do-          path <- ask+          path <- asks reverse           throwIO $ NonStringKey path        ((mergedKeys', al'), endLocation) <- local (Key s :) $ do@@ -303,7 +308,9 @@   -> ConduitT (Marked Event) o Parse (Marked Value) parseScalar me v tag style a = do   s <- parseScalarText me v tag style a-  pure $ textToValue style tag s <$ me+  let mv = textToValue style tag s <$ me+  path <- lift $ asks reverse+  pure $ mv {markedJSONPath = Just path}  parseScalarKey   :: Marked Event

@@ -13,13 +13,18 @@   , double   , int   , bool++    -- * Lower-level+  , withPrependedPath   ) where  import Prelude  import Data.Aeson.Compat (FromJSON, Key) import qualified Data.Aeson.Compat as Aeson+import qualified Data.Aeson.Compat.Key as Key import qualified Data.Aeson.Compat.KeyMap as KeyMap+import Data.Aeson.Types (formatRelativePath) import Data.Bifunctor (first) import Data.Foldable (toList) import Data.Scientific (Scientific)@@ -32,7 +37,7 @@   -> (MarkedObject -> Either String a)   -> Marked Value   -> Either String (Marked a)-withObject label f = traverse $ \case+withObject label f = withPrependedPath $ \case   Object hm -> f hm   v -> prependContext label $ typeMismatch "Object" v @@ -41,7 +46,7 @@   -> (MarkedArray -> Either String a)   -> Marked Value   -> Either String (Marked a)-withArray label f = traverse $ \case+withArray label f = withPrependedPath $ \case   Array v -> f v   v -> prependContext label $ typeMismatch "Array" v @@ -50,7 +55,7 @@   -> (Text -> Either String a)   -> Marked Value   -> Either String (Marked a)-withText label f = traverse $ \case+withText label f = withPrependedPath $ \case   String t -> f t   v -> prependContext label $ typeMismatch "String" v @@ -59,7 +64,7 @@   -> (Scientific -> Either String a)   -> Marked Value   -> Either String (Marked a)-withScientific label f = traverse $ \case+withScientific label f = withPrependedPath $ \case   Number s -> f s   v -> prependContext label $ typeMismatch "Number" v @@ -68,7 +73,7 @@   -> (Bool -> Either String a)   -> Marked Value   -> Either String (Marked a)-withBool label f = traverse $ \case+withBool label f = withPrependedPath $ \case   Bool b -> f b   v -> prependContext label $ typeMismatch "Bool" v @@ -90,7 +95,7 @@   prefix = "expected " <> expected <> ", but encountered "  (.:) :: MarkedObject -> Key -> Either String (Marked Value)-(.:) km k = maybe (Left "Key not found") Right $ KeyMap.lookup k km+(.:) km k = maybe (Left $ "Key not found: " <> Key.toString k) Right $ KeyMap.lookup k km  (.:?) :: MarkedObject -> Key -> Either String (Maybe (Marked Value)) (.:?) km k = Right $ KeyMap.lookup k km@@ -103,7 +108,7 @@  -- | Parse the value using its 'FromJSON' instance, passing along the marks json :: FromJSON a => Marked Value -> Either String (Marked a)-json = traverse valueAsJSON+json = withPrependedPath valueAsJSON  value :: Marked Value -> Either String (Marked Aeson.Value) value = json@@ -119,3 +124,24 @@  bool :: Marked Value -> Either String (Marked Bool) bool = json++-- | Prepend an error with an item's 'markedJSONPath', when present+--+-- All of the functions above do this already. You would only need this if+-- you're writing something that doesn't us them.+withPrependedPath+  :: (val -> Either String a)+  -> Marked val+  -> Either String (Marked a)+withPrependedPath f mv = first format $ traverse f mv+ where+  format :: String -> String+  format = case markedJSONPath mv of+    Nothing -> id+    Just [] -> prependPathElem "Error in $"+    Just xs -> prependPathElem $ formatRelativePath [last xs]++prependPathElem :: String -> String -> String+prependPathElem prefix = \case+  ys@('[' : _) -> prefix <> ys -- ys is "[k]", make it (e.g.) "$[k]"+  ys -> prefix <> ": " <> ys -- ys is "{...}", make it (e.g.) "$: {...}"

@@ -10,8 +10,8 @@  import Data.Aeson (FromJSON (..)) import qualified Data.Aeson as Aeson+import Data.Aeson.Compat (parseEither) import Data.Aeson.Compat.KeyMap (KeyMap)-import Data.Aeson.Types (parseEither) import Data.Scientific (Scientific) import Data.Text (Text) import Data.Vector (Vector)

@@ -4,7 +4,9 @@  import Prelude +import Data.Aeson.Types (JSONPathElement (..)) import Data.Functor.Alt ((<!>))+import Data.List (isPrefixOf) import Data.Text (Text) import Data.Yaml.Marked import Data.Yaml.Marked.Decode@@ -32,7 +34,7 @@   deriving stock (Eq, Show)  decodeExtraDep :: Marked Value -> Either String (Marked ExtraDep)-decodeExtraDep x = (fmap Git <$> decodeGitCommit x) <!> (fmap Plain <$> text x)+decodeExtraDep x = (fmap Plain <$> text x) <!> (fmap Git <$> decodeGitCommit x)  data GitCommit = GitCommit   { git :: Marked Text@@ -80,6 +82,7 @@                     Marked                       { markedItem = "lts-20.11"                       , markedPath = "<input>"+                      , markedJSONPath = Just [Key "resolver"]                       , markedLocationStart = Location 10 0 10                       , markedLocationEnd = Location 19 0 19                       }@@ -89,12 +92,14 @@                           [ Marked                               { markedItem = Plain "../local-package"                               , markedPath = "<input>"+                              , markedJSONPath = Just [Key "extra-deps", Index 0]                               , markedLocationStart = Location 45 3 3                               , markedLocationEnd = Location 61 3 19                               }                           , Marked                               { markedItem = Plain "hackage-dep-1.0"                               , markedPath = "<input>"+                              , markedJSONPath = Just [Key "extra-deps", Index 1]                               , markedLocationStart = Location 87 6 3                               , markedLocationEnd = Location 102 6 18                               }@@ -106,6 +111,7 @@                                           Marked                                             { markedItem = "foo"                                             , markedPath = "<input>"+                                            , markedJSONPath = Just [Key "extra-deps", Index 2, Key "git"]                                             , markedLocationStart = Location 125 9 8                                             , markedLocationEnd = Location 128 9 11                                             }@@ -113,22 +119,26 @@                                           Marked                                             { markedItem = "abc"                                             , markedPath = "<input>"+                                            , markedJSONPath = Just [Key "extra-deps", Index 2, Key "commit"]                                             , markedLocationStart = Location 140 10 11                                             , markedLocationEnd = Location 143 10 14                                             }                                       }                               , markedPath = "<input>"+                              , markedJSONPath = Just [Key "extra-deps", Index 2]                               , markedLocationStart = Location 120 9 3                               , markedLocationEnd = Location 143 10 14                               }                           , Marked                               { markedItem = Plain "foo-0.0.0"                               , markedPath = "<input>"+                              , markedJSONPath = Just [Key "extra-deps", Index 3]                               , markedLocationStart = Location 159 13 3                               , markedLocationEnd = Location 168 13 12                               }                           ]                       , markedPath = "<input>"+                      , markedJSONPath = Just [Key "extra-deps"]                       , markedLocationStart = Location 43 3 1                       , markedLocationEnd = Location 168 13 12                       }@@ -136,11 +146,52 @@                     Marked                       { markedItem = True                       , markedPath = "<input>"+                      , markedJSONPath = Just [Key "some-setting"]                       , markedLocationStart = Location 184 15 14                       , markedLocationEnd = Location 187 15 17                       }                 }           , markedPath = "<input>"+          , markedJSONPath = Just []           , markedLocationStart = Location 0 0 0           , markedLocationEnd = Location 187 15 17           }++    context "errors" $ do+      it "incorrect type" $ do+        let exampleYaml =+              mconcat+                [ "resolver: lts-20.11\n"+                , "extra-deps:\n"+                , "  - Yes\n" -- expected String, encountered Boolean+                ]++        decodeThrow decodeStackYaml "<input>" exampleYaml+          `shouldThrow` aesonExceptionPrefixed "Error in $['extra-deps'][0]: "++      it "missing key" $ do+        let exampleYaml =+              mconcat+                [ "extra-deps:\n"+                , "  - foo-1.0.1\n"+                ]++        decodeThrow decodeStackYaml "<input>" exampleYaml+          `shouldThrow` aesonExceptionPrefixed "Error in $: Key not found"++      it "missing nested key" $ do+        let exampleYaml =+              mconcat+                [ "resolver: lts-20.11\n"+                , "extra-deps:\n"+                , "  - foo-1.0.1\n"+                , "  - git: abc\n" -- no commit+                ]++        decodeThrow decodeStackYaml "<input>" exampleYaml+          `shouldThrow` aesonExceptionPrefixed "Error in $['extra-deps'][1]: Key not found: commit"++aesonExceptionPrefixed :: String -> ParseException -> Bool+aesonExceptionPrefixed x = \case+  AesonException msg -> x `isPrefixOf` msg+  _ -> False

@@ -1,6 +1,6 @@ cabal-version:   1.18 name:            yaml-marked-version:         0.1.0.0+version:         0.2.0.0 license:         MIT license-file:    LICENSE maintainer:      Pat Brisbin <pbrisbin@gmail.com>