mirror of
https://github.com/typeable/hjsonpointer.git
synced 2024-08-17 02:20:23 +03:00
Switch to 4 space indentation.
This commit is contained in:
Ian Grant Jeffries
parent
92621b1d6e
commit
930c14acc8
24
Example.hs
24
Example.hs
@ -8,20 +8,20 @@ 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
|
||||
-- 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!")
|
||||
-- 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)
|
||||
print (P.resolve pntr1 document)
|
||||
print (P.resolve pntr2 document)
|
||||
|
||||
where
|
||||
document :: Value
|
||||
|
||||
26
README.md
26
README.md
@ -9,7 +9,7 @@
|
||||
```haskell
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Main where
|
||||
module Example where
|
||||
|
||||
import Control.Monad (unless)
|
||||
import Data.Aeson
|
||||
@ -17,20 +17,20 @@ 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 -> pure pntr
|
||||
-- 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!")
|
||||
-- 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)
|
||||
print (P.resolve pntr1 document)
|
||||
print (P.resolve pntr2 document)
|
||||
|
||||
where
|
||||
document :: Value
|
||||
|
||||
@ -17,41 +17,43 @@ import Data.Monoid
|
||||
import Data.Traversable
|
||||
|
||||
newtype Pointer
|
||||
= Pointer { _unPointer :: [Token] }
|
||||
deriving (Eq, Show, Monoid, Arbitrary)
|
||||
= 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
|
||||
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
|
||||
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)
|
||||
newtype Token
|
||||
= Token { _unToken :: Text }
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance Arbitrary Token where
|
||||
arbitrary = Token . T.pack <$> arbitrary
|
||||
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
|
||||
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)
|
||||
= 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
|
||||
@ -65,21 +67,21 @@ data FormatError
|
||||
-- "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
|
||||
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
|
||||
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
|
||||
| not (isValid t) = Nothing
|
||||
| otherwise = Just . Token . replace $ t
|
||||
where
|
||||
-- All tildes must be followed by 0s or 1s.
|
||||
isValid :: Text -> Bool
|
||||
@ -94,11 +96,11 @@ unescapeToken t
|
||||
-- * Resolution
|
||||
|
||||
data ResolutionError
|
||||
= ObjectLookupFailed
|
||||
| ArrayIndexInvalid
|
||||
| ArrayElemNotFound
|
||||
| ExpectedObjectOrArray
|
||||
deriving (Eq, Show)
|
||||
= ObjectLookupFailed
|
||||
| ArrayIndexInvalid
|
||||
| ArrayElemNotFound
|
||||
| ExpectedObjectOrArray
|
||||
deriving (Eq, Show)
|
||||
|
||||
resolve :: Pointer -> Value -> Either ResolutionError Value
|
||||
resolve (Pointer []) v = Right v
|
||||
@ -108,15 +110,15 @@ resolve (Pointer (t:ts)) v = resolveToken t v >>= resolve (Pointer ts)
|
||||
-- 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
|
||||
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
|
||||
case H.lookup (_unToken tok) h of
|
||||
Nothing -> Left ObjectLookupFailed
|
||||
Just res -> Right res
|
||||
resolveToken _ _ = Left ExpectedObjectOrArray
|
||||
|
||||
98
test/Unit.hs
98
test/Unit.hs
@ -24,70 +24,70 @@ import qualified Example
|
||||
|
||||
main :: IO ()
|
||||
main = hspec $ do
|
||||
describe "example" $ do
|
||||
it "compiles and runs without errors" Example.main
|
||||
describe "pointers" $ do
|
||||
it "can be stored as JSON without changing its value" (property roundtrip)
|
||||
it "can be represented in a JSON string value" jsonString
|
||||
it "can be represented in a URI fragment identifier" uriFragment
|
||||
describe "example" $ do
|
||||
it "compiles and runs without errors" Example.main
|
||||
describe "pointers" $ do
|
||||
it "can be stored as JSON without changing its value" (property roundtrip)
|
||||
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 a = Just a == decode (encode a)
|
||||
|
||||
jsonString :: Assertion
|
||||
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)
|
||||
]
|
||||
[ ("" , 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 = 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)
|
||||
]
|
||||
[ ("#" , 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)
|
||||
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)
|
||||
]
|
||||
[ "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)
|
||||
]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user