hjsonpointer 1.0.0.2 → 1.1.0.0

raw patch · 7 files changed

+217/−160 lines, 7 filesdep +hashabledep +semigroupsdep ~aesonPVP ok

version bump matches the API change (PVP)

Dependencies added: hashable, semigroups

Dependency ranges changed: aeson

API changes (from Hackage documentation)

Files

• Example.hs +7/−8
• README.md +7/−9
• changelog.md +7/−0
• hjsonpointer.cabal +9/−10
• src/Data/Aeson/Pointer.hs +0/−124
• src/JSONPointer.hs +178/−0
• test/Unit.hs +9/−9

@@ -1,27 +1,26 @@-{-# LANGUAGE OverloadedStrings #-}  module Example where -import           Control.Monad      (unless)+import           Control.Monad (unless) import           Data.Aeson-import qualified Data.Aeson.Pointer as P+import qualified JSONPointer   as JP  main :: IO () main = do     -- JSON Pointers must either be empty or start with a /.-    pntr1 <- case P.unescape "/foo/0" of+    pntr1 <- case JP.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 "/"]+    let pntr2 = JP.Pointer [JP.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!")+    unless (JP.unescape "/~1" == Right pntr2) (error "ohno!") -    print (P.resolve pntr1 document)-    print (P.resolve pntr2 document)+    print (JP.resolve pntr1 document)+    print (JP.resolve pntr2 document)    where     document :: Value

@@ -7,30 +7,28 @@ # Example  ```haskell-{-# LANGUAGE OverloadedStrings #-}- module Example where -import           Control.Monad      (unless)+import           Control.Monad (unless) import           Data.Aeson-import qualified Data.Aeson.Pointer as P+import qualified JSONPointer   as JP  main :: IO () main = do     -- JSON Pointers must either be empty or start with a /.-    pntr1 <- case P.unescape "/foo/0" of+    pntr1 <- case JP.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 "/"]+    let pntr2 = JP.Pointer [JP.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!")+    unless (JP.unescape "/~1" == Right pntr2) (error "ohno!") -    print (P.resolve pntr1 document)-    print (P.resolve pntr2 document)+    print (JP.resolve pntr1 document)+    print (JP.resolve pntr2 document)    where     document :: Value

@@ -1,3 +1,10 @@+# 1.1.0.0+++ Rename the module to `JSONPointer`.++ Bump aeson.++ Derive `Semigroup` for `Pointer`.++ Reorganize code.+ # 1.0.0.2  + Bump hspec.

@@ -1,5 +1,5 @@ name:               hjsonpointer-version:            1.0.0.2+version:            1.1.0.0 synopsis:           JSON Pointer library homepage:           https://github.com/seagreen/hjsonpointer license:            MIT@@ -17,19 +17,18 @@   hs-source-dirs:     src   default-language: Haskell2010-  default-extensions:-    OverloadedStrings-  other-extensions:-    GeneralizedNewtypeDeriving   ghc-options:     -Wall   exposed-modules:-    Data.Aeson.Pointer+    JSONPointer   build-depends:-      aeson                >= 0.7  && < 1.1-    , base                 >= 4.6  && < 4.10+      base                 >= 4.6  && < 4.10+    , aeson                >= 0.7  && < 1.2+    , hashable             >= 1.2  && < 1.3     , QuickCheck           >= 2.8  && < 2.10     , unordered-containers >= 0.2  && < 0.3+    , semigroups           >= 0.18 && < 1.0+      -- ^ for GHCs < 8     , text                 >= 1.2  && < 1.3     , vector               >= 0.10 && < 0.12 @@ -49,12 +48,12 @@       aeson     , base     , hjsonpointer+    , hspec                >= 2.2 && < 2.4+    , http-types           >= 0.8 && < 0.10     , QuickCheck     , unordered-containers     , text     , vector-    , hspec                >= 2.2 && < 2.4-    , http-types           >= 0.8 && < 0.10  source-repository head   type: git

@@ -1,124 +0,0 @@-{-# 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

@@ -0,0 +1,178 @@+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}++module JSONPointer where++import           Control.Monad       (when)+import           Data.Aeson+import qualified Data.Hashable       as HA+import qualified Data.HashMap.Strict as HM+import           Data.Semigroup      (Semigroup)+import           Data.Text           (Text)+import qualified Data.Text           as T+import qualified Data.Vector         as V+import           GHC.Generics        (Generic)+import           Test.QuickCheck+import           Text.Read           (readMaybe)++-- For GHCs before 7.10:+import           Control.Applicative+import           Data.Monoid+import           Data.Traversable++--------------------------------------------------+-- * 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)++--------------------------------------------------+-- * Main types and escaping+--------------------------------------------------++newtype Pointer+    = Pointer { _unPointer :: [Token] }+    deriving (Eq, Show, Semigroup, Monoid, Generic, Arbitrary)++instance HA.Hashable Pointer++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.+--+-- Since these are unescaped you can write @"/"@ and @"~"@ normally.+-- (e.g. if you're referencing a key such as @"abc/123"@, go ahead+-- and write that exactly.+newtype Token+    = Token { _unToken :: Text }+    deriving (Eq, Show, Generic)++instance HA.Hashable Token++instance Arbitrary Token where+    arbitrary = Token . T.pack <$> arbitrary++-- | This escapes @"/"@ (because it's the token separator character).+--+-- It also escapes @"~"@ (because it's the escape character).+escape :: Pointer -> Text+escape (Pointer []) = ""+escape (Pointer ts) =+      T.cons '/'+    . T.intercalate "/"+    . fmap (T.replace "/" "~1" . T.replace "~" "~0" . _unToken)+    $ ts++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++--------------------------------------------------+-- * Wrapper Types+--+-- These aren't used by the rest of the library+-- (as explained in the docs for 'Token').+--+-- However, they might be useful if you need to distinguish JSON Pointer+-- tokens from plain 'Text' or 'Int' without losing information by+-- converting to 'Token'.+--------------------------------------------------++-- | A glorified @type@ alias. If you need to do JSON Pointer operations+-- you're looking for 'Token' instead.+--+-- NOTE: Unlike 'Token' this is escaped.+newtype Key+    = Key { _unKey :: Text }+    deriving (Eq, Show, Generic)++instance HA.Hashable Key++-- | A glorified @type@ alias. If you need to do JSON Pointer operations+-- you're looking for 'Token' instead.+newtype Index+    = Index { _unIndex :: Int }+    deriving (Eq, Show, Generic)++instance HA.Hashable Index++--------------------------------------------------+-- * Internals+--------------------------------------------------++-- | 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" "/"++-- | For internal use (by 'resolve').+--+-- Might also be useful for 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 HM.lookup (_unToken tok) h of+        Nothing  -> Left ObjectLookupFailed+        Just res -> Right res+resolveToken _ _ = Left ExpectedObjectOrArray

@@ -3,15 +3,15 @@  import           Control.Arrow import           Data.Aeson-import qualified Data.Aeson.Pointer      as P-import           Data.Text               (Text)-import qualified Data.Text               as T+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  (urlDecode)+import qualified Data.Vector            as V+import qualified JSONPointer            as JP+import           Network.HTTP.Types.URI (urlDecode)  import           Test.Hspec-import           Test.QuickCheck         (property)+import           Test.QuickCheck        (property)  -- For GHCs before 7.10: import           Control.Applicative@@ -29,7 +29,7 @@         it "can be represented in a JSON string value" jsonString         it "can be represented in a URI fragment identifier" uriFragment -roundtrip :: P.Pointer -> Bool+roundtrip :: JP.Pointer -> Bool roundtrip a = Just a == decode (encode a)  jsonString :: Expectation@@ -69,9 +69,9 @@  resolvesTo :: (Text, Value) -> Expectation resolvesTo (t, expected) =-    case P.unescape t of+    case JP.unescape t of         Left e  -> expectationFailure (show e <> " error for pointer: " <> show t)-        Right p -> P.resolve p specExample `shouldBe` Right expected+        Right p -> JP.resolve p specExample `shouldBe` Right expected  specExample :: Value specExample = object