@@ -1,3 +1,5 @@
1+{-# LANGUAGE FlexibleInstances #-}
2+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
13---------------------------------------------------------
24--
35-- Module : Text.Yaml
@@ -18,6 +20,7 @@ module Text.Yaml
1820 , encodeFile
1921 , decode
2022 , decodeFile
23+ , testSuite
2124 ) where
2225
2326import Prelude hiding (readList)
@@ -25,53 +28,62 @@ import Text.Libyaml
2528import qualified Data.ByteString as B
2629import qualified Data.ByteString.Lazy as BL
2730import Data.ByteString.Class
28−import Data.Object
31+import Data.Object hiding (testSuite)
2932import System.IO.Unsafe
30−import Control.Arrow (first)
33+import Control.Arrow (first, (***))
34+import Control.Monad (replicateM)
3135
32−encode :: (StrictByteString bs, ToObject o) => o -> bs
36+import Test.Framework (testGroup, Test)
37+import Test.Framework.Providers.HUnit
38+import Test.Framework.Providers.QuickCheck (testProperty)
39+import Test.HUnit hiding (Test, path)
40+import Test.QuickCheck
41+
42+encode :: (StrictByteString bs, ToRawObject o) => o -> bs
3343encode = unsafePerformIO . encode'
3444
35−decode :: (Monad m, StrictByteString bs, FromObject o) => bs -> m o
45+decode :: (MonadFail m, StrictByteString bs, FromRawObject o) => bs -> m o
3646decode = unsafePerformIO . decode'
3747
38−encodeFile :: ToObject o => FilePath -> o -> IO ()
48+encodeFile :: ToRawObject o => FilePath -> o -> IO ()
3949encodeFile path o = encode' o >>= B.writeFile path
4050
41−decodeFile :: (Monad m, FromObject o) => FilePath -> IO (m o)
51+decodeFile :: (MonadFail m, FromRawObject o) => FilePath -> IO (m o)
4252decodeFile path = do
4353 c <- B.readFile path
4454 decode' c
4555
46−encode' :: (StrictByteString bs, ToObject o) => o -> IO bs
56+encode' :: (StrictByteString bs, ToRawObject o) => o -> IO bs
4757encode' o =
48− let events = objectToEvents $ toObject o
58+ let events = objectToEvents $ toRawObject o
4959 result = withEmitter $ flip emitEvents $ events
5060 in fromStrictByteString `fmap` result
5161
52−decode' :: (Monad m, StrictByteString bs, FromObject o) => bs -> IO (m o)
62+decode' :: (MonadFail m, StrictByteString bs, FromRawObject o)
63+ => bs
64+ -> IO (m o)
5365decode' bs = do
5466 let bs' = toStrictByteString bs
5567 events = withParser bs' parserParse
56− (fromObject . eventsToObject) `fmap` events
68+ (fromRawObject . eventsToRawObject) `fmap` events
5769
58−objectToEvents :: Object -> [Event]
70+objectToEvents :: RawObject -> [Event]
5971objectToEvents y = concat
6072 [ [EventStreamStart, EventDocumentStart]
6173 , writeSingle y
6274 , [EventDocumentEnd, EventStreamEnd]] where
63− writeSingle :: Object -> [Event]
75+ writeSingle :: RawObject -> [Event]
6476 writeSingle (Scalar bs) = [EventScalar $ fromLazyByteString bs]
6577 writeSingle (Sequence ys) =
6678 (EventSequenceStart : concatMap writeSingle ys)
6779 ++ [EventSequenceEnd]
6880 writeSingle (Mapping pairs) =
6981 EventMappingStart : concatMap writePair pairs ++ [EventMappingEnd]
70− writePair :: (BL.ByteString, Object) -> [Event]
82+ writePair :: (BL.ByteString, RawObject) -> [Event]
7183 writePair (k, v) = EventScalar (fromLazyByteString k) : writeSingle v
7284
73−eventsToObject :: [Event] -> Object
74−eventsToObject = fst . readSingle . dropWhile isIgnored where
85+eventsToRawObject :: [Event] -> RawObject
86+eventsToRawObject = fst . readSingle . dropWhile isIgnored where
7587 isIgnored EventAlias = False
7688 isIgnored (EventScalar _) = False
7789 isIgnored EventSequenceStart = False
@@ -79,19 +91,21 @@ eventsToObject = fst . readSingle . dropWhile isIgnored where
7991 isIgnored EventMappingStart = False
8092 isIgnored EventMappingEnd = False
8193 isIgnored _ = True
82− readSingle :: [Event] -> (Object, [Event])
94+ readSingle :: [Event] -> (RawObject, [Event])
8395 readSingle [] = error "readSingle: no more events"
8496 readSingle (EventScalar bs:rest) = (Scalar $ toLazyByteString bs, rest)
8597 readSingle (EventSequenceStart:rest) = readList [] rest
8698 readSingle (EventMappingStart:rest) = readMap [] rest
8799 readSingle (x:_) = error $ "readSingle: " ++ show x
88− readList :: [Object] -> [Event] -> (Object, [Event])
100+ readList :: [RawObject] -> [Event] -> (RawObject, [Event])
89101 readList nodes (EventSequenceEnd:rest) =
90102 (Sequence $ reverse nodes, rest)
91103 readList nodes events =
92104 let (next, rest) = readSingle events
93105 in readList (next : nodes) rest
94− readMap :: [(B.ByteString, Object)] -> [Event] -> (Object, [Event])
106+ readMap :: [(B.ByteString, RawObject)]
107+ -> [Event]
108+ -> (RawObject, [Event])
95109 readMap pairs (EventMappingEnd:rest) =
96110 (Mapping $ map (first toLazyByteString) $ reverse pairs, rest)
97111 readMap pairs (EventScalar bs:events) =
@@ -99,3 +113,41 @@ eventsToObject = fst . readSingle . dropWhile isIgnored where
99113 in readMap ((fromStrictByteString bs, next) : pairs) rest
100114 readMap _ (e:_) = error $ "Unexpected event in readMap: " ++ show e
101115 readMap _ [] = error "Unexpected empty event list in readMap"
116+
117+newtype MyString = MyString String
118+ deriving (Eq, Show, ToRaw, FromRaw, ToRawObject, FromRawObject)
119+propEncodeDecode :: Object MyString MyString -> Bool
120+propEncodeDecode o = decode (encode o :: B.ByteString) == Just o
121+
122+caseEmptyStrings :: Assertion
123+caseEmptyStrings = do
124+ let m =
125+ [ ("foo", "bar")
126+ , ("baz", "")
127+ , ("bin", "")
128+ ]
129+ let m' = map (toStrictByteString *** toStrictByteString) m
130+ let m'' = map (toLazyByteString *** toLazyByteString) m
131+ Just m @=? decode (encode m :: String)
132+ Just m' @=? decode (encode m' :: String)
133+ Just m'' @=? decode (encode m'' :: String)
134+
135+testSuite :: Test
136+testSuite = testGroup "Text.Yaml"
137+ [ testProperty "propEncodeDecode" propEncodeDecode
138+ , testCase "empty strings" caseEmptyStrings
139+ ]
140+
141+instance Arbitrary (Object MyString MyString) where
142+ coarbitrary = undefined
143+ arbitrary = oneof [arbS, arbL, arbM] where
144+ arbS = Scalar `fmap` (arbitrary :: Gen MyString)
145+ arbL = Sequence `fmap` vector 1
146+ arbM = Mapping `fmap` vector 1
147+
148+instance Arbitrary MyString where
149+ coarbitrary = undefined
150+ arbitrary = do
151+ size <- arbitrary
152+ s <- replicateM (size `mod` 5) $ elements ['A'..'Z']
153+ return $! MyString s