From 907156bdaf7d3ceaf33b9c7d8d0c15d5f09cb34a Mon Sep 17 00:00:00 2001 From: Ian Grant Jeffries Date: Thu, 26 Mar 2015 19:41:30 -0400 Subject: [PATCH] 0.2 Fix mistake in resolveRefTok. Split errors over two types. Switch the order of pointer and value arguments for functions that take both. The pointer now comes first. --- README.md | 23 ++++++++++++++++-- changelog.txt | 9 +++++++ hjsonpointer.cabal | 7 +++--- src/Data/JsonPointer.hs | 54 +++++++++++++++++++++-------------------- tests/Unit.hs | 19 ++++++++++----- 5 files changed, 75 insertions(+), 37 deletions(-) create mode 100644 changelog.txt diff --git a/README.md b/README.md index 2435be5..f1d552f 100644 --- a/README.md +++ b/README.md @@ -5,6 +5,25 @@ # Example ``` -λ jsonPointer "/foo" >>= resolvePointer (Object $ singleton "foo" $ String "bar") -Right (String "bar") +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Data.Aeson +import qualified Data.HashMap.Strict as H +import Data.JsonPointer + +main :: IO () +main = + case jsonPointer "/foo" of + Left e -> print e + Right pntr -> + case resolvePointer pntr (Object $ H.singleton "foo" $ String "bar") of + Left e2 -> print e2 + Right v -> print v +``` + +Output: +``` +String "bar" ``` diff --git a/changelog.txt b/changelog.txt new file mode 100644 index 0000000..95b9576 --- /dev/null +++ b/changelog.txt @@ -0,0 +1,9 @@ +# 0.2 + +Fix mistake in resolveRefTok. +Split errors over two types. +Switch the order of pointer and value arguments for functions that take both. The pointer now comes first. + +# 0.1 + +Initial implementation. diff --git a/hjsonpointer.cabal b/hjsonpointer.cabal index 0a943de..1c3f2d6 100644 --- a/hjsonpointer.cabal +++ b/hjsonpointer.cabal @@ -1,6 +1,6 @@ name: hjsonpointer -version: 0.1.0.1 -synopsis: JSON Pointer library for Haskell +version: 0.2.0.0 +synopsis: JSON Pointer library homepage: https://github.com/seagreen/hjsonpointer license: MIT license-file: MIT-LICENSE.txt @@ -9,7 +9,8 @@ maintainer: ian@housejeffries.com category: Data build-type: Simple cabal-version: >=1.10 -extra-source-files: README.md +extra-source-files: changelog.txt + README.md library hs-source-dirs: src diff --git a/src/Data/JsonPointer.hs b/src/Data/JsonPointer.hs index b0015e0..84f12ea 100644 --- a/src/Data/JsonPointer.hs +++ b/src/Data/JsonPointer.hs @@ -11,67 +11,69 @@ import Text.Read (readMaybe) newtype JsonPointer = JsonPointer { _unJsonPointer :: [Text] } deriving (Eq, Show) -data PointerErr +data PointerFormatError -- | The Text to build a JSON Pointer must either be empty - -- or start with a '/'. + -- or start with a "/". = InvalidFirstChar | UnescapedTilde - | ObjectLookupFailed + deriving (Eq, Show) + +data ResolutionError + = ObjectLookupFailed | ArrayIndexInvalid | ArrayElemNotFound - | UnindexableValue + | ExpectedObjectOrArray deriving (Eq, Show) -- | The Text to build a JSON Pointer must either be empty or start --- with a '/'. If you're turning a URI Fragment into a JSON Pointer --- you must drop the initial '#'. -jsonPointer :: Text -> Either PointerErr JsonPointer +-- with a "/". If you're turning a URI Fragment into a JSON Pointer +-- you must drop the initial "#". +jsonPointer :: Text -> Either PointerFormatError JsonPointer jsonPointer t = JsonPointer <$> (unescape =<< process (T.splitOn "/" t)) where - process ::[Text] -> Either PointerErr [Text] + process ::[Text] -> Either PointerFormatError [Text] process [] = Right [] - process (x:xs) = do - unless (T.null x) $ Left InvalidFirstChar - Right xs + process (x:xs) + -- This checks that the JsonPointer started with a "/": + | (not . T.null $ x) = Left InvalidFirstChar + | otherwise = Right xs - unescape :: [Text] -> Either PointerErr [Text] + unescape :: [Text] -> Either PointerFormatError [Text] unescape xs = do void $ mapM checkValid xs Right $ T.replace "~0" "~" . T.replace "~1" "/" <$> xs - checkValid :: Text -> Either PointerErr () + checkValid :: Text -> Either PointerFormatError () checkValid x = do let afterTildes = drop 1 $ T.splitOn "~" x if all (\y -> T.isPrefixOf "0" y || T.isPrefixOf "1" y) afterTildes then Right () else Left UnescapedTilde -resolvePointer :: Value -> JsonPointer -> Either PointerErr Value -resolvePointer v p = +resolvePointer :: JsonPointer -> Value -> Either ResolutionError Value +resolvePointer p v = case _unJsonPointer p of [] -> Right v - _ -> resolveRefTok v p >>= uncurry resolvePointer + _ -> resolveRefTok p v >>= uncurry resolvePointer -- | For internal use and specialized applications that don't want to -- resolve the entire pointer at once. -resolveRefTok :: Value -> JsonPointer -> Either PointerErr (Value, JsonPointer) -resolveRefTok v p = do +resolveRefTok :: JsonPointer -> Value -> Either ResolutionError (JsonPointer, Value) +resolveRefTok p v = do case _unJsonPointer p of - [] -> Right (v, p) + [] -> Right (p, v) (tok:ps) -> case v of Object h -> case H.lookup tok h of Nothing -> Left ObjectLookupFailed - Just vv -> Right (vv, JsonPointer ps) + Just vv -> Right (JsonPointer ps, vv) Array vs -> do case readMaybe (T.unpack tok) of Nothing -> Left ArrayIndexInvalid Just n -> do - unless (n >= 0) $ Left ArrayIndexInvalid - unless (n < V.length vs) $ Left ArrayElemNotFound - Right (vs V.! n, JsonPointer ps) - vv -> do - unless (null ps) $ Left UnindexableValue - Right (vv, JsonPointer []) + when (n < 0) $ Left ArrayIndexInvalid + when (n >= V.length vs) $ Left ArrayElemNotFound + Right (JsonPointer ps, vs V.! n) + _ -> Left ExpectedObjectOrArray diff --git a/tests/Unit.hs b/tests/Unit.hs index e98e4da..7ccae17 100644 --- a/tests/Unit.hs +++ b/tests/Unit.hs @@ -1,5 +1,7 @@ module Main where +import Control.Applicative +import Control.Arrow import Control.Monad import Data.Aeson import qualified Data.HashMap.Strict as H @@ -38,11 +40,18 @@ specExample = , ("m~n" , Number 8) ] +resolvesTo :: (Text, Value) -> Assertion +resolvesTo (t, expected) = + case jsonPointer t of + Left e -> assertFailure (show e <> " error for pointer: " <> show t) + Right p -> + assertEqual ("Resolved value for pointer: " <> show t) + (Right expected) + $ resolvePointer p specExample + jsonString :: Assertion jsonString = - void $ mapM - (\(a,expected) -> assertEqual ("Tried to resolve " <> show a) (Right expected) - $ jsonPointer a >>= resolvePointer specExample) + void $ mapM resolvesTo [ ("" , specExample) , ("/foo" , Array $ V.fromList ["bar", "baz"]) , ("/foo/0", String "bar") @@ -59,9 +68,7 @@ jsonString = uriFragment :: Assertion uriFragment = - void $ mapM - (\(a,expected) -> assertEqual ("Tried to resolve " <> show a) (Right expected) - $ jsonPointer (decodeFragment a) >>= resolvePointer specExample) + void $ mapM resolvesTo $ first decodeFragment <$> [ ("#" , specExample) , ("#/foo" , Array $ V.fromList ["bar", "baz"]) , ("#/foo/0", String "bar")