git.iko.soy/typeable/yaml
on master help sign in
Merge pull request #144 from sol/refactoring
78453deMichael Snoyman
src/Data/Yaml/Internal.hs+22−26
compare with master
unifiedsplit
@@ -34,6 +34,7 @@ import Data.Conduit ((.|), ConduitM, runConduit)
34import qualified Data.Conduit.List as CL
34import qualified Data.Conduit.List as CL
35import qualified Data.HashMap.Strict as M
35import qualified Data.HashMap.Strict as M
36import qualified Data.HashSet as HashSet
36import qualified Data.HashSet as HashSet
37+import Data.Map (Map)
37import qualified Data.Map as Map
38import qualified Data.Map as Map
38import Data.Scientific (Scientific)
39import Data.Scientific (Scientific)
39import Data.Text (Text, pack)
40import Data.Text (Text, pack)
@@ -126,7 +127,13 @@ instance MonadTrans PErrorT where
126instance MonadIO m => MonadIO (PErrorT m) where
127instance MonadIO m => MonadIO (PErrorT m) where
127 liftIO = lift . liftIO
128 liftIO = lift . liftIO
128
129
130+defineAnchor :: Value -> String -> ConduitM e o Parse ()
131+defineAnchor value name = lift $ modify $ Map.insert name value
132+
133+lookupAnchor :: String -> ConduitM e o Parse (Maybe Value)
134+lookupAnchor name = lift $ gets (Map.lookup name)
135+
129−type Parse = StateT (Map.Map String Value) (ResourceT IO)
136+type Parse = StateT (Map String Value) (ResourceT IO)
130
137
131requireEvent :: Event -> ConduitM Event o Parse ()
138requireEvent :: Event -> ConduitM Event o Parse ()
132requireEvent e = do
139requireEvent e = do
@@ -158,11 +165,8 @@ parseScalar :: ByteString -> Anchor -> Style -> Tag
158 -> ConduitM Event o Parse Text
165 -> ConduitM Event o Parse Text
159parseScalar v a style tag = do
166parseScalar v a style tag = do
160 let res = decodeUtf8With lenientDecode v
167 let res = decodeUtf8With lenientDecode v
161− case a of
162− Nothing -> return res
163− Just an -> do
164− lift $ modify (Map.insert an $ textToValue style tag res)
168+ mapM_ (defineAnchor (textToValue style tag res)) a
165− return res
169+ return res
166
170
167textToValue :: Style -> Tag -> Text -> Value
171textToValue :: Style -> Tag -> Text -> Value
168textToValue SingleQuoted _ t = String t
172textToValue SingleQuoted _ t = String t
@@ -198,8 +202,8 @@ parseO = do
198 Just (EventSequenceStart _ _ a) -> parseS a id
202 Just (EventSequenceStart _ _ a) -> parseS a id
199 Just (EventMappingStart _ _ a) -> parseM a M.empty
203 Just (EventMappingStart _ _ a) -> parseM a M.empty
200 Just (EventAlias an) -> do
204 Just (EventAlias an) -> do
201− m <- lift get
205+ m <- lookupAnchor an
202− case Map.lookup an m of
206+ case m of
203 Nothing -> liftIO $ throwIO $ UnknownAlias an
207 Nothing -> liftIO $ throwIO $ UnknownAlias an
204 Just v -> return v
208 Just v -> return v
205 _ -> liftIO $ throwIO $ UnexpectedEvent me Nothing
209 _ -> liftIO $ throwIO $ UnexpectedEvent me Nothing
@@ -213,11 +217,8 @@ parseS a front = do
213 Just EventSequenceEnd -> do
217 Just EventSequenceEnd -> do
214 CL.drop 1
218 CL.drop 1
215 let res = Array $ V.fromList $ front []
219 let res = Array $ V.fromList $ front []
216− case a of
220+ mapM_ (defineAnchor res) a
217− Nothing -> return res
218− Just an -> do
219− lift $ modify $ Map.insert an res
220− return res
221+ return res
221 _ -> do
222 _ -> do
222 o <- parseO
223 o <- parseO
223 parseS a $ front . (:) o
224 parseS a $ front . (:) o
@@ -226,23 +227,18 @@ parseM :: Y.Anchor
226 -> M.HashMap Text Value
227 -> M.HashMap Text Value
227 -> ConduitM Event o Parse Value
228 -> ConduitM Event o Parse Value
228parseM a front = do
229parseM a front = do
229− me <- CL.peek
230+ me <- CL.head
230 case me of
231 case me of
231 Just EventMappingEnd -> do
232 Just EventMappingEnd -> do
232− CL.drop 1
233 let res = Object front
233 let res = Object front
234− case a of
234+ mapM_ (defineAnchor res) a
235− Nothing -> return res
236− Just an -> do
237− lift $ modify $ Map.insert an res
238− return res
235+ return res
239 _ -> do
236 _ -> do
240− CL.drop 1
241 s <- case me of
237 s <- case me of
242 Just (EventScalar v tag style a') -> parseScalar v a' style tag
238 Just (EventScalar v tag style a') -> parseScalar v a' style tag
243 Just (EventAlias an) -> do
239 Just (EventAlias an) -> do
244− m <- lift get
240+ m <- lookupAnchor an
245− case Map.lookup an m of
241+ case m of
246 Nothing -> liftIO $ throwIO $ UnknownAlias an
242 Nothing -> liftIO $ throwIO $ UnknownAlias an
247 Just (String t) -> return t
243 Just (String t) -> return t
248 Just v -> liftIO $ throwIO $ NonStringKeyAlias an v
244 Just v -> liftIO $ throwIO $ NonStringKeyAlias an v
@@ -253,12 +249,12 @@ parseM a front = do
253 al' = if s == pack "<<"
249 al' = if s == pack "<<"
254 then case o of
250 then case o of
255 Object l -> M.union front l
251 Object l -> M.union front l
256− Array l -> M.union front $ foldl merge' M.empty $ V.toList l
252+ Array l -> M.union front $ foldl mergeObjects M.empty $ V.toList l
257 _ -> al
253 _ -> al
258 else al
254 else al
259 parseM a al'
255 parseM a al'
260− where merge' al (Object om) = M.union al om
256+ where mergeObjects al (Object om) = M.union al om
261− merge' al _ = al
257+ mergeObjects al _ = al
262
258
263decodeHelper :: FromJSON a
259decodeHelper :: FromJSON a
264 => ConduitM () Y.Event Parse ()
260 => ConduitM () Y.Event Parse ()