@@ -22,7 +22,8 @@ import Control.Applicative ((<|>))
2222import Control.Exception
2323import Control.Monad (when, unless)
2424import Control.Monad.Trans.Resource (ResourceT, runResourceT)
25−import Control.Monad.RWS
25+import Control.Monad.State
26+import Control.Monad.Reader
2627import Data.Aeson
2728import Data.Aeson.Internal (JSONPath, JSONPathElement(..))
2829import Data.Aeson.Types hiding (parse)
@@ -113,18 +114,29 @@ prettyPrintParseException pe = case pe of
113114 CyclicIncludes -> "Cyclic includes"
114115
115116defineAnchor :: Value -> String -> ConduitM e o Parse ()
116−defineAnchor value name = modify $ Map.insert name value
117+defineAnchor value name = modify (modifyAnchors $ Map.insert name value)
118+ where
119+ modifyAnchors :: (Map String Value -> Map String Value) -> ParseState -> ParseState
120+ modifyAnchors f st = st {parseStateAnchors = f (parseStateAnchors st)}
117121
118122lookupAnchor :: String -> ConduitM e o Parse (Maybe Value)
119−lookupAnchor name = gets (Map.lookup name)
123+lookupAnchor name = gets (Map.lookup name . parseStateAnchors)
120124
121125data Warning = DuplicateKey JSONPath
122126 deriving (Eq, Show)
123127
124128addWarning :: Warning -> ConduitM e o Parse ()
125−addWarning = tell . return
129+addWarning w = modify (modifyWarnings (w :))
130+ where
131+ modifyWarnings :: ([Warning] -> [Warning]) -> ParseState -> ParseState
132+ modifyWarnings f st = st {parseStateWarnings = f (parseStateWarnings st)}
133+
134+data ParseState = ParseState {
135+ parseStateAnchors :: Map String Value
136+, parseStateWarnings :: [Warning]
137+}
126138
127−type Parse = RWST JSONPath [Warning] (Map String Value) (ResourceT IO)
139+type Parse = ReaderT JSONPath (StateT ParseState (ResourceT IO))
128140
129141requireEvent :: Event -> ConduitM Event o Parse ()
130142requireEvent e = do
@@ -263,28 +275,28 @@ decodeHelper src = do
263275 -- This used to be tryAny, but the fact is that catching async
264276 -- exceptions is fine here. We'll rethrow them immediately in the
265277 -- otherwise clause.
266− x <- try $ runResourceT $ evalRWST (runConduit $ src .| parse) [] Map.empty
278+ x <- try $ runResourceT $ runStateT (runReaderT (runConduit $ src .| parse) []) (ParseState Map.empty [])
267279 case x of
268280 Left e
269281 | Just pe <- fromException e -> return $ Left pe
270282 | Just ye <- fromException e -> return $ Left $ InvalidYaml $ Just (ye :: YamlException)
271283 | otherwise -> throwIO e
272− Right (y, warnings) -> return $ Right (warnings, parseEither parseJSON y)
284+ Right (y, st) -> return $ Right (parseStateWarnings st, parseEither parseJSON y)
273285
274286decodeHelper_ :: FromJSON a
275287 => ConduitM () Event Parse ()
276288 -> IO (Either ParseException ([Warning], a))
277289decodeHelper_ src = do
278− x <- try $ runResourceT $ evalRWST (runConduit $ src .| parse) [] Map.empty
290+ x <- try $ runResourceT $ runStateT (runReaderT (runConduit $ src .| parse) []) (ParseState Map.empty [])
279291 return $ case x of
280292 Left e
281293 | Just pe <- fromException e -> Left pe
282294 | Just ye <- fromException e -> Left $ InvalidYaml $ Just (ye :: YamlException)
283295 | otherwise -> Left $ OtherParseException e
284− Right (y, warnings) -> either
296+ Right (y, st) -> either
285297 (Left . AesonException)
286298 Right
287− ((,) warnings <$> parseEither parseJSON y)
299+ ((,) (parseStateWarnings st) <$> parseEither parseJSON y)
288300
289301-- | Strings which must be escaped so as not to be treated as non-string scalars.
290302specialStrings :: HashSet.HashSet Text