068664b · typeable/yaml

git.iko.soy/typeable/yaml

Better decoding type signature

commit068664b874f2052581d1d968a64b361a4d2120e6 authorMichael Snoyman <michael@snoyman.com> dateWed 13 Jan 2010, 20:35 (17 years ago) parentf9f6245

2 files changed+28−22

compare with master

unifiedsplit

Text/Libyaml.hs+15−9 runtests.hs+13−13

Text/Libyaml.hs+15−9

@@ -16,6 +16,8 @@ module Text.Libyaml

1616 , emitEvents

1717 , withParser

1818 , parserParse

19+ -- * Enumerator

20+ , EnumResult (..)

1921 -- * Higher level functions

2022 , encode

2123 , decode

@@ -296,18 +298,19 @@ getEvent er = do

296298 YamlMappingStartEvent -> return EventMappingStart

297299 YamlMappingEndEvent -> return EventMappingEnd

298300

299−parserParse :: (a -> Event -> Either a a)

301+parserParse :: (a -> Event -> IO (EnumResult a b))

300302 -> a

301303 -> Parser

302− -> IO (Either YamlException a)

304+ -> IO (Either YamlException b)

303305parserParse fold accum parser = do

304306 event' <- parserParseOne parser

305307 case event' of

306308 Left e -> return $ Left e

307309 Right event -> do

308− case fold accum event of

309− Left accum' -> return $ Right accum'

310− Right accum' -> parserParse fold accum' parser

310+ res <- fold accum event

311+ case res of

312+ Done accum' -> return $ Right accum'

313+ More accum' -> parserParse fold accum' parser

311314

312315-- Emitter

313316

@@ -520,6 +523,9 @@ newtype ToEventRawException = ToEventRawException CInt

520523 deriving (Show, Typeable)

521524instance Exception ToEventRawException

522525

526+data EnumResult a b = More a | Done b

527+ deriving (Eq, Show)

528+

523529encode :: (a -> Maybe (Event, a))

524530 -> a

525531 -> IO (Either YamlException B.ByteString)

@@ -533,13 +539,13 @@ encodeFile filePath unfold src =

533539 withEmitterFile filePath $ emitEvents unfold src

534540

535541decode :: B.ByteString

536− -> (a -> Event -> Either a a)

542+ -> (a -> Event -> IO (EnumResult a b))

537543 -> a

538− -> IO (Either YamlException a)

544+ -> IO (Either YamlException b)

539545decode bs fold accum = withParser bs $ parserParse fold accum

540546

541547decodeFile :: FilePath

542− -> (a -> Event -> Either a a)

548+ -> (a -> Event -> IO (EnumResult a b))

543549 -> a

544− -> IO (Either YamlException a)

550+ -> IO (Either YamlException b)

545551decodeFile fp fold accum = withFileParser fp $ parserParse fold accum

runtests.hs+13−13

@@ -25,11 +25,11 @@ caseCountScalars = do

2525 where

2626 yamlString = "foo:\n baz: [bin1, bin2, bin3]\nbaz: bazval"

2727 yamlBS = B8.pack yamlString

28− fold (s, l, m) (EventScalar {}) = Right (s + 1, l, m)

29− fold (s, l, m) EventSequenceStart = Right (s, l + 1, m)

30− fold (s, l, m) EventMappingStart = Right (s, l, m + 1)

31− fold res EventNone = Left res

32− fold res _ = Right res

28+ fold (s, l, m) (EventScalar {}) = return $ More (s + 1, l, m)

29+ fold (s, l, m) EventSequenceStart = return $ More (s, l + 1, m)

30+ fold (s, l, m) EventMappingStart = return $ More (s, l, m + 1)

31+ fold res EventNone = return $ Done res

32+ fold res _ = return $ More res

3333 accum = (0, 0, 0) :: (Int, Int, Int)

3434

3535caseLargestString :: Assertion

@@ -43,10 +43,10 @@ caseLargestString = do

4343 let s' = B8.unpack bs

4444 i' = length s'

4545 in if i' > i

46− then Right (i', s')

47− else Right (i, s)

48− fold res EventNone = Left res

49− fold res _ = Right res

46+ then return $ More (i', s')

47+ else return $ More (i, s)

48+ fold res EventNone = return $ Done res

49+ fold res _ = return $ More res

5050 accum = (0, "no strings found")

5151

5252toIO :: Exception l => IO (Either l r) -> IO r

@@ -63,8 +63,8 @@ caseEncodeDecode = do

6363 where

6464 yamlString = "foo: bar\nbaz:\n - bin1\n - bin2\n"

6565 yamlBS = B8.pack yamlString

66− fold x EventNone = Left x

67− fold x e = Right $ x . (:) e

66+ fold x EventNone = return $ Done x

67+ fold x e = return $ More $ x . (:) e

6868 unfold (x:xs) = Just (x, xs)

6969 unfold [] = Nothing

7070

@@ -79,8 +79,8 @@ caseEncodeDecodeFile = do

7979 where

8080 filePath = "test/largest-string.yaml"

8181 tmpPath = "tmp.yaml"

82− fold x EventNone = Left x

83− fold x e = Right $ x . (:) e

82+ fold x EventNone = return $ Done x

83+ fold x e = return $ More $ x . (:) e

8484 unfold (x:xs) = Just (x, xs)

8585 unfold [] = Nothing

8686