git.iko.soy/typeable/yaml
on master help sign in
Fixed memory leak error.
4e92566Michael Snoyman
Text/Yaml.hs+28−23
compare with master
unifiedsplit
@@ -43,7 +43,6 @@ module Text.Yaml
43import Prelude hiding (readList)
43import Prelude hiding (readList)
44import Text.Libyaml
44import Text.Libyaml
45import qualified Data.ByteString as B
45import qualified Data.ByteString as B
46−import qualified Data.ByteString.Lazy as BL
47import Data.Object
46import Data.Object
48import Data.Object.Text
47import Data.Object.Text
49import Data.Object.Scalar
48import Data.Object.Scalar
@@ -55,8 +54,6 @@ import Data.Convertible
55import Data.Attempt
54import Data.Attempt
56
55
57import Data.Text.Lazy (Text)
56import Data.Text.Lazy (Text)
58−import qualified Data.Text.Lazy as LT
59−import qualified Data.Text.Lazy.Encoding as LTE
60
57
61#if TEST
58#if TEST
62import Test.Framework (testGroup, Test)
59import Test.Framework (testGroup, Test)
@@ -67,23 +64,23 @@ import Test.QuickCheck
67
64
68import Control.Monad (replicateM)
65import Control.Monad (replicateM)
69import Control.Arrow ((***))
66import Control.Arrow ((***))
67+import qualified Data.Text.Lazy as LT
68+import qualified Data.ByteString.Lazy as BL
70#endif
69#endif
71
70
72-- Low level, non-exported functions
71-- Low level, non-exported functions
73−encode' :: (ConvertSuccess B.ByteString a, MonadFailure YamlException m)
72+encode' :: MonadFailure YamlException m
74 => TextObject
73 => TextObject
75− -> IO (m a)
74+ -> IO (m B.ByteString)
76encode' o = do
75encode' o = do
77 let events = objectToEvents o
76 let events = objectToEvents o
78 result <- withEmitter $ flip emitEvents events
77 result <- withEmitter $ flip emitEvents events
79 return $ do
78 return $ do
80 result' <- result
79 result' <- result
81− return $ convertSuccess result'
80+ return result'
82
81
83−decode' :: (ConvertSuccess a B.ByteString,
84− MonadFailure YamlException m
82+decode' :: MonadFailure YamlException m
85− )
83+ => B.ByteString
86− => a
87 -> IO (m TextObject)
84 -> IO (m TextObject)
88decode' bs = do
85decode' bs = do
89 events <- withParser (convertSuccess bs) parserParse
86 events <- withParser (convertSuccess bs) parserParse
@@ -91,21 +88,23 @@ decode' bs = do
91
88
92-- Text API
89-- Text API
93-- FIXME: this *should* be in a MonadFailure
90-- FIXME: this *should* be in a MonadFailure
91+
92+-- FIXME: I think the To and From below are backwards. Maybe just say convert?
94encodeText :: ConvertSuccess B.ByteString a
93encodeText :: ConvertSuccess B.ByteString a
95 => TextObject
94 => TextObject
96 -> a
95 -> a
97−encodeText = unsafePerformIO . join . encode'
96+encodeText = convertSuccess . unsafePerformIO . join . encode'
98
97
99encodeToText :: (ConvertSuccess B.ByteString a, ToObject x Text Text)
98encodeToText :: (ConvertSuccess B.ByteString a, ToObject x Text Text)
100 => x
99 => x
101 -> a
100 -> a
102−encodeToText = unsafePerformIO . join . encode' . toTextObject
101+encodeToText = convertSuccess . unsafePerformIO . join . encode' . toTextObject
103
102
104decodeText :: (ConvertSuccess a B.ByteString,
103decodeText :: (ConvertSuccess a B.ByteString,
105 MonadFailure YamlException m)
104 MonadFailure YamlException m)
106 => a
105 => a
107 -> m TextObject
106 -> m TextObject
108−decodeText = unsafePerformIO . decode'
107+decodeText = unsafePerformIO . decode' . convertSuccess
109
108
110decodeFromText :: (ConvertSuccess a B.ByteString,
109decodeFromText :: (ConvertSuccess a B.ByteString,
111 FromObject x Text Text)
110 FromObject x Text Text)
@@ -127,13 +126,13 @@ decodeFromTextWrap a = decodeText a >>= fromObjectWrap
127encodeScalar :: ConvertSuccess B.ByteString a
126encodeScalar :: ConvertSuccess B.ByteString a
128 => ScalarObject
127 => ScalarObject
129 -> a
128 -> a
130−encodeScalar = unsafePerformIO . join . encode' . toTextObject
129+encodeScalar = convertSuccess . unsafePerformIO . join . encode' . toTextObject
131
130
132decodeScalar :: (ConvertSuccess a B.ByteString,
131decodeScalar :: (ConvertSuccess a B.ByteString,
133 MonadFailure YamlException m)
132 MonadFailure YamlException m)
134 => a
133 => a
135 -> m ScalarObject
134 -> m ScalarObject
136−decodeScalar = liftM toScalarObject . unsafePerformIO . decode'
135+decodeScalar = liftM toScalarObject . unsafePerformIO . decode' . convertSuccess
137
136
138-- File API
137-- File API
139encodeFile :: (MonadIO m, MonadFailure YamlException m)
138encodeFile :: (MonadIO m, MonadFailure YamlException m)
@@ -143,7 +142,7 @@ encodeFile :: (MonadIO m, MonadFailure YamlException m)
143encodeFile path o = do
142encodeFile path o = do
144 content <- liftIO $ encode' o
143 content <- liftIO $ encode' o
145 content' <- content
144 content' <- content
146− liftIO $ ltWriteFile path content'
145+ liftIO $ B.writeFile path content'
147
146
148encodeFileToText :: (ToObject x Text Text,
147encodeFileToText :: (ToObject x Text Text,
149 MonadIO m,
148 MonadIO m,
@@ -154,20 +153,14 @@ encodeFileToText :: (ToObject x Text Text,
154 -> m ()
153 -> m ()
155encodeFileToText fp = encodeFile fp . toTextObject
154encodeFileToText fp = encodeFile fp . toTextObject
156
155
157−ltWriteFile :: FilePath -> Text -> IO ()
158−ltWriteFile fp = BL.writeFile fp . LTE.encodeUtf8
159−
160decodeFile :: (MonadFailure YamlException m,
156decodeFile :: (MonadFailure YamlException m,
161 MonadIO m)
157 MonadIO m)
162 => FilePath
158 => FilePath
163 -> m TextObject
159 -> m TextObject
164decodeFile path = do
160decodeFile path = do
165− contents <- liftIO (ltReadFile path)
161+ contents <- liftIO $ B.readFile path
166 join $ liftIO $ decode' contents
162 join $ liftIO $ decode' contents
167
163
168−ltReadFile :: FilePath -> IO Text
169−ltReadFile = fmap LTE.decodeUtf8 . BL.readFile
170−
171decodeFileFromTextWrap :: (MonadFailure YamlException m,
164decodeFileFromTextWrap :: (MonadFailure YamlException m,
172 MonadFailure FromObjectException m,
165 MonadFailure FromObjectException m,
173 MonadIO m,
166 MonadIO m,
@@ -275,10 +268,22 @@ caseEmptyStrings = do
275 test' m'
268 test' m'
276 test' m''
269 test' m''
277
270
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+
278testSuite :: Test
282testSuite :: Test
279testSuite = testGroup "Text.Yaml"
283testSuite = testGroup "Text.Yaml"
280 [ testProperty "propEncodeDecode" propEncodeDecode
284 [ testProperty "propEncodeDecode" propEncodeDecode
281 , testCase "empty strings" caseEmptyStrings
285 , testCase "empty strings" caseEmptyStrings
286+ , testCase "encode large objects" caseLargeObjects
282 ]
287 ]
283
288
284instance Arbitrary (Object MyString MyString) where
289instance Arbitrary (Object MyString MyString) where