@@ -1,5 +1,6 @@
11{-# LANGUAGE FlexibleInstances #-}
2−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE MultiParamTypeClasses #-}
34---------------------------------------------------------
45--
56-- Module : Text.Yaml
@@ -26,9 +27,9 @@ module Text.Yaml
2627import Prelude hiding (readList)
2728import Text.Libyaml
2829import qualified Data.ByteString as B
29−import qualified Data.ByteString.Lazy as BL
3030import Data.ByteString.Class
31−import Data.Object hiding (testSuite)
31+import Data.Object
32+import Data.Object.Raw
3233import System.IO.Unsafe
3334import Control.Arrow (first, (***))
3435import Control.Monad (replicateM)
@@ -39,33 +40,35 @@ import Test.Framework.Providers.QuickCheck (testProperty)
3940import Test.HUnit hiding (Test, path)
4041import Test.QuickCheck
4142
42−encode :: (StrictByteString bs, ToRawObject o) => o -> bs
43+encode :: (StrictByteString bs, ToObject o Raw Raw) => o -> bs
4344encode = unsafePerformIO . encode'
4445
45−decode :: (MonadFail m, StrictByteString bs, FromRawObject o) => bs -> m o
46+decode :: (MonadFail m, StrictByteString bs, FromObject o Raw Raw)
47+ => bs
48+ -> m o
4649decode = unsafePerformIO . decode'
4750
48−encodeFile :: ToRawObject o => FilePath -> o -> IO ()
51+encodeFile :: ToObject o Raw Raw => FilePath -> o -> IO ()
4952encodeFile path o = encode' o >>= B.writeFile path
5053
51−decodeFile :: (MonadFail m, FromRawObject o) => FilePath -> IO (m o)
54+decodeFile :: (MonadFail m, FromObject o Raw Raw) => FilePath -> IO (m o)
5255decodeFile path = do
5356 c <- B.readFile path
5457 decode' c
5558
56−encode' :: (StrictByteString bs, ToRawObject o) => o -> IO bs
59+encode' :: (StrictByteString bs, ToObject o Raw Raw) => o -> IO bs
5760encode' o =
58− let events = objectToEvents $ toRawObject o
61+ let events = objectToEvents $ toObject o
5962 result = withEmitter $ flip emitEvents $ events
6063 in fromStrictByteString `fmap` result
6164
62−decode' :: (MonadFail m, StrictByteString bs, FromRawObject o)
65+decode' :: (MonadFail m, StrictByteString bs, FromObject o Raw Raw)
6366 => bs
6467 -> IO (m o)
6568decode' bs = do
6669 let bs' = toStrictByteString bs
6770 events = withParser bs' parserParse
68− (fromRawObject . eventsToRawObject) `fmap` events
71+ (fromObject . eventsToRawObject) `fmap` events
6972
7073objectToEvents :: RawObject -> [Event]
7174objectToEvents y = concat
@@ -73,14 +76,14 @@ objectToEvents y = concat
7376 , writeSingle y
7477 , [EventDocumentEnd, EventStreamEnd]] where
7578 writeSingle :: RawObject -> [Event]
76− writeSingle (Scalar bs) = [EventScalar $ fromLazyByteString bs]
79+ writeSingle (Scalar (Raw bs)) = [EventScalar $ toStrictByteString bs]
7780 writeSingle (Sequence ys) =
7881 (EventSequenceStart : concatMap writeSingle ys)
7982 ++ [EventSequenceEnd]
8083 writeSingle (Mapping pairs) =
8184 EventMappingStart : concatMap writePair pairs ++ [EventMappingEnd]
82− writePair :: (BL.ByteString, RawObject) -> [Event]
83− writePair (k, v) = EventScalar (fromLazyByteString k) : writeSingle v
85+ writePair :: (Raw, RawObject) -> [Event]
86+ writePair (Raw k, v) = EventScalar (fromLazyByteString k) : writeSingle v
8487
8588eventsToRawObject :: [Event] -> RawObject
8689eventsToRawObject = fst . readSingle . dropWhile isIgnored where
@@ -93,7 +96,8 @@ eventsToRawObject = fst . readSingle . dropWhile isIgnored where
9396 isIgnored _ = True
9497 readSingle :: [Event] -> (RawObject, [Event])
9598 readSingle [] = error "readSingle: no more events"
96− readSingle (EventScalar bs:rest) = (Scalar $ toLazyByteString bs, rest)
99+ readSingle (EventScalar bs:rest) =
100+ (Scalar $ Raw $ toLazyByteString bs, rest)
97101 readSingle (EventSequenceStart:rest) = readList [] rest
98102 readSingle (EventMappingStart:rest) = readMap [] rest
99103 readSingle (x:_) = error $ "readSingle: " ++ show x
@@ -107,7 +111,7 @@ eventsToRawObject = fst . readSingle . dropWhile isIgnored where
107111 -> [Event]
108112 -> (RawObject, [Event])
109113 readMap pairs (EventMappingEnd:rest) =
110− (Mapping $ map (first toLazyByteString) $ reverse pairs, rest)
114+ (Mapping $ map (first $ Raw . toLazyByteString) $ reverse pairs, rest)
111115 readMap pairs (EventScalar bs:events) =
112116 let (next, rest) = readSingle events
113117 in readMap ((fromStrictByteString bs, next) : pairs) rest
@@ -115,7 +119,12 @@ eventsToRawObject = fst . readSingle . dropWhile isIgnored where
115119 readMap _ [] = error "Unexpected empty event list in readMap"
116120
117121newtype MyString = MyString String
118− deriving (Eq, Show, ToRaw, FromRaw, ToRawObject, FromRawObject)
122+ deriving (Eq, Show)
123+instance ToScalar MyString Raw where
124+ toScalar (MyString s) = toScalar s
125+instance FromScalar MyString Raw where
126+ fromScalar raw = MyString `fmap` fromScalar raw
127+
119128propEncodeDecode :: Object MyString MyString -> Bool
120129propEncodeDecode o = decode (encode o :: B.ByteString) == Just o
121130
@@ -126,9 +135,10 @@ caseEmptyStrings = do
126135 , ("baz", "")
127136 , ("bin", "")
128137 ]
138+ ma = m
129139 let m' = map (toStrictByteString *** toStrictByteString) m
130140 let m'' = map (toLazyByteString *** toLazyByteString) m
131− Just m @=? decode (encode m :: String)
141+ Just ma @=? decode (encode ma :: String)
132142 Just m' @=? decode (encode m' :: String)
133143 Just m'' @=? decode (encode m'' :: String)
134144