diff --git a/Example.hs b/Example.hs --- a/Example.hs +++ b/Example.hs @@ -8,20 +8,20 @@ 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 diff --git a/README.md b/README.md --- a/README.md +++ b/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 @@ 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 diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,7 @@ +# 1.0.0.0 + ++ Bump aeson. + # 0.3.0.2 + Switch to hspec for tests. diff --git a/hjsonpointer.cabal b/hjsonpointer.cabal --- a/hjsonpointer.cabal +++ b/hjsonpointer.cabal @@ -1,52 +1,63 @@ -name: hjsonpointer -version: 0.3.0.2 -synopsis: JSON Pointer library -homepage: https://github.com/seagreen/hjsonpointer -license: MIT -license-file: MIT-LICENSE.txt -author: Ian Grant Jeffries -maintainer: ian@housejeffries.com -category: Data -build-type: Simple -cabal-version: >=1.10 -tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1 -extra-source-files: changelog.md - README.md +name: hjsonpointer +version: 1.0.0.0 +synopsis: JSON Pointer library +homepage: https://github.com/seagreen/hjsonpointer +license: MIT +license-file: MIT-LICENSE.txt +author: Ian Grant Jeffries +maintainer: ian@housejeffries.com +category: Data +build-type: Simple +cabal-version: >=1.10 +tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1 +extra-source-files: + changelog.md + README.md library - hs-source-dirs: src - exposed-modules: Data.Aeson.Pointer - default-language: Haskell2010 - default-extensions: OverloadedStrings - other-extensions: GeneralizedNewtypeDeriving - ghc-options: -Wall - build-depends: aeson >= 0.7 && < 0.12 - , base >= 4.6 && < 4.10 - , QuickCheck >= 2.8 && < 2.10 - , unordered-containers >= 0.2 && < 0.3 - , text >= 1.2 && < 1.3 - , vector >= 0.10 && < 0.12 + hs-source-dirs: + src + default-language: Haskell2010 + default-extensions: + OverloadedStrings + other-extensions: + GeneralizedNewtypeDeriving + ghc-options: + -Wall + exposed-modules: + Data.Aeson.Pointer + build-depends: + aeson >= 0.7 && < 1.1 + , base >= 4.6 && < 4.10 + , QuickCheck >= 2.8 && < 2.10 + , unordered-containers >= 0.2 && < 0.3 + , text >= 1.2 && < 1.3 + , vector >= 0.10 && < 0.12 test-suite unit - type: exitcode-stdio-1.0 - hs-source-dirs: test - ./ - main-is: Unit.hs - other-modules: Example - default-language: Haskell2010 - ghc-options: -Wall - default-extensions: OverloadedStrings - build-depends: aeson - , base - , hjsonpointer - , QuickCheck - , unordered-containers - , text - , vector - , hspec >= 2.2 && < 2.3 - , http-types >= 0.8 && < 0.10 - , HUnit >= 1.2 && < 1.4 + hs-source-dirs: + test + ./ + default-language: Haskell2010 + default-extensions: + OverloadedStrings + ghc-options: + -Wall + type: exitcode-stdio-1.0 + main-is: Unit.hs + other-modules: Example + build-depends: + aeson + , base + , hjsonpointer + , QuickCheck + , unordered-containers + , text + , vector + , hspec >= 2.2 && < 2.3 + , http-types >= 0.8 && < 0.10 + , HUnit >= 1.2 && < 1.4 source-repository head - type: git - location: git://github.com/seagreen/hjsonpointer.git + type: git + location: git://github.com/seagreen/hjsonpointer.git diff --git a/src/Data/Aeson/Pointer.hs b/src/Data/Aeson/Pointer.hs --- a/src/Data/Aeson/Pointer.hs +++ b/src/Data/Aeson/Pointer.hs @@ -17,41 +17,43 @@ 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 @@ -- "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 @@ -- * 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 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 diff --git a/test/Unit.hs b/test/Unit.hs --- a/test/Unit.hs +++ b/test/Unit.hs @@ -24,70 +24,70 @@ 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) + ]