@@ -1,5 +1,6 @@
1{-# LANGUAGE FlexibleInstances #-}
1{-# LANGUAGE FlexibleInstances #-}
2−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE MultiParamTypeClasses #-}
3---------------------------------------------------------
4---------------------------------------------------------
5-- Module : Text.Yaml
6-- Module : Text.Yaml
@@ -26,9 +27,9 @@ module Text.Yaml
26import Prelude hiding (readList)
27import Prelude hiding (readList)
27import Text.Libyaml
28import Text.Libyaml
28import qualified Data.ByteString as B
29import qualified Data.ByteString as B
29−import qualified Data.ByteString.Lazy as BL
30import Data.ByteString.Class
30import Data.ByteString.Class
31−import Data.Object hiding (testSuite)
31+import Data.Object
32+import Data.Object.Raw
32import System.IO.Unsafe
33import System.IO.Unsafe
33import Control.Arrow (first, (***))
34import Control.Arrow (first, (***))
34import Control.Monad (replicateM)
35import Control.Monad (replicateM)
@@ -39,33 +40,35 @@ import Test.Framework.Providers.QuickCheck (testProperty)
39import Test.HUnit hiding (Test, path)
40import Test.HUnit hiding (Test, path)
40import Test.QuickCheck
41import Test.QuickCheck
42−encode :: (StrictByteString bs, ToRawObject o) => o -> bs
43+encode :: (StrictByteString bs, ToObject o Raw Raw) => o -> bs
43encode = unsafePerformIO . encode'
44encode = unsafePerformIO . encode'
45−decode :: (MonadFail m, StrictByteString bs, FromRawObject o) => bs -> m o
46+decode :: (MonadFail m, StrictByteString bs, FromObject o Raw Raw)
46decode = unsafePerformIO . decode'
49decode = unsafePerformIO . decode'
48−encodeFile :: ToRawObject o => FilePath -> o -> IO ()
51+encodeFile :: ToObject o Raw Raw => FilePath -> o -> IO ()
49encodeFile path o = encode' o >>= B.writeFile path
52encodeFile path o = encode' o >>= B.writeFile path
51−decodeFile :: (MonadFail m, FromRawObject o) => FilePath -> IO (m o)
54+decodeFile :: (MonadFail m, FromObject o Raw Raw) => FilePath -> IO (m o)
52decodeFile path = do
55decodeFile path = do
53 c <- B.readFile path
56 c <- B.readFile path
56−encode' :: (StrictByteString bs, ToRawObject o) => o -> IO bs
59+encode' :: (StrictByteString bs, ToObject o Raw Raw) => o -> IO bs
57encode' o =
60encode' o =
58− let events = objectToEvents $ toRawObject o
61+ let events = objectToEvents $ toObject o
59 result = withEmitter $ flip emitEvents $ events
62 result = withEmitter $ flip emitEvents $ events
60 in fromStrictByteString `fmap` result
63 in fromStrictByteString `fmap` result
62−decode' :: (MonadFail m, StrictByteString bs, FromRawObject o)
65+decode' :: (MonadFail m, StrictByteString bs, FromObject o Raw Raw)
64 -> IO (m o)
67 -> IO (m o)
65decode' bs = do
68decode' bs = do
66 let bs' = toStrictByteString bs
69 let bs' = toStrictByteString bs
67 events = withParser bs' parserParse
70 events = withParser bs' parserParse
68− (fromRawObject . eventsToRawObject) `fmap` events
71+ (fromObject . eventsToRawObject) `fmap` events
70objectToEvents :: RawObject -> [Event]
73objectToEvents :: RawObject -> [Event]
71objectToEvents y = concat
74objectToEvents y = concat
@@ -73,14 +76,14 @@ objectToEvents y = concat
73 , writeSingle y
76 , writeSingle y
74 , [EventDocumentEnd, EventStreamEnd]] where
77 , [EventDocumentEnd, EventStreamEnd]] where
75 writeSingle :: RawObject -> [Event]
78 writeSingle :: RawObject -> [Event]
76− writeSingle (Scalar bs) = [EventScalar $ fromLazyByteString bs]
79+ writeSingle (Scalar (Raw bs)) = [EventScalar $ toStrictByteString bs]
77 writeSingle (Sequence ys) =
80 writeSingle (Sequence ys) =
78 (EventSequenceStart : concatMap writeSingle ys)
81 (EventSequenceStart : concatMap writeSingle ys)
79 ++ [EventSequenceEnd]
82 ++ [EventSequenceEnd]
80 writeSingle (Mapping pairs) =
83 writeSingle (Mapping pairs) =
81 EventMappingStart : concatMap writePair pairs ++ [EventMappingEnd]
84 EventMappingStart : concatMap writePair pairs ++ [EventMappingEnd]
82− writePair :: (BL.ByteString, RawObject) -> [Event]
85+ writePair :: (Raw, RawObject) -> [Event]
83− writePair (k, v) = EventScalar (fromLazyByteString k) : writeSingle v
86+ writePair (Raw k, v) = EventScalar (fromLazyByteString k) : writeSingle v
85eventsToRawObject :: [Event] -> RawObject
88eventsToRawObject :: [Event] -> RawObject
86eventsToRawObject = fst . readSingle . dropWhile isIgnored where
89eventsToRawObject = fst . readSingle . dropWhile isIgnored where
@@ -93,7 +96,8 @@ eventsToRawObject = fst . readSingle . dropWhile isIgnored where
93 isIgnored _ = True
96 isIgnored _ = True
94 readSingle :: [Event] -> (RawObject, [Event])
97 readSingle :: [Event] -> (RawObject, [Event])
95 readSingle [] = error "readSingle: no more events"
98 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)
97 readSingle (EventSequenceStart:rest) = readList [] rest
101 readSingle (EventSequenceStart:rest) = readList [] rest
98 readSingle (EventMappingStart:rest) = readMap [] rest
102 readSingle (EventMappingStart:rest) = readMap [] rest
99 readSingle (x:_) = error $ "readSingle: " ++ show x
103 readSingle (x:_) = error $ "readSingle: " ++ show x
@@ -107,7 +111,7 @@ eventsToRawObject = fst . readSingle . dropWhile isIgnored where
107 -> [Event]
111 -> [Event]
108 -> (RawObject, [Event])
112 -> (RawObject, [Event])
109 readMap pairs (EventMappingEnd:rest) =
113 readMap pairs (EventMappingEnd:rest) =
110− (Mapping $ map (first toLazyByteString) $ reverse pairs, rest)
114+ (Mapping $ map (first $ Raw . toLazyByteString) $ reverse pairs, rest)
111 readMap pairs (EventScalar bs:events) =
115 readMap pairs (EventScalar bs:events) =
112 let (next, rest) = readSingle events
116 let (next, rest) = readSingle events
113 in readMap ((fromStrictByteString bs, next) : pairs) rest
117 in readMap ((fromStrictByteString bs, next) : pairs) rest
@@ -115,7 +119,12 @@ eventsToRawObject = fst . readSingle . dropWhile isIgnored where
115 readMap _ [] = error "Unexpected empty event list in readMap"
119 readMap _ [] = error "Unexpected empty event list in readMap"
117newtype MyString = MyString String
121newtype 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
119propEncodeDecode :: Object MyString MyString -> Bool
128propEncodeDecode :: Object MyString MyString -> Bool
120propEncodeDecode o = decode (encode o :: B.ByteString) == Just o
129propEncodeDecode o = decode (encode o :: B.ByteString) == Just o
@@ -126,9 +135,10 @@ caseEmptyStrings = do
126 , ("baz", "")
135 , ("baz", "")
127 , ("bin", "")
136 , ("bin", "")
129 let m' = map (toStrictByteString *** toStrictByteString) m
139 let m' = map (toStrictByteString *** toStrictByteString) m
130 let m'' = map (toLazyByteString *** toLazyByteString) m
140 let m'' = map (toLazyByteString *** toLazyByteString) m
131− Just m @=? decode (encode m :: String)
141+ Just ma @=? decode (encode ma :: String)
132 Just m' @=? decode (encode m' :: String)
142 Just m' @=? decode (encode m' :: String)
133 Just m'' @=? decode (encode m'' :: String)
143 Just m'' @=? decode (encode m'' :: String)