@@ -26,8 +26,10 @@ module Data.Aeson.Types.Internal
2626 -- * Type conversion
2727 , Parser
2828 , Result(..)
29+ , IResult(..)
2930 , JSONPathElement(..)
3031 , JSONPath
32+ , iparse
3133 , parse
3234 , parseEither
3335 , parseMaybe
@@ -80,8 +82,13 @@ data JSONPathElement = Key Text
8082 deriving (Eq, Show, Typeable)
8183type JSONPath = [JSONPathElement]
8284
85+-- | The internal result of running a 'Parser'.
86+data IResult a = IError JSONPath String
87+ | ISuccess a
88+ deriving (Eq, Show, Typeable)
89+
8390-- | The result of running a 'Parser'.
84−data Result a = Error JSONPath String
91+data Result a = Error String
8592 | Success a
8693 deriving (Eq, Show, Typeable)
8794
@@ -89,28 +96,57 @@ instance NFData JSONPathElement where
8996 rnf (Key t) = rnf t
9097 rnf (Index i) = rnf i
9198
99+instance (NFData a) => NFData (IResult a) where
100+ rnf (ISuccess a) = rnf a
101+ rnf (IError path err) = rnf path `seq` rnf err
102+
92103instance (NFData a) => NFData (Result a) where
93104 rnf (Success a) = rnf a
94− rnf (Error path err) = rnf path `seq` rnf err
105+ rnf (Error err) = rnf err
106+
107+instance Functor IResult where
108+ fmap f (ISuccess a) = ISuccess (f a)
109+ fmap _ (IError path err) = IError path err
110+ {-# INLINE fmap #-}
95111
96112instance Functor Result where
97113 fmap f (Success a) = Success (f a)
98− fmap _ (Error path err) = Error path err
114+ fmap _ (Error err) = Error err
99115 {-# INLINE fmap #-}
100116
117+instance Monad IResult where
118+ return = ISuccess
119+ {-# INLINE return #-}
120+ ISuccess a >>= k = k a
121+ IError path err >>= _ = IError path err
122+ {-# INLINE (>>=) #-}
123+
101124instance Monad Result where
102125 return = Success
103126 {-# INLINE return #-}
104− Success a >>= k = k a
105− Error path err >>= _ = Error path err
127+ Success a >>= k = k a
128+ Error err >>= _ = Error err
106129 {-# INLINE (>>=) #-}
107130
131+instance Applicative IResult where
132+ pure = return
133+ {-# INLINE pure #-}
134+ (<*>) = ap
135+ {-# INLINE (<*>) #-}
136+
108137instance Applicative Result where
109138 pure = return
110139 {-# INLINE pure #-}
111140 (<*>) = ap
112141 {-# INLINE (<*>) #-}
113142
143+instance MonadPlus IResult where
144+ mzero = fail "mzero"
145+ {-# INLINE mzero #-}
146+ mplus a@(ISuccess _) _ = a
147+ mplus _ b = b
148+ {-# INLINE mplus #-}
149+
114150instance MonadPlus Result where
115151 mzero = fail "mzero"
116152 {-# INLINE mzero #-}
@@ -118,12 +154,24 @@ instance MonadPlus Result where
118154 mplus _ b = b
119155 {-# INLINE mplus #-}
120156
157+instance Alternative IResult where
158+ empty = mzero
159+ {-# INLINE empty #-}
160+ (<|>) = mplus
161+ {-# INLINE (<|>) #-}
162+
121163instance Alternative Result where
122164 empty = mzero
123165 {-# INLINE empty #-}
124166 (<|>) = mplus
125167 {-# INLINE (<|>) #-}
126168
169+instance Monoid (IResult a) where
170+ mempty = fail "mempty"
171+ {-# INLINE mempty #-}
172+ mappend = mplus
173+ {-# INLINE mappend #-}
174+
127175instance Monoid (Result a) where
128176 mempty = fail "mempty"
129177 {-# INLINE mempty #-}
@@ -288,9 +336,14 @@ emptyObject = Object H.empty
288336
289337-- | Run a 'Parser'.
290338parse :: (a -> Parser b) -> a -> Result b
291−parse m v = runParser (m v) [] Error Success
339+parse m v = runParser (m v) [] (const Error) Success
292340{-# INLINE parse #-}
293341
342+-- | Run a 'Parser'.
343+iparse :: (a -> Parser b) -> a -> IResult b
344+iparse m v = runParser (m v) [] IError ISuccess
345+{-# INLINE iparse #-}
346+
294347-- | Run a 'Parser' with a 'Maybe' result type.
295348parseMaybe :: (a -> Parser b) -> a -> Maybe b
296349parseMaybe m v = runParser (m v) [] (\_ _ -> Nothing) Just
@@ -298,18 +351,18 @@ parseMaybe m v = runParser (m v) [] (\_ _ -> Nothing) Just
298351
299352-- | Run a 'Parser' with an 'Either' result type.
300353parseEither :: (a -> Parser b) -> a -> Either String b
301−parseEither m v = runParser (m v) [] (\path msg -> Left $ formatError path msg) Right
354+parseEither m v = runParser (m v) [] onError Right
355+ where onError path msg = Left (formatError path msg)
302356{-# INLINE parseEither #-}
303357
304−-- | Annotate error message with JSON Path error location
358+-- | Annotate an error message with a
359+-- <http://goessner.net/articles/JsonPath/ JSONPath> error location.
305360formatError :: JSONPath -> String -> String
306−formatError path msg = "Error in " ++ (formatJSONPath path) ++ ": " ++ msg
307− where formatJSONPath :: JSONPath -> String
308− formatJSONPath p = format "$" p
309− where format :: String -> JSONPath -> String
310− format prefix [] = prefix
311− format prefix (Index idx:parts) = format (prefix ++ "[" ++ show idx ++ "]") parts
312− format prefix (Key key:parts) = format (prefix ++ "." ++ unpack key) parts
361+formatError path msg = "Error in " ++ (format "$" path) ++ ": " ++ msg
362+ where
363+ format pfx [] = pfx
364+ format pfx (Index idx:parts) = format (pfx ++ "[" ++ show idx ++ "]") parts
365+ format pfx (Key key:parts) = format (pfx ++ "." ++ unpack key) parts
313366
314367-- | A key\/value pair for an 'Object'.
315368type Pair = (Text, Value)