hjsonpointer 0.2.0.4 → 0.3.0.0

raw patch · 8 files changed

+282/−173 lines, 8 filesdep +QuickCheckdep +test-framework-quickcheck2dep ~aesondep ~basedep ~http-typesnew-component:exe:examplePVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, test-framework-quickcheck2

Dependency ranges changed: aeson, base, http-types

API changes (from Hackage documentation)

Files

• Example.hs +30/−0
• README.md +28/−11
• changelog.md +13/−0
• changelog.txt +0/−9
• hjsonpointer.cabal +20/−8
• src/Data/Aeson/Pointer.hs +122/−0
• src/Data/JsonPointer.hs +0/−79
• tests/Unit.hs +69/−66

@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import           Control.Monad      (unless)+import           Data.Aeson+import qualified Data.Aeson.Pointer as P++main :: IO ()+main = do+  -- JSON Pointers must either be empty or start with a /.+  pntr1 <- case P.unescape "/foo/0" of+             Left _     -> error "Failed to construct JSON Pointer."+             Right pntr -> return pntr++  -- We can also write JSON Pointers in Haskell.+  let pntr2 = P.Pointer [P.Token "/"]+  -- When we do this we don't have to escape / or ~ characters+  -- (as ~1 and ~0 respectively) like we do in an escaped JSON+  -- Pointer string.+  unless (P.unescape "/~1" == Right pntr2) (error "ohno!")++  print (P.resolve pntr1 document)+  print (P.resolve pntr2 document)++  where+    document :: Value+    document = object [ "foo" .= [String "bar", String "baz"]+                      , "/"   .= String "quux"+                      ]

@@ -2,28 +2,45 @@  [JSON Pointer](http://tools.ietf.org/html/rfc6901) library for Haskell. +[Hackage](https://hackage.haskell.org/package/hjsonpointer) / [GitHub](https://github.com/seagreen/hjsonpointer) / [Travis CI](https://travis-ci.org/seagreen/hjsonpointer)+ # Example -```+```haskell {-# LANGUAGE OverloadedStrings #-}  module Main where +import           Control.Monad      (unless) import           Data.Aeson-import qualified Data.HashMap.Strict as H-import           Data.JsonPointer+import qualified Data.Aeson.Pointer as P  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+main = do+  -- JSON Pointers must either be empty or start with a /.+  pntr1 <- case P.unescape "/foo/0" of+             Left _     -> error "Failed to construct JSON Pointer."+             Right pntr -> pure pntr++  -- We can also write JSON Pointers in Haskell.+  let pntr2 = P.Pointer [P.Token "/"]+  -- When we do this we don't have to escape / or ~ characters+  -- (as ~1 and ~0 respectively) like we do in an escaped JSON+  -- Pointer string.+  unless (P.unescape "/~1" == Right pntr2) (error "ohno!")++  print (P.resolve pntr1 document)+  print (P.resolve pntr2 document)++  where+    document :: Value+    document = object [ "foo" .= [String "bar", String "baz"]+                      , "/"   .= String "quux"+                      ] ```  Output: ```-String "bar"+Right (String "bar")+Right (String "quux") ```

@@ -0,0 +1,13 @@+# 0.3+++ Rewrite.++# 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.

@@ -1,9 +0,0 @@-# 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.

@@ -1,5 +1,5 @@ name:                   hjsonpointer-version:                0.2.0.4+version:                0.3.0.0 synopsis:               JSON Pointer library homepage:               https://github.com/seagreen/hjsonpointer license:                MIT@@ -9,17 +9,20 @@ category:               Data build-type:             Simple cabal-version:          >=1.10-extra-source-files:     changelog.txt+tested-with:            GHC == 7.8.4, GHC == 7.10.3+extra-source-files:     changelog.md                         README.md  library   hs-source-dirs:       src-  exposed-modules:      Data.JsonPointer+  exposed-modules:      Data.Aeson.Pointer   default-language:     Haskell2010   default-extensions:   OverloadedStrings+  other-extensions:     GeneralizedNewtypeDeriving   ghc-options:          -Wall-  build-depends:        aeson                >= 0.7  && < 0.10+  build-depends:        aeson                >= 0.7  && < 0.12                       , base                 >= 4.6  && < 4.9+                      , QuickCheck           >= 2.8  && < 2.9                       , unordered-containers >= 0.2  && < 0.3                       , text                 >= 1.2  && < 1.3                       , vector               >= 0.10 && < 0.12@@ -37,10 +40,19 @@                       , unordered-containers                       , text                       , vector-                      , http-types           >= 0.8 && < 0.9-                      , HUnit                >= 1.2 && < 1.4-                      , test-framework       >= 0.8 && < 0.9-                      , test-framework-hunit >= 0.3 && < 0.4+                      , http-types                 >= 0.8 && < 0.10+                      , HUnit                      >= 1.2 && < 1.4+                      , test-framework             >= 0.8 && < 0.9+                      , test-framework-hunit       >= 0.3 && < 0.4+                      , test-framework-quickcheck2 >= 0.3 && < 0.4++executable example+  main-is:              Example.hs+  default-language:     Haskell2010+  ghc-options:          -Wall+  build-depends:        aeson+                      , base+                      , hjsonpointer  source-repository head   type:               git

@@ -0,0 +1,122 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Data.Aeson.Pointer where++import           Control.Monad       (when)+import           Data.Aeson+import qualified Data.HashMap.Strict as H+import           Data.Text           (Text)+import qualified Data.Text           as T+import qualified Data.Vector         as V+import           Test.QuickCheck+import           Text.Read           (readMaybe)++-- For GHCs before 7.10:+import           Control.Applicative+import           Data.Monoid+import           Data.Traversable++newtype Pointer+  = Pointer { _unPointer :: [Token] }+  deriving (Eq, Show, Monoid, Arbitrary)++instance FromJSON Pointer where+  parseJSON = withText "JSON Pointer" $ \t ->+    case unescape t of+      Left e  -> fail (show e)+      Right p -> pure p++instance ToJSON Pointer where+  toJSON = String . escape++-- | We don't try to distinguish between integer tokens and string+-- tokens since all tokens start as strings, and all tokens can+-- be used to resolve JSON objects.+newtype Token = Token { _unToken :: Text } deriving (Eq, Show)++instance Arbitrary Token where+  arbitrary = Token . T.pack <$> arbitrary++escape :: Pointer -> Text+escape (Pointer []) = ""+escape (Pointer ts) =+    T.cons '/'+  . T.intercalate "/"+  . fmap (T.replace "/" "~1" . T.replace "~" "~0" . _unToken)+  $ ts++-- * Unescaping++data FormatError+  = InvalidFirstChar+  -- ^ JSON Pointers must either be empty or start with a @/@.+  | UnescapedTilde+  deriving (Eq, Show)+++-- | JSON Pointers must either be empty or start with a @/@. This means+-- that if you're turning a URI Fragment into a JSON Pointer you must+-- drop the initial @#@.+--+-- Note that the unescaping happening here is not the same as URI+-- decoding. If you are turning a URI fragment into a JSON Pointer you+-- must URI decode the 'Text' before using it as an argument to this+-- function. There's an example of how to do this in the tests using+-- "Network.HTTP.Types.URI.urlDecode" from http-types.+unescape :: Text -> Either FormatError Pointer+unescape txt =+  case T.splitOn "/" txt of+    []    -> Right (Pointer [])+    "":xs -> Pointer <$> traverse f xs+    _     -> Left InvalidFirstChar+  where+    f :: Text -> Either FormatError Token+    f t = case unescapeToken t of+            Nothing  -> Left UnescapedTilde+            Just tok -> Right tok++-- | For internal use by 'unescape'.+unescapeToken :: Text -> Maybe Token+unescapeToken t+  | not (isValid t) = Nothing+  | otherwise       = Just . Token . replace $ t+  where+    -- All tildes must be followed by 0s or 1s.+    isValid :: Text -> Bool+    isValid x = all (\y -> T.isPrefixOf "0" y || T.isPrefixOf "1" y) afterTildes+      where+        afterTildes :: [Text]+        afterTildes = drop 1 $ T.splitOn "~" x++    replace :: Text -> Text+    replace = T.replace "~0" "~" . T.replace "~1" "/"++-- * Resolution++data ResolutionError+  = ObjectLookupFailed+  | ArrayIndexInvalid+  | ArrayElemNotFound+  | ExpectedObjectOrArray+  deriving (Eq, Show)++resolve :: Pointer -> Value -> Either ResolutionError Value+resolve (Pointer []) v     = Right v+resolve (Pointer (t:ts)) v = resolveToken t v >>= resolve (Pointer ts)++-- | For internal use (or specialized applications that don't want to+-- resolve an entire pointer at once).+resolveToken :: Token -> Value -> Either ResolutionError Value+resolveToken tok (Array vs) =+  case readMaybe . T.unpack . _unToken $ tok of+    Nothing -> Left ArrayIndexInvalid+    Just n  -> do+      when (n < 0) (Left ArrayIndexInvalid)+      case vs V.!? n of+        Nothing  -> Left ArrayElemNotFound+        Just res -> Right res+resolveToken tok (Object h) =+  case H.lookup (_unToken tok) h of+    Nothing  -> Left ObjectLookupFailed+    Just res -> Right res+resolveToken _ _ = Left ExpectedObjectOrArray

@@ -1,79 +0,0 @@-module Data.JsonPointer where--import           Control.Applicative-import           Control.Monad-import           Data.Aeson-import qualified Data.HashMap.Strict as H-import           Data.Text           (Text)-import qualified Data.Text           as T-import qualified Data.Vector         as V-import           Text.Read           (readMaybe)--newtype JsonPointer = JsonPointer { _unJsonPointer :: [Text] } deriving (Eq, Show)--data PointerFormatError-  -- | The Text to build a JSON Pointer must either be empty-  -- or start with a "/".-  = InvalidFirstChar-  | UnescapedTilde-  deriving (Eq, Show)--data ResolutionError-  = ObjectLookupFailed-  | ArrayIndexInvalid-  | ArrayElemNotFound-  | 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 PointerFormatError JsonPointer-jsonPointer t =-  JsonPointer <$> (unescape =<< process (T.splitOn "/" t))-  where-    process ::[Text] -> Either PointerFormatError [Text]-    process []     = Right []-    process (x:xs)-      -- This checks that the JsonPointer started with a "/":-      | (not . T.null $ x) = Left InvalidFirstChar-      | otherwise          = Right xs--    unescape :: [Text] -> Either PointerFormatError [Text]-    unescape xs = do-      void $ mapM checkValid xs-      Right $ T.replace "~0" "~" . T.replace "~1" "/" <$> xs--    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 :: JsonPointer -> Value -> Either ResolutionError Value-resolvePointer p v =-  case _unJsonPointer p of-    [] -> Right v-    _  -> resolveRefTok p v >>= uncurry resolvePointer---- | For internal use and specialized applications that don't want to--- resolve the entire pointer at once.-resolveRefTok :: JsonPointer -> Value -> Either ResolutionError (JsonPointer, Value)-resolveRefTok p v = do-  case _unJsonPointer p of-    []       -> Right (p, v)-    (tok:ps) ->-      case v of-        Object h ->-          case H.lookup tok h of-            Nothing -> Left ObjectLookupFailed-            Just vv -> Right (JsonPointer ps, vv)-        Array vs -> do-          case readMaybe (T.unpack tok) of-            Nothing -> Left ArrayIndexInvalid-            Just n  -> do-              when (n < 0)            $ Left ArrayIndexInvalid-              when (n >= V.length vs) $ Left ArrayElemNotFound-              Right (JsonPointer ps, vs V.! n)-        _ -> Left ExpectedObjectOrArray

@@ -1,87 +1,90 @@+ module Main where -import           Control.Applicative import           Control.Arrow-import           Control.Monad import           Data.Aeson-import qualified Data.HashMap.Strict            as H-import           Data.JsonPointer-import           Data.Monoid-import           Data.Text                      (Text)-import qualified Data.Text                      as T+import qualified Data.Aeson.Pointer                   as P+import           Data.Text                            (Text)+import qualified Data.Text                            as T import           Data.Text.Encoding-import qualified Data.Vector                    as V-import           Network.HTTP.Types.URI-import           Test.Framework                 (defaultMain, testGroup)-import           Test.Framework.Providers.HUnit (testCase)-import           Test.HUnit                     hiding (Test)+import qualified Data.Vector                          as V+import           Network.HTTP.Types.URI               (urlDecode)+import           Test.Framework                       (defaultMain, testGroup)+import           Test.Framework.Providers.HUnit       (testCase)+import           Test.Framework.Providers.QuickCheck2 (testProperty)+import           Test.HUnit                           hiding (Test) +-- For GHCs before 7.10:+import           Control.Applicative+import           Data.Foldable+import           Data.Monoid  main :: IO () main = defaultMain   [ testGroup "unit"-    [ testCase "Can be represented in a JSON string value" jsonString+    [ testProperty "Storing a Pointer as JSON doesn't change its value" roundtrip+    , testCase "Can be represented in a JSON string value" jsonString     , testCase "Can be represented in a URI fragment identifier" uriFragment     ]   ] -specExample :: Value-specExample =-  Object $ H.fromList-    [ ("foo" , Array $ V.fromList ["bar", "baz"])-    , (""    , Number 0)-    , ("a/b" , Number 1)-    , ("c%d" , Number 2)-    , ("e^f" , Number 3)-    , ("g|h" , Number 4)-    , ("i\\j", Number 5)-    , ("k\"l", Number 6)-    , (" "   , Number 7)-    , ("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+roundtrip :: P.Pointer -> Bool+roundtrip a = Just a == decode (encode a)  jsonString :: Assertion-jsonString =-  void $ mapM resolvesTo-    [ (""      , specExample)-    , ("/foo"  , Array $ V.fromList ["bar", "baz"])-    , ("/foo/0", String "bar")-    , ("/"     , Number 0)-    , ("/a~1b" , Number 1)-    , ("/c%d"  , Number 2)-    , ("/e^f"  , Number 3)-    , ("/g|h"  , Number 4)-    , ("/i\\j" , Number 5)-    , ("/k\"l" , Number 6)-    , ("/ "    , Number 7)-    , ("/m~0n" , Number 8)-    ]+jsonString = traverse_ resolvesTo+  [ (""      , specExample)+  , ("/foo"  , Array $ V.fromList ["bar", "baz"])+  , ("/foo/0", String "bar")+  , ("/"     , Number 0)+  , ("/a~1b" , Number 1)+  , ("/c%d"  , Number 2)+  , ("/e^f"  , Number 3)+  , ("/g|h"  , Number 4)+  , ("/i\\j" , Number 5)+  , ("/k\"l" , Number 6)+  , ("/ "    , Number 7)+  , ("/m~0n" , Number 8)+  ]  uriFragment :: Assertion-uriFragment =-  void $ mapM resolvesTo $ first decodeFragment <$>-    [ ("#"      , specExample)-    , ("#/foo"  , Array $ V.fromList ["bar", "baz"])-    , ("#/foo/0", String "bar")-    , ("#/"     , Number 0)-    , ("#/a~1b" , Number 1)-    , ("#/c%25d", Number 2)-    , ("#/e%5Ef", Number 3)-    , ("#/g%7Ch", Number 4)-    , ("#/i%5Cj", Number 5)-    , ("#/k%22l", Number 6)-    , ("#/%20"  , Number 7)-    , ("#/m~0n" , Number 8)-    ]+uriFragment = traverse_ resolvesTo . fmap (first decodeFragment) $+  [ ("#"      , specExample)+  , ("#/foo"  , Array $ V.fromList ["bar", "baz"])+  , ("#/foo/0", String "bar")+  , ("#/"     , Number 0)+  , ("#/a~1b" , Number 1)+  , ("#/c%25d", Number 2)+  , ("#/e%5Ef", Number 3)+  , ("#/g%7Ch", Number 4)+  , ("#/i%5Cj", Number 5)+  , ("#/k%22l", Number 6)+  , ("#/%20"  , Number 7)+  , ("#/m~0n" , Number 8)+  ]   where     decodeFragment :: Text -> Text     decodeFragment = T.drop 1 . decodeUtf8 . urlDecode True . encodeUtf8++resolvesTo :: (Text, Value) -> Assertion+resolvesTo (t, expected) =+  case P.unescape t of+    Left e  -> assertFailure (show e <> " error for pointer: " <> show t)+    Right p -> assertEqual+                 ("Resolved value for pointer: " <> show t)+                 (Right expected)+                 (P.resolve p specExample)++specExample :: Value+specExample = object+  [ "foo"  .= (["bar", "baz"] :: [Text])+  , ""     .= (0 :: Int)+  , "a/b"  .= (1 :: Int)+  , "c%d"  .= (2 :: Int)+  , "e^f"  .= (3 :: Int)+  , "g|h"  .= (4 :: Int)+  , "i\\j" .= (5 :: Int)+  , "k\"l" .= (6 :: Int)+  , " "    .= (7 :: Int)+  , "m~n"  .= (8 :: Int)+  ]