mirror of
https://github.com/typeable/hjsonpointer.git
synced 2024-08-17 02:20:23 +03:00
1.1.0.0.
+ Rename the module to `JSONPointer`. + Bump aeson. + Derive `Semigroup` for `Pointer`. + Reorganize code.
This commit is contained in:
parent
222867960f
commit
e9b9827cef
15
Example.hs
15
Example.hs
@ -1,27 +1,26 @@
|
|||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
|
|
||||||
module Example where
|
module Example where
|
||||||
|
|
||||||
import Control.Monad (unless)
|
import Control.Monad (unless)
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import qualified Data.Aeson.Pointer as P
|
import qualified JSONPointer as JP
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
-- JSON Pointers must either be empty or start with a /.
|
-- 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."
|
Left _ -> error "Failed to construct JSON Pointer."
|
||||||
Right pntr -> return pntr
|
Right pntr -> return pntr
|
||||||
|
|
||||||
-- We can also write JSON Pointers in Haskell.
|
-- 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
|
-- When we do this we don't have to escape / or ~ characters
|
||||||
-- (as ~1 and ~0 respectively) like we do in an escaped JSON
|
-- (as ~1 and ~0 respectively) like we do in an escaped JSON
|
||||||
-- Pointer string.
|
-- Pointer string.
|
||||||
unless (P.unescape "/~1" == Right pntr2) (error "ohno!")
|
unless (JP.unescape "/~1" == Right pntr2) (error "ohno!")
|
||||||
|
|
||||||
print (P.resolve pntr1 document)
|
print (JP.resolve pntr1 document)
|
||||||
print (P.resolve pntr2 document)
|
print (JP.resolve pntr2 document)
|
||||||
|
|
||||||
where
|
where
|
||||||
document :: Value
|
document :: Value
|
||||||
|
16
README.md
16
README.md
@ -7,30 +7,28 @@
|
|||||||
# Example
|
# Example
|
||||||
|
|
||||||
```haskell
|
```haskell
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
|
|
||||||
module Example where
|
module Example where
|
||||||
|
|
||||||
import Control.Monad (unless)
|
import Control.Monad (unless)
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import qualified Data.Aeson.Pointer as P
|
import qualified JSONPointer as JP
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
-- JSON Pointers must either be empty or start with a /.
|
-- 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."
|
Left _ -> error "Failed to construct JSON Pointer."
|
||||||
Right pntr -> return pntr
|
Right pntr -> return pntr
|
||||||
|
|
||||||
-- We can also write JSON Pointers in Haskell.
|
-- 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
|
-- When we do this we don't have to escape / or ~ characters
|
||||||
-- (as ~1 and ~0 respectively) like we do in an escaped JSON
|
-- (as ~1 and ~0 respectively) like we do in an escaped JSON
|
||||||
-- Pointer string.
|
-- Pointer string.
|
||||||
unless (P.unescape "/~1" == Right pntr2) (error "ohno!")
|
unless (JP.unescape "/~1" == Right pntr2) (error "ohno!")
|
||||||
|
|
||||||
print (P.resolve pntr1 document)
|
print (JP.resolve pntr1 document)
|
||||||
print (P.resolve pntr2 document)
|
print (JP.resolve pntr2 document)
|
||||||
|
|
||||||
where
|
where
|
||||||
document :: Value
|
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
|
# 1.0.0.2
|
||||||
|
|
||||||
+ Bump hspec.
|
+ Bump hspec.
|
||||||
|
@ -1,5 +1,5 @@
|
|||||||
name: hjsonpointer
|
name: hjsonpointer
|
||||||
version: 1.0.0.2
|
version: 1.1.0.0
|
||||||
synopsis: JSON Pointer library
|
synopsis: JSON Pointer library
|
||||||
homepage: https://github.com/seagreen/hjsonpointer
|
homepage: https://github.com/seagreen/hjsonpointer
|
||||||
license: MIT
|
license: MIT
|
||||||
@ -17,19 +17,18 @@ library
|
|||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
src
|
src
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
default-extensions:
|
|
||||||
OverloadedStrings
|
|
||||||
other-extensions:
|
|
||||||
GeneralizedNewtypeDeriving
|
|
||||||
ghc-options:
|
ghc-options:
|
||||||
-Wall
|
-Wall
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
Data.Aeson.Pointer
|
JSONPointer
|
||||||
build-depends:
|
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
|
, QuickCheck >= 2.8 && < 2.10
|
||||||
, unordered-containers >= 0.2 && < 0.3
|
, unordered-containers >= 0.2 && < 0.3
|
||||||
|
, semigroups >= 0.18 && < 1.0
|
||||||
|
-- ^ for GHCs < 8
|
||||||
, text >= 1.2 && < 1.3
|
, text >= 1.2 && < 1.3
|
||||||
, vector >= 0.10 && < 0.12
|
, vector >= 0.10 && < 0.12
|
||||||
|
|
||||||
@ -49,12 +48,12 @@ test-suite unit
|
|||||||
aeson
|
aeson
|
||||||
, base
|
, base
|
||||||
, hjsonpointer
|
, hjsonpointer
|
||||||
|
, hspec >= 2.2 && < 2.4
|
||||||
|
, http-types >= 0.8 && < 0.10
|
||||||
, QuickCheck
|
, QuickCheck
|
||||||
, unordered-containers
|
, unordered-containers
|
||||||
, text
|
, text
|
||||||
, vector
|
, vector
|
||||||
, hspec >= 2.2 && < 2.4
|
|
||||||
, http-types >= 0.8 && < 0.10
|
|
||||||
|
|
||||||
source-repository head
|
source-repository head
|
||||||
type: git
|
type: git
|
||||||
|
@ -1,13 +1,18 @@
|
|||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module Data.Aeson.Pointer where
|
module JSONPointer where
|
||||||
|
|
||||||
import Control.Monad (when)
|
import Control.Monad (when)
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import qualified Data.HashMap.Strict as H
|
import qualified Data.Hashable as HA
|
||||||
|
import qualified Data.HashMap.Strict as HM
|
||||||
|
import Data.Semigroup (Semigroup)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Vector as V
|
import qualified Data.Vector as V
|
||||||
|
import GHC.Generics (Generic)
|
||||||
import Test.QuickCheck
|
import Test.QuickCheck
|
||||||
import Text.Read (readMaybe)
|
import Text.Read (readMaybe)
|
||||||
|
|
||||||
@ -16,9 +21,30 @@ import Control.Applicative
|
|||||||
import Data.Monoid
|
import Data.Monoid
|
||||||
import Data.Traversable
|
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
|
newtype Pointer
|
||||||
= Pointer { _unPointer :: [Token] }
|
= Pointer { _unPointer :: [Token] }
|
||||||
deriving (Eq, Show, Monoid, Arbitrary)
|
deriving (Eq, Show, Semigroup, Monoid, Generic, Arbitrary)
|
||||||
|
|
||||||
|
instance HA.Hashable Pointer
|
||||||
|
|
||||||
instance FromJSON Pointer where
|
instance FromJSON Pointer where
|
||||||
parseJSON = withText "JSON Pointer" $ \t ->
|
parseJSON = withText "JSON Pointer" $ \t ->
|
||||||
@ -32,13 +58,22 @@ instance ToJSON Pointer where
|
|||||||
-- | We don't try to distinguish between integer tokens and string
|
-- | We don't try to distinguish between integer tokens and string
|
||||||
-- tokens since all tokens start as strings, and all tokens can
|
-- tokens since all tokens start as strings, and all tokens can
|
||||||
-- be used to resolve JSON objects.
|
-- 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
|
newtype Token
|
||||||
= Token { _unToken :: Text }
|
= Token { _unToken :: Text }
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show, Generic)
|
||||||
|
|
||||||
|
instance HA.Hashable Token
|
||||||
|
|
||||||
instance Arbitrary Token where
|
instance Arbitrary Token where
|
||||||
arbitrary = Token . T.pack <$> arbitrary
|
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 -> Text
|
||||||
escape (Pointer []) = ""
|
escape (Pointer []) = ""
|
||||||
escape (Pointer ts) =
|
escape (Pointer ts) =
|
||||||
@ -47,15 +82,12 @@ escape (Pointer ts) =
|
|||||||
. fmap (T.replace "/" "~1" . T.replace "~" "~0" . _unToken)
|
. fmap (T.replace "/" "~1" . T.replace "~" "~0" . _unToken)
|
||||||
$ ts
|
$ ts
|
||||||
|
|
||||||
-- * Unescaping
|
|
||||||
|
|
||||||
data FormatError
|
data FormatError
|
||||||
= InvalidFirstChar
|
= InvalidFirstChar
|
||||||
-- ^ JSON Pointers must either be empty or start with a @/@.
|
-- ^ JSON Pointers must either be empty or start with a @/@.
|
||||||
| UnescapedTilde
|
| UnescapedTilde
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
-- | JSON Pointers must either be empty or start with a @/@. This means
|
-- | 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
|
-- that if you're turning a URI Fragment into a JSON Pointer you must
|
||||||
-- drop the initial @#@.
|
-- drop the initial @#@.
|
||||||
@ -77,7 +109,40 @@ unescape txt =
|
|||||||
Nothing -> Left UnescapedTilde
|
Nothing -> Left UnescapedTilde
|
||||||
Just tok -> Right tok
|
Just tok -> Right tok
|
||||||
|
|
||||||
-- | For internal use by 'unescape'.
|
--------------------------------------------------
|
||||||
|
-- * 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 :: Text -> Maybe Token
|
||||||
unescapeToken t
|
unescapeToken t
|
||||||
| not (isValid t) = Nothing
|
| not (isValid t) = Nothing
|
||||||
@ -93,21 +158,10 @@ unescapeToken t
|
|||||||
replace :: Text -> Text
|
replace :: Text -> Text
|
||||||
replace = T.replace "~0" "~" . T.replace "~1" "/"
|
replace = T.replace "~0" "~" . T.replace "~1" "/"
|
||||||
|
|
||||||
-- * Resolution
|
-- | For internal use (by 'resolve').
|
||||||
|
--
|
||||||
data ResolutionError
|
-- Might also be useful for specialized applications that don't
|
||||||
= ObjectLookupFailed
|
-- want to resolve an entire pointer at once.
|
||||||
| 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 :: Token -> Value -> Either ResolutionError Value
|
||||||
resolveToken tok (Array vs) =
|
resolveToken tok (Array vs) =
|
||||||
case readMaybe . T.unpack . _unToken $ tok of
|
case readMaybe . T.unpack . _unToken $ tok of
|
||||||
@ -118,7 +172,7 @@ resolveToken tok (Array vs) =
|
|||||||
Nothing -> Left ArrayElemNotFound
|
Nothing -> Left ArrayElemNotFound
|
||||||
Just res -> Right res
|
Just res -> Right res
|
||||||
resolveToken tok (Object h) =
|
resolveToken tok (Object h) =
|
||||||
case H.lookup (_unToken tok) h of
|
case HM.lookup (_unToken tok) h of
|
||||||
Nothing -> Left ObjectLookupFailed
|
Nothing -> Left ObjectLookupFailed
|
||||||
Just res -> Right res
|
Just res -> Right res
|
||||||
resolveToken _ _ = Left ExpectedObjectOrArray
|
resolveToken _ _ = Left ExpectedObjectOrArray
|
18
test/Unit.hs
18
test/Unit.hs
@ -3,15 +3,15 @@ module Main where
|
|||||||
|
|
||||||
import Control.Arrow
|
import Control.Arrow
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import qualified Data.Aeson.Pointer as P
|
import Data.Text (Text)
|
||||||
import Data.Text (Text)
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text as T
|
|
||||||
import Data.Text.Encoding
|
import Data.Text.Encoding
|
||||||
import qualified Data.Vector as V
|
import qualified Data.Vector as V
|
||||||
import Network.HTTP.Types.URI (urlDecode)
|
import qualified JSONPointer as JP
|
||||||
|
import Network.HTTP.Types.URI (urlDecode)
|
||||||
|
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
import Test.QuickCheck (property)
|
import Test.QuickCheck (property)
|
||||||
|
|
||||||
-- For GHCs before 7.10:
|
-- For GHCs before 7.10:
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
@ -29,7 +29,7 @@ main = hspec $ do
|
|||||||
it "can be represented in a JSON string value" jsonString
|
it "can be represented in a JSON string value" jsonString
|
||||||
it "can be represented in a URI fragment identifier" uriFragment
|
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)
|
roundtrip a = Just a == decode (encode a)
|
||||||
|
|
||||||
jsonString :: Expectation
|
jsonString :: Expectation
|
||||||
@ -69,9 +69,9 @@ uriFragment = traverse_ resolvesTo . fmap (first decodeFragment) $
|
|||||||
|
|
||||||
resolvesTo :: (Text, Value) -> Expectation
|
resolvesTo :: (Text, Value) -> Expectation
|
||||||
resolvesTo (t, expected) =
|
resolvesTo (t, expected) =
|
||||||
case P.unescape t of
|
case JP.unescape t of
|
||||||
Left e -> expectationFailure (show e <> " error for pointer: " <> show t)
|
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 :: Value
|
||||||
specExample = object
|
specExample = object
|
||||||
|
Loading…
Reference in New Issue
Block a user