git.iko.soy/typeable/yaml
on master help sign in
Switched over completely to monadic parsing
5860fa9Michael Snoyman
Text/Libyaml.hs+6−31
compare with master
unifiedsplit
@@ -15,7 +15,6 @@ module Text.Libyaml
15 -- * Exceptions
15 -- * Exceptions
16 , YamlException (..)
16 , YamlException (..)
17 -- * Enumerator
17 -- * Enumerator
18− , EnumResult (..)
19 , With (..)
18 , With (..)
20 -- * Encoder
19 -- * Encoder
21 , YamlEncoder
20 , YamlEncoder
@@ -27,7 +26,6 @@ module Text.Libyaml
27 , decode
26 , decode
28 , encodeFile
27 , encodeFile
29 , decodeFile
28 , decodeFile
30− , decodeFile'
31 ) where
29 ) where
32
30
33import qualified Data.ByteString.Internal as B
31import qualified Data.ByteString.Internal as B
@@ -317,18 +315,6 @@ getEvent er = do
317 YamlMappingStartEvent -> return EventMappingStart
315 YamlMappingStartEvent -> return EventMappingStart
318 YamlMappingEndEvent -> return EventMappingEnd
316 YamlMappingEndEvent -> return EventMappingEnd
319
317
320−parserParse :: (MonadFailure YamlException m, With m)
321− => (a -> Event -> m (EnumResult a b))
322− -> a
323− -> Parser
324− -> m b
325−parserParse fold accum parser = do
326− event <- parserParseOne parser
327− res <- fold accum event
328− case res of
329− Done accum' -> return accum'
330− More accum' -> parserParse fold accum' parser
331−
332-- Emitter
318-- Emitter
333
319
334data EmitterStruct
320data EmitterStruct
@@ -552,9 +538,6 @@ newtype ToEventRawException = ToEventRawException CInt
552 deriving (Show, Typeable)
538 deriving (Show, Typeable)
553instance Exception ToEventRawException
539instance Exception ToEventRawException
554
540
555−data EnumResult a b = More a | Done b
556− deriving (Eq, Show)
557−
558encode :: (With m, MonadFailure YamlException m)
541encode :: (With m, MonadFailure YamlException m)
559 => YamlEncoder m ()
542 => YamlEncoder m ()
560 -> m B.ByteString
543 -> m B.ByteString
@@ -568,20 +551,12 @@ encodeFile filePath = withEmitterFile filePath . runMyReaderT
568
551
569decode :: (With m, MonadFailure YamlException m)
552decode :: (With m, MonadFailure YamlException m)
570 => B.ByteString
553 => B.ByteString
571− -> (a -> Event -> m (EnumResult a b))
554+ -> YamlDecoder m a
572− -> a
573− -> m b
555+ -> m a
574−decode bs fold accum = withParser bs $ parserParse fold accum
556+decode bs dec = withParser bs $ runMyReaderT dec
575
557
576decodeFile :: (With m, MonadFailure YamlException m)
558decodeFile :: (With m, MonadFailure YamlException m)
577 => FilePath
559 => FilePath
578− -> (a -> Event -> m (EnumResult a b))
579− -> a
580− -> m b
581−decodeFile fp fold accum = withFileParser fp $ parserParse fold accum
582−
583−decodeFile' :: (With m, MonadFailure YamlException m)
584− => FilePath
585− -> YamlDecoder m a
560+ -> YamlDecoder m a
586− -> m a
561+ -> m a
587−decodeFile' fp dec = withFileParser fp $ runMyReaderT dec
562+decodeFile fp dec = withFileParser fp $ runMyReaderT dec
runtests.hs+35−44
@@ -17,67 +17,72 @@ main = defaultMain
17 , testCase "encode/decode" caseEncodeDecode
17 , testCase "encode/decode" caseEncodeDecode
18 , testCase "encode/decode file" caseEncodeDecodeFile
18 , testCase "encode/decode file" caseEncodeDecodeFile
19 , testCase "interleaved encode/decode" caseInterleave
19 , testCase "interleaved encode/decode" caseInterleave
20− , testCase "interleaved encode/decode monadic" caseInterleaveMonad
21 ]
20 ]
22
21
23caseCountScalars :: Assertion
22caseCountScalars :: Assertion
24caseCountScalars = do
23caseCountScalars = do
25− res <- decode yamlBS fold accum
24+ res <- decode yamlBS $ counter accum
26 res @?= (7, 1, 2)
25 res @?= (7, 1, 2)
27 where
26 where
28 yamlString = "foo:\n baz: [bin1, bin2, bin3]\nbaz: bazval"
27 yamlString = "foo:\n baz: [bin1, bin2, bin3]\nbaz: bazval"
29 yamlBS = B8.pack yamlString
28 yamlBS = B8.pack yamlString
29+ counter (s, l, m) = do
30+ e <- parseEvent
31+ case e of
30− fold (s, l, m) (EventScalar {}) = return $ More (s + 1, l, m)
32+ EventScalar {} -> counter (s + 1, l, m)
31− fold (s, l, m) EventSequenceStart = return $ More (s, l + 1, m)
33+ EventSequenceStart -> counter (s, l + 1, m)
32− fold (s, l, m) EventMappingStart = return $ More (s, l, m + 1)
34+ EventMappingStart -> counter (s, l, m + 1)
33− fold res EventNone = return $ Done res
35+ EventNone -> return (s, l, m)
34− fold res _ = return $ More res
36+ _ -> counter (s, l, m)
35 accum = (0, 0, 0) :: (Int, Int, Int)
37 accum = (0, 0, 0) :: (Int, Int, Int)
36
38
37caseLargestString :: Assertion
39caseLargestString :: Assertion
38caseLargestString = do
40caseLargestString = do
39− res <- decodeFile filePath fold accum
41+ res <- decodeFile filePath $ dec accum
40 res @?= (length expected, expected)
42 res @?= (length expected, expected)
41 where
43 where
42 expected = "this one is just a little bit bigger than the others"
44 expected = "this one is just a little bit bigger than the others"
43 filePath = "test/largest-string.yaml"
45 filePath = "test/largest-string.yaml"
46+ dec (i, s) = do
47+ e <- parseEvent
48+ case e of
44− fold (i, s) (EventScalar bs _ _) =
49+ (EventScalar bs _ _) -> do
45− let s' = B8.unpack bs
50+ let s' = B8.unpack bs
46− i' = length s'
51+ i' = length s'
47− in if i' > i
52+ dec $ if i' > i then (i', s') else (i, s)
48− then return $ More (i', s')
49− else return $ More (i, s)
50− fold res EventNone = return $ Done res
53+ EventNone -> return (i, s)
51− fold res _ = return $ More res
54+ _ -> dec (i, s)
52 accum = (0, "no strings found")
55 accum = (0, "no strings found")
53
56
54caseEncodeDecode :: Assertion
57caseEncodeDecode :: Assertion
55caseEncodeDecode = do
58caseEncodeDecode = do
56− eList' <- decode yamlBS fold id
59+ eList <- decode yamlBS $ dec id
57− let eList = eList' []
58 bs <- encode $ mapM_ emitEvent eList
60 bs <- encode $ mapM_ emitEvent eList
59− eList2' <- decode bs fold id
61+ eList2 <- decode bs $ dec id
60− let eList2 = eList2' []
61 map MyEvent eList @=? map MyEvent eList2
62 map MyEvent eList @=? map MyEvent eList2
62 where
63 where
63 yamlString = "foo: bar\nbaz:\n - bin1\n - bin2\n"
64 yamlString = "foo: bar\nbaz:\n - bin1\n - bin2\n"
64 yamlBS = B8.pack yamlString
65 yamlBS = B8.pack yamlString
66+ dec front = do
67+ e <- parseEvent
68+ case e of
65− fold x EventNone = return $ Done x
69+ EventNone -> return $ front []
66− fold x e = return $ More $ x . (:) e
70+ _ -> dec $ front . (:) e
67
71
68caseEncodeDecodeFile :: Assertion
72caseEncodeDecodeFile :: Assertion
69caseEncodeDecodeFile = do
73caseEncodeDecodeFile = do
70− eList' <- decodeFile filePath fold id
74+ eList <- decodeFile filePath $ dec id
71− let eList = eList' []
72 encodeFile tmpPath $ mapM_ emitEvent eList
75 encodeFile tmpPath $ mapM_ emitEvent eList
73− eList2' <- decodeFile filePath fold id
76+ eList2 <- decodeFile filePath $ dec id
74− let eList2 = eList2' []
75 map MyEvent eList @=? map MyEvent eList2
77 map MyEvent eList @=? map MyEvent eList2
76 where
78 where
77 filePath = "test/largest-string.yaml"
79 filePath = "test/largest-string.yaml"
78 tmpPath = "tmp.yaml"
80 tmpPath = "tmp.yaml"
81+ dec front = do
82+ e <- parseEvent
83+ case e of
79− fold x EventNone = return $ Done x
84+ EventNone -> return $ front []
80− fold x e = return $ More $ x . (:) e
85+ _ -> dec $ front . (:) e
81
86
82newtype MyEvent = MyEvent Event deriving Show
87newtype MyEvent = MyEvent Event deriving Show
83instance Eq MyEvent where
88instance Eq MyEvent where
@@ -87,22 +92,8 @@ instance Eq MyEvent where
87
92
88caseInterleave :: Assertion
93caseInterleave :: Assertion
89caseInterleave = do
94caseInterleave = do
90− encodeFile tmpPath $ decodeFile filePath emitEvent' ()
91− encodeFile tmpPath2 $ decodeFile tmpPath emitEvent' ()
92− f1 <- readFile tmpPath
93− f2 <- readFile tmpPath2
94− f1 @=? f2
95− where
96− filePath = "test/largest-string.yaml"
97− tmpPath = "tmp.yaml"
98− tmpPath2 = "tmp2.yaml"
99− emitEvent' () EventNone = return $ Done ()
100− emitEvent' () e = emitEvent e >> return (More ())
101−
102−caseInterleaveMonad :: Assertion
103−caseInterleaveMonad = do
104− decodeFile' filePath $ encodeFile tmpPath inside
95+ decodeFile filePath $ encodeFile tmpPath inside
105− decodeFile' tmpPath $ encodeFile tmpPath2 inside
96+ decodeFile tmpPath $ encodeFile tmpPath2 inside
106 f1 <- readFile tmpPath
97 f1 <- readFile tmpPath
107 f2 <- readFile tmpPath2
98 f2 <- readFile tmpPath2
108 f1 @=? f2
99 f1 @=? f2