@@ -43,7 +43,6 @@ module Text.Yaml
4343import Prelude hiding (readList)
4444import Text.Libyaml
4545import qualified Data.ByteString as B
46−import qualified Data.ByteString.Lazy as BL
4746import Data.Object
4847import Data.Object.Text
4948import Data.Object.Scalar
@@ -55,8 +54,6 @@ import Data.Convertible
5554import Data.Attempt
5655
5756import Data.Text.Lazy (Text)
58−import qualified Data.Text.Lazy as LT
59−import qualified Data.Text.Lazy.Encoding as LTE
6057
6158#if TEST
6259import Test.Framework (testGroup, Test)
@@ -67,23 +64,23 @@ import Test.QuickCheck
6764
6865import Control.Monad (replicateM)
6966import Control.Arrow ((***))
67+import qualified Data.Text.Lazy as LT
68+import qualified Data.ByteString.Lazy as BL
7069#endif
7170
7271-- Low level, non-exported functions
73−encode' :: (ConvertSuccess B.ByteString a, MonadFailure YamlException m)
72+encode' :: MonadFailure YamlException m
7473 => TextObject
75− -> IO (m a)
74+ -> IO (m B.ByteString)
7675encode' o = do
7776 let events = objectToEvents o
7877 result <- withEmitter $ flip emitEvents events
7978 return $ do
8079 result' <- result
81− return $ convertSuccess result'
80+ return result'
8281
83−decode' :: (ConvertSuccess a B.ByteString,
84− MonadFailure YamlException m
85− )
86− => a
82+decode' :: MonadFailure YamlException m
83+ => B.ByteString
8784 -> IO (m TextObject)
8885decode' bs = do
8986 events <- withParser (convertSuccess bs) parserParse
@@ -91,21 +88,23 @@ decode' bs = do
9188
9289-- Text API
9390-- FIXME: this *should* be in a MonadFailure
91+
92+-- FIXME: I think the To and From below are backwards. Maybe just say convert?
9493encodeText :: ConvertSuccess B.ByteString a
9594 => TextObject
9695 -> a
97−encodeText = unsafePerformIO . join . encode'
96+encodeText = convertSuccess . unsafePerformIO . join . encode'
9897
9998encodeToText :: (ConvertSuccess B.ByteString a, ToObject x Text Text)
10099 => x
101100 -> a
102−encodeToText = unsafePerformIO . join . encode' . toTextObject
101+encodeToText = convertSuccess . unsafePerformIO . join . encode' . toTextObject
103102
104103decodeText :: (ConvertSuccess a B.ByteString,
105104 MonadFailure YamlException m)
106105 => a
107106 -> m TextObject
108−decodeText = unsafePerformIO . decode'
107+decodeText = unsafePerformIO . decode' . convertSuccess
109108
110109decodeFromText :: (ConvertSuccess a B.ByteString,
111110 FromObject x Text Text)
@@ -127,13 +126,13 @@ decodeFromTextWrap a = decodeText a >>= fromObjectWrap
127126encodeScalar :: ConvertSuccess B.ByteString a
128127 => ScalarObject
129128 -> a
130−encodeScalar = unsafePerformIO . join . encode' . toTextObject
129+encodeScalar = convertSuccess . unsafePerformIO . join . encode' . toTextObject
131130
132131decodeScalar :: (ConvertSuccess a B.ByteString,
133132 MonadFailure YamlException m)
134133 => a
135134 -> m ScalarObject
136−decodeScalar = liftM toScalarObject . unsafePerformIO . decode'
135+decodeScalar = liftM toScalarObject . unsafePerformIO . decode' . convertSuccess
137136
138137-- File API
139138encodeFile :: (MonadIO m, MonadFailure YamlException m)
@@ -143,7 +142,7 @@ encodeFile :: (MonadIO m, MonadFailure YamlException m)
143142encodeFile path o = do
144143 content <- liftIO $ encode' o
145144 content' <- content
146− liftIO $ ltWriteFile path content'
145+ liftIO $ B.writeFile path content'
147146
148147encodeFileToText :: (ToObject x Text Text,
149148 MonadIO m,
@@ -154,20 +153,14 @@ encodeFileToText :: (ToObject x Text Text,
154153 -> m ()
155154encodeFileToText fp = encodeFile fp . toTextObject
156155
157−ltWriteFile :: FilePath -> Text -> IO ()
158−ltWriteFile fp = BL.writeFile fp . LTE.encodeUtf8
159−
160156decodeFile :: (MonadFailure YamlException m,
161157 MonadIO m)
162158 => FilePath
163159 -> m TextObject
164160decodeFile path = do
165− contents <- liftIO (ltReadFile path)
161+ contents <- liftIO $ B.readFile path
166162 join $ liftIO $ decode' contents
167163
168−ltReadFile :: FilePath -> IO Text
169−ltReadFile = fmap LTE.decodeUtf8 . BL.readFile
170−
171164decodeFileFromTextWrap :: (MonadFailure YamlException m,
172165 MonadFailure FromObjectException m,
173166 MonadIO m,
@@ -275,10 +268,22 @@ caseEmptyStrings = do
275268 test' m'
276269 test' m''
277270
271+caseLargeObjects :: Assertion
272+caseLargeObjects = do
273+ let level3 = toTextObject (convertSuccess "X" :: Text)
274+ level2 = toTextObject $ replicate 10000 level3
275+ level1 = toTextObject $ zip (map (: []) ['A'..'Z']) $ repeat level2
276+ decoded :: Maybe TextObject
277+ decoded = decodeText $ (encodeText level1 :: Text)
278+ assertEqual "encode/decode identity" decoded $ Just level1
279+ putStrLn "encoding the file..."
280+ encodeFile "test.yaml" level1
281+
278282testSuite :: Test
279283testSuite = testGroup "Text.Yaml"
280284 [ testProperty "propEncodeDecode" propEncodeDecode
281285 , testCase "empty strings" caseEmptyStrings
286+ , testCase "encode large objects" caseLargeObjects
282287 ]
283288
284289instance Arbitrary (Object MyString MyString) where