@@ -1,6 +1,7 @@
11{-# LANGUAGE FlexibleInstances #-}
22{-# LANGUAGE FlexibleContexts #-}
33{-# LANGUAGE MultiParamTypeClasses #-}
4+{-# LANGUAGE CPP #-}
45---------------------------------------------------------
56--
67-- Module : Text.Yaml
@@ -21,84 +22,97 @@ module Text.Yaml
2122 , encodeFile
2223 , decode
2324 , decodeFile
25+#if TEST
2426 , testSuite
27+#endif
2528 ) where
2629
2730import Prelude hiding (readList)
2831import Text.Libyaml
2932import qualified Data.ByteString as B
30−import Data.ByteString.Class
33+import qualified Data.ByteString.Lazy as BL
3134import Data.Object
32−import Data.Object.Raw
35+import Data.Object.Text
3336import System.IO.Unsafe
34−import Control.Arrow (first, (***))
35−import Control.Monad (replicateM, liftM)
37+import Control.Arrow (first)
38+import Control.Monad (liftM, join)
3639import Control.Monad.Trans
3740import Control.Monad.Attempt
41+import Data.Convertible
3842
43+import Data.Text.Lazy (Text)
44+import qualified Data.Text.Lazy as LT
45+import qualified Data.Text.Lazy.Encoding as LTE
46+
47+#if TEST
3948import Test.Framework (testGroup, Test)
4049import Test.Framework.Providers.HUnit
4150import Test.Framework.Providers.QuickCheck (testProperty)
4251import Test.HUnit hiding (Test, path)
4352import Test.QuickCheck
53+#endif
4454
45−import Control.Exception
46−
47−encode :: (StrictByteString bs, ToObject o Raw Raw) => o -> bs
55+encode :: (ConvertSuccess B.ByteString a, ToObject o Text Text) => o -> a
4856encode = unsafePerformIO . encode'
4957
50−decode :: (StrictByteString bs, FromObject o Raw Raw, MonadFailure SomeException m)
51− => bs
52− -> m o
53−decode bs = unsafePerformIO $ do
54− a <- runAttemptT $ decode' bs -- FIXME
55− case a of
56− Success s -> return $ return s
57− Failure e -> return $ failure e
58+decode :: (ConvertSuccess a B.ByteString,
59+ MonadFailure YamlException m)
60+ => a
61+ -> m TextObject
62+decode = unsafePerformIO . decode'
5863
59−encodeFile :: ToObject o Raw Raw => FilePath -> o -> IO ()
60−encodeFile path o = encode' o >>= B.writeFile path
64+encodeFile :: ToObject o Text Text => FilePath -> o -> IO ()
65+encodeFile path o = encode' o >>= ltWriteFile path
6166
62−decodeFile :: (FromObject o Raw Raw, MonadFailure SomeException m, MonadIO m)
63− => FilePath
64− -> m o
65−decodeFile path = liftIO (B.readFile path) >>= decode'
67+ltWriteFile :: FilePath -> Text -> IO ()
68+ltWriteFile fp = BL.writeFile fp . LTE.encodeUtf8
6669
67−encode' :: (StrictByteString bs, ToObject o Raw Raw) => o -> IO bs
70+decodeFile :: (MonadFailure YamlException m,
71+ MonadIO m)
72+ => FilePath
73+ -> m TextObject
74+decodeFile path = do
75+ contents <- liftIO (ltReadFile path)
76+ join $ liftIO $ decode' contents
77+
78+ltReadFile :: FilePath -> IO Text
79+ltReadFile = fmap LTE.decodeUtf8 . BL.readFile
80+
81+encode' :: (ConvertSuccess B.ByteString a,
82+ ToObject o Text Text)
83+ => o
84+ -> IO a
6885encode' o =
6986 let events = objectToEvents $ toObject o
7087 result = withEmitter $ flip emitEvents events
71− in fromStrictByteString `fmap` joinAttempt result
88+ in convertSuccess `fmap` joinAttempt result
7289
73−decode' :: (StrictByteString bs, FromObject o Raw Raw, MonadIO m,
74− MonadFailure SomeException m)
75− => bs
76− -> m o
90+decode' :: (ConvertSuccess a B.ByteString,
91+ MonadFailure YamlException m
92+ )
93+ => a
94+ -> IO (m TextObject)
7795decode' bs = do
78− events <- liftIO $ withParser (toStrictByteString bs) parserParse
79− attempt failure' (myFA . fromObject . eventsToRawObject) events
80− where
81− myFA = attempt failure' return
82− failure' :: (MonadFailure SomeException m, Exception e) => e -> m a
83− failure' = failure . SomeException
84−
85−objectToEvents :: RawObject -> [Event]
96+ events <- withParser (convertSuccess bs) parserParse
97+ return $ liftM eventsToTextObject events
98+
99+objectToEvents :: TextObject -> [Event]
86100objectToEvents y = concat
87101 [ [EventStreamStart, EventDocumentStart]
88102 , writeSingle y
89103 , [EventDocumentEnd, EventStreamEnd]] where
90− writeSingle :: RawObject -> [Event]
91− writeSingle (Scalar (Raw bs)) = [EventScalar $ toStrictByteString bs]
104+ writeSingle :: TextObject -> [Event]
105+ writeSingle (Scalar text) = [EventScalar $ convertSuccess text]
92106 writeSingle (Sequence ys) =
93107 (EventSequenceStart : concatMap writeSingle ys)
94108 ++ [EventSequenceEnd]
95109 writeSingle (Mapping pairs) =
96110 EventMappingStart : concatMap writePair pairs ++ [EventMappingEnd]
97− writePair :: (Raw, RawObject) -> [Event]
98− writePair (Raw k, v) = EventScalar (fromLazyByteString k) : writeSingle v
111+ writePair :: (Text, TextObject) -> [Event]
112+ writePair (k, v) = EventScalar (convertSuccess k) : writeSingle v
99113
100−eventsToRawObject :: [Event] -> RawObject
101−eventsToRawObject = fst . readSingle . dropWhile isIgnored where
114+eventsToTextObject :: [Event] -> TextObject
115+eventsToTextObject = fst . readSingle . dropWhile isIgnored where
102116 isIgnored EventAlias = False
103117 isIgnored (EventScalar _) = False
104118 isIgnored EventSequenceStart = False
@@ -106,37 +120,40 @@ eventsToRawObject = fst . readSingle . dropWhile isIgnored where
106120 isIgnored EventMappingStart = False
107121 isIgnored EventMappingEnd = False
108122 isIgnored _ = True
109− readSingle :: [Event] -> (RawObject, [Event])
123+ readSingle :: [Event] -> (TextObject, [Event])
110124 readSingle [] = error "readSingle: no more events"
111125 readSingle (EventScalar bs:rest) =
112− (Scalar $ Raw $ toLazyByteString bs, rest)
126+ (Scalar $ convertSuccess bs, rest)
113127 readSingle (EventSequenceStart:rest) = readList [] rest
114128 readSingle (EventMappingStart:rest) = readMap [] rest
115129 readSingle (x:_) = error $ "readSingle: " ++ show x
116− readList :: [RawObject] -> [Event] -> (RawObject, [Event])
130+ readList :: [TextObject] -> [Event] -> (TextObject, [Event])
117131 readList nodes (EventSequenceEnd:rest) =
118132 (Sequence $ reverse nodes, rest)
119133 readList nodes events =
120134 let (next, rest) = readSingle events
121135 in readList (next : nodes) rest
122− readMap :: [(B.ByteString, RawObject)]
136+ readMap :: [(B.ByteString, TextObject)]
123137 -> [Event]
124− -> (RawObject, [Event])
138+ -> (TextObject, [Event])
125139 readMap pairs (EventMappingEnd:rest) =
126− (Mapping $ map (first $ Raw . toLazyByteString) $ reverse pairs, rest)
140+ (Mapping $ map (first convertSuccess) $ reverse pairs, rest)
127141 readMap pairs (EventScalar bs:events) =
128142 let (next, rest) = readSingle events
129− in readMap ((fromStrictByteString bs, next) : pairs) rest
143+ in readMap ((bs, next) : pairs) rest
130144 readMap _ (e:_) = error $ "Unexpected event in readMap: " ++ show e
131145 readMap _ [] = error "Unexpected empty event list in readMap"
132146
133147newtype MyString = MyString String
134148 deriving (Eq, Show)
135−instance ToScalar MyString Raw where
136− toScalar (MyString s) = toScalar s
137−instance FromScalar MyString Raw where
138− fromScalar raw = MyString `liftM` fromScalar raw
139−
149+instance ConvertAttempt MyString Text where
150+ convertAttempt = return . convertSuccess
151+instance ConvertSuccess MyString Text where
152+ convertSuccess (MyString s) = convertSuccess s
153+instance ConvertAttempt Text MyString where
154+ convertAttempt raw = MyString `liftM` convertAttempt raw
155+
156+#if TEST
140157propEncodeDecode :: Object MyString MyString -> Bool
141158propEncodeDecode o = fromAttempt (decode (encode o :: B.ByteString))
142159 == Just o
@@ -174,3 +191,4 @@ instance Arbitrary MyString where
174191 size <- arbitrary
175192 s <- replicateM (size `mod` 5) $ elements ['A'..'Z']
176193 return $! MyString s
194+#endif