hjsonpointer (empty) → 0.1.0.0
raw patch · 6 files changed
+235/−0 lines, 6 filesdep +HUnitdep +aesondep +basesetup-changed
Dependencies added: HUnit, aeson, base, hjsonpointer, http-types, test-framework, test-framework-hunit, text, unordered-containers, vector
Files
- MIT-LICENSE.txt +20/−0
- README.md +10/−0
- Setup.hs +2/−0
- hjsonpointer.cabal +46/−0
- src/Data/JsonPointer.hs +77/−0
- tests/Unit.hs +80/−0
+ MIT-LICENSE.txt view
@@ -0,0 +1,20 @@+The MIT License (MIT)+Copyright (c) 2015 Ian Grant Jeffries++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,+DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR+OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE+OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,10 @@+# Summary++[JSON Pointer](http://tools.ietf.org/html/rfc6901) library for Haskell.++# Example++```+λ jsonPointer "/foo" >>= resolvePointer (Object $ singleton "foo" $ String "bar")+Right (String "bar")+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hjsonpointer.cabal view
@@ -0,0 +1,46 @@+name: hjsonpointer+version: 0.1.0.0+synopsis: JSON Pointer library for Haskell+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+extra-source-files: README.md++library+ hs-source-dirs: src+ exposed-modules: Data.JsonPointer+ default-language: Haskell2010+ default-extensions: OverloadedStrings+ ghc-options: -Wall+ build-depends: aeson >= 0.8 && < 0.9+ , base >= 4.7 && < 4.8+ , unordered-containers >= 0.2 && < 0.3+ , text >= 1.2 && < 1.3+ , vector >= 0.10 && < 0.11++test-suite unit+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: Unit.hs+ default-language: Haskell2010+ ghc-options: -Wall+ default-extensions: OverloadedStrings+ build-depends: aeson+ , base+ , hjsonpointer+ , unordered-containers+ , text+ , vector+ , http-types >= 0.8 && < 0.9+ , HUnit >= 1.2 && < 1.3+ , test-framework >= 0.8 && < 0.9+ , test-framework-hunit >= 0.3 && < 0.4++source-repository head+ type: git+ location: git://github.com/seagreen/hjsonpointer.git
+ src/Data/JsonPointer.hs view
@@ -0,0 +1,77 @@+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 PointerErr+ -- | The Text to build a JSON Pointer must either be empty+ -- or start with a '/'.+ = InvalidFirstChar+ | UnescapedTilde+ | ObjectLookupFailed+ | ArrayIndexInvalid+ | ArrayElemNotFound+ | UnindexableValue+ 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 PointerErr JsonPointer+jsonPointer t =+ JsonPointer <$> (unescape =<< process (T.splitOn "/" t))+ where+ process ::[Text] -> Either PointerErr [Text]+ process [] = Right []+ process (x:xs) = do+ unless (T.null x) $ Left InvalidFirstChar+ Right xs++ unescape :: [Text] -> Either PointerErr [Text]+ unescape xs = do+ void $ mapM checkValid xs+ Right $ T.replace "~0" "~" . T.replace "~1" "/" <$> xs++ checkValid :: Text -> Either PointerErr ()+ 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 :: Value -> JsonPointer -> Either PointerErr Value+resolvePointer v p =+ case _unJsonPointer p of+ [] -> Right v+ _ -> resolveRefTok v p >>= uncurry resolvePointer++-- | For internal use and specialized applications that don't want to+-- resolve the entire pointer at once.+resolveRefTok :: Value -> JsonPointer -> Either PointerErr (Value, JsonPointer)+resolveRefTok v p = do+ case _unJsonPointer p of+ [] -> Right (v, p)+ (tok:ps) ->+ case v of+ Object h ->+ case H.lookup tok h of+ Nothing -> Left ObjectLookupFailed+ Just vv -> Right (vv, JsonPointer ps)+ Array vs -> do+ case readMaybe (T.unpack tok) of+ Nothing -> Left ArrayIndexInvalid+ Just n -> do+ unless (n >= 0) $ Left ArrayIndexInvalid+ unless (n < V.length vs) $ Left ArrayElemNotFound+ Right (vs V.! n, JsonPointer ps)+ vv -> do+ unless (null ps) $ Left UnindexableValue+ Right (vv, JsonPointer [])
+ tests/Unit.hs view
@@ -0,0 +1,80 @@+module Main where++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 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)+++main :: IO ()+main = defaultMain+ [ testGroup "unit"+ [ 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)+ ]++jsonString :: Assertion+jsonString =+ void $ mapM+ (\(a,expected) -> assertEqual ("Tried to resolve " <> show a) (Right expected)+ $ jsonPointer a >>= resolvePointer specExample)+ [ ("" , 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+ (\(a,expected) -> assertEqual ("Tried to resolve " <> show a) (Right expected)+ $ jsonPointer (decodeFragment a) >>= resolvePointer specExample)+ [ ("#" , 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