@@ -17,10 +17,15 @@
1717---------------------------------------------------------
1818
1919module Text.Yaml
20− ( module Data.Object
21− , encode
20+ (
21+ -- * Converting to/from 'TextObject's
22+ encodeText
23+ , decodeText
24+ -- * Convert to/from 'ScalarObejct's
25+ , encodeScalar
26+ , decodeScalar
27+ -- * Files
2228 , encodeFile
23− , decode
2429 , decodeFile
2530#if TEST
2631 , testSuite
@@ -33,6 +38,7 @@ import qualified Data.ByteString as B
3338import qualified Data.ByteString.Lazy as BL
3439import Data.Object
3540import Data.Object.Text
41+import Data.Object.Scalar
3642import System.IO.Unsafe
3743import Control.Arrow (first)
3844import Control.Monad (liftM, join)
@@ -50,19 +56,56 @@ import Test.Framework.Providers.HUnit
5056import Test.Framework.Providers.QuickCheck (testProperty)
5157import Test.HUnit hiding (Test, path)
5258import Test.QuickCheck
59+
60+import Control.Monad (replicateM)
61+import Control.Arrow ((***))
5362#endif
5463
55−encode :: (ConvertSuccess B.ByteString a, ToObject o Text Text) => o -> a
56−encode = unsafePerformIO . encode'
64+-- Low level, non-exported functions
65+encode' :: ConvertSuccess B.ByteString a
66+ => TextObject
67+ -> IO a
68+encode' o =
69+ let events = objectToEvents o
70+ result = withEmitter $ flip emitEvents events
71+ in convertSuccess `fmap` joinAttempt result
5772
58−decode :: (ConvertSuccess a B.ByteString,
59− MonadFailure YamlException m)
60− => a
61− -> m TextObject
62−decode = unsafePerformIO . decode'
73+decode' :: (ConvertSuccess a B.ByteString,
74+ MonadFailure YamlException m
75+ )
76+ => a
77+ -> IO (m TextObject)
78+decode' bs = do
79+ events <- withParser (convertSuccess bs) parserParse
80+ return $ liftM eventsToTextObject events
81+
82+-- Text API
83+encodeText :: ConvertSuccess B.ByteString a
84+ => TextObject
85+ -> a
86+encodeText = unsafePerformIO . encode'
87+
88+decodeText :: (ConvertSuccess a B.ByteString,
89+ MonadFailure YamlException m)
90+ => a
91+ -> m TextObject
92+decodeText = unsafePerformIO . decode'
93+
94+-- Scalar API
95+encodeScalar :: ConvertSuccess B.ByteString a
96+ => ScalarObject
97+ -> a
98+encodeScalar = unsafePerformIO . encode' . toTextObject
99+
100+decodeScalar :: (ConvertSuccess a B.ByteString,
101+ MonadFailure YamlException m)
102+ => a
103+ -> m ScalarObject
104+decodeScalar = liftM toScalarObject . unsafePerformIO . decode'
63105
106+-- File API
64107encodeFile :: ToObject o Text Text => FilePath -> o -> IO ()
65−encodeFile path o = encode' o >>= ltWriteFile path
108+encodeFile path o = encode' (toTextObject o) >>= ltWriteFile path
66109
67110ltWriteFile :: FilePath -> Text -> IO ()
68111ltWriteFile fp = BL.writeFile fp . LTE.encodeUtf8
@@ -78,24 +121,7 @@ decodeFile path = do
78121ltReadFile :: FilePath -> IO Text
79122ltReadFile = fmap LTE.decodeUtf8 . BL.readFile
80123
81−encode' :: (ConvertSuccess B.ByteString a,
82− ToObject o Text Text)
83− => o
84− -> IO a
85−encode' o =
86− let events = objectToEvents $ toObject o
87− result = withEmitter $ flip emitEvents events
88− in convertSuccess `fmap` joinAttempt result
89−
90−decode' :: (ConvertSuccess a B.ByteString,
91− MonadFailure YamlException m
92− )
93− => a
94− -> IO (m TextObject)
95−decode' bs = do
96− events <- withParser (convertSuccess bs) parserParse
97− return $ liftM eventsToTextObject events
98−
124+-- The real worker functions
99125objectToEvents :: TextObject -> [Event]
100126objectToEvents y = concat
101127 [ [EventStreamStart, EventDocumentStart]
@@ -144,6 +170,7 @@ eventsToTextObject = fst . readSingle . dropWhile isIgnored where
144170 readMap _ (e:_) = error $ "Unexpected event in readMap: " ++ show e
145171 readMap _ [] = error "Unexpected empty event list in readMap"
146172
173+#if TEST
147174newtype MyString = MyString String
148175 deriving (Eq, Show)
149176instance ConvertAttempt MyString Text where
@@ -151,12 +178,53 @@ instance ConvertAttempt MyString Text where
151178instance ConvertSuccess MyString Text where
152179 convertSuccess (MyString s) = convertSuccess s
153180instance ConvertAttempt Text MyString where
154− convertAttempt raw = MyString `liftM` convertAttempt raw
181+ convertAttempt = return . convertSuccess
182+instance ConvertSuccess Text MyString where
183+ convertSuccess = MyString . convertSuccess
184+
185+myEquals :: Eq v => Attempt v -> Attempt v -> Bool
186+myEquals (Success v1) (Success v2) = v1 == v2
187+myEquals _ _ = False
188+
189+instance ConvertSuccess B.ByteString B.ByteString where -- FIXME belongs elsewhere
190+ convertSuccess = id
191+instance ConvertAttempt B.ByteString B.ByteString where -- FIXME belongs elsewhere
192+ convertAttempt = return
155193
156−#if TEST
157194propEncodeDecode :: Object MyString MyString -> Bool
158−propEncodeDecode o = fromAttempt (decode (encode o :: B.ByteString))
159− == Just o
195+propEncodeDecode o =
196+ fmap h2 (decodeText (encodeText (h1 o) :: B.ByteString))
197+ `myEquals` Success o
198+ where
199+ h1 = mapKeysValues convertSuccess convertSuccess
200+ h2 = mapKeysValues convertSuccess convertSuccess
201+
202+toSBS :: ConvertSuccess a B.ByteString => a -> B.ByteString
203+toSBS = convertSuccess
204+
205+toLBS :: ConvertSuccess a BL.ByteString => a -> BL.ByteString
206+toLBS = convertSuccess
207+
208+instance ToObject (Object Text Text) Text Text where -- FIXME belongs elsewhere
209+ toObject = id
210+
211+instance ConvertSuccess B.ByteString [Char] where -- FIXME belongs elsewhere
212+ convertSuccess = convertSuccess . (convertSuccess :: B.ByteString -> Text)
213+instance ConvertAttempt B.ByteString [Char] where -- FIXME belongs elsewhere
214+ convertAttempt = return . convertSuccess
215+instance ConvertSuccess [Char] B.ByteString where -- FIXME belongs elsewhere
216+ convertSuccess = convertSuccess . (convertSuccess :: String -> Text)
217+instance ConvertAttempt [Char] B.ByteString where -- FIXME belongs elsewhere
218+ convertAttempt = return . convertSuccess
219+
220+instance ConvertSuccess BL.ByteString [Char] where -- FIXME belongs elsewhere
221+ convertSuccess = convertSuccess . (convertSuccess :: BL.ByteString -> Text)
222+instance ConvertAttempt BL.ByteString [Char] where -- FIXME belongs elsewhere
223+ convertAttempt = return . convertSuccess
224+instance ConvertSuccess [Char] BL.ByteString where -- FIXME belongs elsewhere
225+ convertSuccess = convertSuccess . (convertSuccess :: String -> Text)
226+instance ConvertAttempt [Char] BL.ByteString where -- FIXME belongs elsewhere
227+ convertAttempt = return . convertSuccess
160228
161229caseEmptyStrings :: Assertion
162230caseEmptyStrings = do
@@ -165,9 +233,14 @@ caseEmptyStrings = do
165233 , ("baz", "")
166234 , ("bin", "")
167235 ]
168− let m' = map (toStrictByteString *** toStrictByteString) m
169− let m'' = map (toLazyByteString *** toLazyByteString) m
170− let test' x = Just x @=? fromAttempt (decode (encode x :: String))
236+ let m' = map (toSBS *** toSBS) m
237+ let m'' = map (toLBS *** toLBS) m
238+ let test' :: (ToObject x Text Text, FromObject x Text Text, Eq x, Show x)
239+ => x
240+ -> Assertion
241+ test' x = Just x @=?
242+ fa (decodeText (encodeText (toTextObject x) :: String)
243+ >>= fromTextObject)
171244 test' m
172245 test' m'
173246 test' m''