0.2

Fix mistake in resolveRefTok.
Split errors over two types.
Switch the order of pointer and value arguments for functions that take both. The pointer now comes first.

README.md

@@ -5,6 +5,25 @@
 # Example
 
 ```
-λ jsonPointer "/foo" >>= resolvePointer (Object $ singleton "foo" $ String "bar")
+{-# LANGUAGE OverloadedStrings #-}
-Right (String "bar")
+
+module Main where
+
+import           Data.Aeson
+import qualified Data.HashMap.Strict as H
+import           Data.JsonPointer
+
+main :: IO ()
+main =
+  case jsonPointer "/foo" of
+    Left e     -> print e
+    Right pntr ->
+      case resolvePointer pntr (Object $ H.singleton "foo" $ String "bar") of
+        Left e2 -> print e2
+        Right v -> print v
+```
+
+Output:
+```
+String "bar"
 ```

changelog.txt

@@ -0,0 +1,9 @@
+# 0.2
+
+Fix mistake in resolveRefTok.
+Split errors over two types.
+Switch the order of pointer and value arguments for functions that take both. The pointer now comes first.
+
+# 0.1
+
+Initial implementation.

hjsonpointer.cabal

@@ -1,6 +1,6 @@
 name:                   hjsonpointer
-version:                0.1.0.1
+version:                0.2.0.0
-synopsis:               JSON Pointer library for Haskell
+synopsis:               JSON Pointer library
 homepage:               https://github.com/seagreen/hjsonpointer
 license:                MIT
 license-file:           MIT-LICENSE.txt
@@ -9,7 +9,8 @@ maintainer:             ian@housejeffries.com
 category:               Data
 build-type:             Simple
 cabal-version:          >=1.10
-extra-source-files:     README.md
+extra-source-files:     changelog.txt
+                        README.md
 
 library
   hs-source-dirs:       src

src/Data/JsonPointer.hs

@@ -11,67 +11,69 @@ import           Text.Read           (readMaybe)
 
 newtype JsonPointer = JsonPointer { _unJsonPointer :: [Text] } deriving (Eq, Show)
 
-data PointerErr
+data PointerFormatError
   -- | The Text to build a JSON Pointer must either be empty
-  -- or start with a '/'.
+  -- or start with a "/".
   = InvalidFirstChar
   | UnescapedTilde
-  | ObjectLookupFailed
+  deriving (Eq, Show)
+
+data ResolutionError
+  = ObjectLookupFailed
   | ArrayIndexInvalid
   | ArrayElemNotFound
-  | UnindexableValue
+  | ExpectedObjectOrArray
   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
+-- with a "/". If you're turning a URI Fragment into a JSON Pointer
--- you must drop the initial '#'.
+-- you must drop the initial "#".
-jsonPointer :: Text -> Either PointerErr JsonPointer
+jsonPointer :: Text -> Either PointerFormatError JsonPointer
 jsonPointer t =
   JsonPointer <$> (unescape =<< process (T.splitOn "/" t))
   where
-    process ::[Text] -> Either PointerErr [Text]
+    process ::[Text] -> Either PointerFormatError [Text]
     process []     = Right []
-    process (x:xs) = do
+    process (x:xs)
-      unless (T.null x) $ Left InvalidFirstChar
+      -- This checks that the JsonPointer started with a "/":
-      Right xs
+      | (not . T.null $ x) = Left InvalidFirstChar
+      | otherwise          = Right xs
 
-    unescape :: [Text] -> Either PointerErr [Text]
+    unescape :: [Text] -> Either PointerFormatError [Text]
     unescape xs = do
       void $ mapM checkValid xs
       Right $ T.replace "~0" "~" . T.replace "~1" "/" <$> xs
 
-    checkValid :: Text -> Either PointerErr ()
+    checkValid :: Text -> Either PointerFormatError ()
     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 :: JsonPointer -> Value -> Either ResolutionError Value
-resolvePointer v p =
+resolvePointer p v =
   case _unJsonPointer p of
     [] -> Right v
-    _  -> resolveRefTok v p >>= uncurry resolvePointer
+    _  -> resolveRefTok p v >>= 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 :: JsonPointer -> Value -> Either ResolutionError (JsonPointer, Value)
-resolveRefTok v p = do
+resolveRefTok p v = do
   case _unJsonPointer p of
-    []       -> Right (v, p)
+    []       -> Right (p, v)
     (tok:ps) ->
       case v of
         Object h ->
           case H.lookup tok h of
             Nothing -> Left ObjectLookupFailed
-            Just vv -> Right (vv, JsonPointer ps)
+            Just vv -> Right (JsonPointer ps, vv)
         Array vs -> do
           case readMaybe (T.unpack tok) of
             Nothing -> Left ArrayIndexInvalid
             Just n  -> do
-              unless (n >= 0)          $ Left ArrayIndexInvalid
+              when (n < 0)            $ Left ArrayIndexInvalid
-              unless (n < V.length vs) $ Left ArrayElemNotFound
+              when (n >= V.length vs) $ Left ArrayElemNotFound
-              Right (vs V.! n, JsonPointer ps)
+              Right (JsonPointer ps, vs V.! n)
-        vv -> do
+        _ -> Left ExpectedObjectOrArray
-          unless (null ps) $ Left UnindexableValue
-          Right (vv, JsonPointer [])

tests/Unit.hs

@@ -1,5 +1,7 @@
 module Main where
 
+import           Control.Applicative
+import           Control.Arrow
 import           Control.Monad
 import           Data.Aeson
 import qualified Data.HashMap.Strict            as H
@@ -38,11 +40,18 @@ specExample =
     , ("m~n" , Number 8)
     ]
 
+resolvesTo :: (Text, Value) -> Assertion
+resolvesTo (t, expected) =
+  case jsonPointer t of
+    Left e  -> assertFailure (show e <> " error for pointer: " <> show t)
+    Right p ->
+      assertEqual ("Resolved value for pointer: " <> show t)
+        (Right expected)
+        $ resolvePointer p specExample
+
 jsonString :: Assertion
 jsonString =
-  void $ mapM
+  void $ mapM resolvesTo
-    (\(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")
@@ -59,9 +68,7 @@ jsonString =
 
 uriFragment :: Assertion
 uriFragment =
-  void $ mapM
+  void $ mapM resolvesTo $ first decodeFragment <$>
-    (\(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")