git.iko.soy/typeable/yaml
on master help sign in
Rework as data-object-yaml
33c1061Michael Snoyman
Data/Object/Yaml.hs+171−93
compare with master
unifiedsplit
@@ -3,14 +3,16 @@
3{-# LANGUAGE MultiParamTypeClasses #-}
3{-# LANGUAGE MultiParamTypeClasses #-}
4{-# LANGUAGE DeriveDataTypeable #-}
4{-# LANGUAGE DeriveDataTypeable #-}
5{-# LANGUAGE TypeSynonymInstances #-}
5{-# LANGUAGE TypeSynonymInstances #-}
6+{-# LANGUAGE CPP #-}
6module Data.Object.Yaml
7module Data.Object.Yaml
7− ( -- * The event stream
8+ ( -- * 'YamlDoc' definition and IO
8− Event (..)
9+ YamlDoc (..)
9− , Style (..)
10+ , readYamlDoc
10− , Tag (..)
11+ , writeYamlDoc
11 -- * 'YamlObject' definition
12 -- * 'YamlObject' definition
12− , YamlDoc (..)
13 , YamlScalar (..)
13 , YamlScalar (..)
14+ , Tag (..)
15+ , Style (..)
14 , YamlObject
16 , YamlObject
15 -- * Performing conversions
17 -- * Performing conversions
16 , eventsToYamlObject
18 , eventsToYamlObject
@@ -18,80 +20,53 @@ module Data.Object.Yaml
18 , YamlException (..)
20 , YamlException (..)
19 -- * Re-export
21 -- * Re-export
20 , module Data.Object.Base
22 , module Data.Object.Base
23+#if TEST
24+ , testSuite
25+#endif
21 ) where
26 ) where
22
27
23import Data.ByteString (ByteString)
28import Data.ByteString (ByteString)
29+import qualified Data.ByteString as B
24import Data.Object.Base
30import Data.Object.Base
25import Data.Object.Text
31import Data.Object.Text
26−import Data.Object.Scalar
27import Data.Convertible.Text
32import Data.Convertible.Text
28import Data.Attempt
33import Data.Attempt
29
34
30−import Data.Typeable (Typeable)
35+import Data.Object.Yaml.Internal
36+import Data.Object.Yaml.Lib
31−import Control.Exception (Exception)
37+import Control.Monad ((<=<), join)
32−
38+import System.IO.Unsafe
33−data Event =
39+
34− EventNone
40+#if TEST
35− | EventStreamStart
41+import Data.Object
36− | EventStreamEnd
42+import Test.Framework (testGroup, Test)
37− | EventDocumentStart
43+import Test.Framework.Providers.HUnit
38− | EventDocumentEnd
44+import Test.Framework.Providers.QuickCheck (testProperty)
39− | EventAlias
45+import Test.HUnit hiding (Test, path)
40− | EventScalar ByteString Tag Style
46+import Test.QuickCheck
41− | EventSequenceStart
42− | EventSequenceEnd
43− | EventMappingStart
44− | EventMappingEnd
45− deriving (Show, Eq)
46
47
47−data Style = Any
48+import Control.Monad (replicateM)
48− | Plain
49+import qualified Data.Text.Lazy as LT
49− | SingleQuoted
50+import qualified Data.ByteString.Lazy as BL
50− | DoubleQuoted
51+import qualified Data.ByteString as B
51− | Literal
52+import Data.Attempt
52− | Folded
53+import Control.Arrow ((***))
53− deriving (Show, Eq, Enum, Bounded, Ord)
54+#endif
54−
55−data Tag = StrTag
56− | FloatTag
57− | NullTag
58− | BoolTag
59− | SetTag
60− | IntTag
61− | SeqTag
62− | MapTag
63− | UriTag String
64− | NoTag
65− deriving Eq
66−instance Show Tag where
67− show StrTag = "tag:yaml.org,2002:str"
68− show FloatTag = "tag:yaml.org,2002:float"
69− show NullTag = "tag:yaml.org,2002:null"
70− show BoolTag = "tag:yaml.org,2002:bool"
71− show SetTag = "tag:yaml.org,2002:set"
72− show IntTag = "tag:yaml.org,2002:int"
73− show SeqTag = "tag:yaml.org,2002:seq"
74− show MapTag = "tag:yaml.org,2002:map"
75− show (UriTag s) = s
76− show NoTag = ""
77−instance ConvertSuccess Tag [Char] where
78− convertSuccess = show
79−instance ConvertSuccess ByteString Tag where
80− convertSuccess = (convertSuccess :: String -> Tag)
81− . convertSuccess
82−instance ConvertSuccess [Char] Tag where
83− convertSuccess "tag:yaml.org,2002:str" = StrTag
84− convertSuccess "tag:yaml.org,2002:float" = FloatTag
85− convertSuccess "tag:yaml.org,2002:null" = NullTag
86− convertSuccess "tag:yaml.org,2002:bool" = BoolTag
87− convertSuccess "tag:yaml.org,2002:set" = SetTag
88− convertSuccess "tag:yaml.org,2002:int" = IntTag
89− convertSuccess "tag:yaml.org,2002:seq" = SeqTag
90− convertSuccess "tag:yaml.org,2002:map" = MapTag
91− convertSuccess "" = NoTag
92− convertSuccess s = UriTag s
93
55
94newtype YamlDoc = YamlDoc { unYamlDoc :: ByteString }
56newtype YamlDoc = YamlDoc { unYamlDoc :: ByteString }
57+instance ConvertSuccess [Event] YamlDoc where
58+ -- Note: the join here will swallow up 'YamlException's.
59+ -- However, these should never occur, as that would imply an error
60+ -- in the C library or bindings.
61+ convertSuccess = YamlDoc . unsafePerformIO . join . encode
62+instance ConvertAttempt YamlDoc [Event] where
63+ convertAttempt = unsafePerformIO . decode . unYamlDoc
64+
65+readYamlDoc :: FilePath -> IO YamlDoc
66+readYamlDoc = fmap YamlDoc . B.readFile
67+
68+writeYamlDoc :: FilePath -> YamlDoc -> IO ()
69+writeYamlDoc fp = B.writeFile fp . unYamlDoc
95
70
96data YamlScalar = YamlScalar
71data YamlScalar = YamlScalar
97 { value :: ByteString
72 { value :: ByteString
@@ -102,9 +77,9 @@ data YamlScalar = YamlScalar
102instance ConvertSuccess YamlScalar Event where
77instance ConvertSuccess YamlScalar Event where
103 convertSuccess (YamlScalar v t s) = EventScalar v (convertSuccess t) s
78 convertSuccess (YamlScalar v t s) = EventScalar v (convertSuccess t) s
104
79
105−instance ConvertSuccess YamlScalar [Char] where
80+instance ConvertSuccess YamlScalar String where
106 convertSuccess = convertSuccess . value
81 convertSuccess = convertSuccess . value
107−instance ConvertSuccess [Char] YamlScalar where
82+instance ConvertSuccess String YamlScalar where
108 convertSuccess t = YamlScalar (convertSuccess t) NoTag Any
83 convertSuccess t = YamlScalar (convertSuccess t) NoTag Any
109
84
110instance ConvertSuccess YamlScalar Text where
85instance ConvertSuccess YamlScalar Text where
@@ -112,31 +87,16 @@ instance ConvertSuccess YamlScalar Text where
112instance ConvertSuccess Text YamlScalar where
87instance ConvertSuccess Text YamlScalar where
113 convertSuccess t = YamlScalar (convertSuccess t) NoTag Any
88 convertSuccess t = YamlScalar (convertSuccess t) NoTag Any
114
89
115−-- FIXME the following are incredibly stupid conversions which ignore tag
90+-- FIXME add Scalar instances
116−-- and style information.
91+{-
117instance ConvertSuccess YamlScalar Scalar where
92instance ConvertSuccess YamlScalar Scalar where
118 convertSuccess = Text . convertSuccess
93 convertSuccess = Text . convertSuccess
119instance ConvertSuccess Scalar YamlScalar where
94instance ConvertSuccess Scalar YamlScalar where
120 convertSuccess s = convertSuccess (convertSuccess s :: Text)
95 convertSuccess s = convertSuccess (convertSuccess s :: Text)
96+-}
121
97
122type YamlObject = Object YamlScalar YamlScalar
98type YamlObject = Object YamlScalar YamlScalar
123
99
124−data YamlException =
125− YamlParserException
126− { parserProblem :: String
127− , parserContext :: String
128− , parserOffset :: Int
129− }
130− | YamlEmitterException { emitterProblem :: String }
131− | YamlOutOfMemory
132− | YamlInvalidEventStreamBeginning [Event]
133− | YamlInvalidEventStreamEnd [Event]
134− | YamlPrematureEventStreamEnd
135− | YamlNonScalarKey
136− | YamlInvalidStartingEvent Event
137− deriving (Show, Typeable)
138−instance Exception YamlException
139−
140-- Emit a YamlObject to an event stream
100-- Emit a YamlObject to an event stream
141instance ConvertSuccess YamlObject [Event] where
101instance ConvertSuccess YamlObject [Event] where
142 convertSuccess o = EventStreamStart
102 convertSuccess o = EventStreamStart
@@ -152,8 +112,15 @@ instance ConvertSuccess YamlObject [Event] where
152 : foldr ($) (EventMappingEnd : rest) (map helperPairs pairs)
112 : foldr ($) (EventMappingEnd : rest) (map helperPairs pairs)
153 helperPairs :: (YamlScalar, YamlObject) -> [Event] -> [Event]
113 helperPairs :: (YamlScalar, YamlObject) -> [Event] -> [Event]
154 helperPairs (k, v) rest = convertSuccess k : helper v rest
114 helperPairs (k, v) rest = convertSuccess k : helper v rest
115+instance ConvertSuccess YamlObject YamlDoc where
116+ convertSuccess = cs . (cs :: YamlObject -> [Event])
117+instance ConvertAttempt YamlDoc YamlObject where
118+ convertAttempt = ca <=< (ca :: YamlDoc -> Attempt [Event])
155
119
120+instance ConvertAttempt [Event] YamlObject where
121+ convertAttempt = eventsToYamlObject
122+
156−-- Parse a YamlObject from an event stream
123+-- | Parse a YamlObject from an event stream
157eventsToYamlObject :: MonadFailure YamlException m
124eventsToYamlObject :: MonadFailure YamlException m
158 => [Event]
125 => [Event]
159 -> m YamlObject
126 -> m YamlObject
@@ -204,12 +171,123 @@ eventsToYamlObject (EventStreamStart:EventDocumentStart:events) = h1 events
204 readMap (f . ((:) (key', val))) rest'
171 readMap (f . ((:) (key', val))) rest'
205eventsToYamlObject e = failure $ YamlInvalidEventStreamBeginning e
172eventsToYamlObject e = failure $ YamlInvalidEventStreamBeginning e
206
173
207−instance ConvertSuccess (Object YamlScalar YamlScalar) (Object Text Text) where
174+instance ConvertSuccess YamlObject TextObject where
175+ convertSuccess = mapKeysValues cs cs
176+instance ConvertSuccess TextObject YamlObject where
208− convertSuccess = mapKeysValues convertSuccess convertSuccess
177+ convertSuccess = mapKeysValues cs cs
209−instance ConvertSuccess (Object Text Text) (Object YamlScalar YamlScalar) where
178+instance ConvertSuccess TextObject YamlDoc where
210− convertSuccess = mapKeysValues convertSuccess convertSuccess
179+ convertSuccess = cs . (cs :: TextObject -> YamlObject)
180+instance ConvertAttempt YamlDoc TextObject where
181+ convertAttempt = fmap cs . (ca :: YamlDoc -> Attempt YamlObject)
211
182
183+{- FIXME
212instance ConvertSuccess (Object YamlScalar YamlScalar) (Object String Scalar) where
184instance ConvertSuccess (Object YamlScalar YamlScalar) (Object String Scalar) where
213 convertSuccess = mapKeysValues convertSuccess convertSuccess
185 convertSuccess = mapKeysValues convertSuccess convertSuccess
214instance ConvertSuccess (Object String Scalar) (Object YamlScalar YamlScalar) where
186instance ConvertSuccess (Object String Scalar) (Object YamlScalar YamlScalar) where
215 convertSuccess = mapKeysValues convertSuccess convertSuccess
187 convertSuccess = mapKeysValues convertSuccess convertSuccess
188+-}
189+
190+#if TEST
191+newtype MyString = MyString String
192+ deriving (Eq, Show)
193+instance ConvertSuccess MyString Text where
194+ convertSuccess (MyString s) = convertSuccess s
195+instance ConvertSuccess Text MyString where
196+ convertSuccess = MyString . convertSuccess
197+instance ConvertSuccess (Object Text Text) (Object MyString MyString) where
198+ convertSuccess = mapKeysValues convertSuccess convertSuccess
199+instance ConvertSuccess (Object MyString MyString) (Object Text Text) where
200+ convertSuccess = mapKeysValues convertSuccess convertSuccess
201+
202+myEquals :: Eq v => Attempt v -> Attempt v -> Bool
203+myEquals a1 a2
204+ | isSuccess a1 && isSuccess a2 = fromSuccess a1 == fromSuccess a2
205+ | otherwise = False
206+
207+propEncodeDecode :: Object MyString MyString -> Bool
208+propEncodeDecode o =
209+ let to :: TextObject
210+ to = cs o
211+ yd :: YamlDoc
212+ yd = cs to
213+ to' = ca yd
214+ in return to `myEquals` to'
215+
216+toSBS :: ConvertSuccess a ByteString => a -> ByteString
217+toSBS = convertSuccess
218+
219+toLBS :: ConvertSuccess a BL.ByteString => a -> BL.ByteString
220+toLBS = convertSuccess
221+
222+caseEmptyStrings :: Assertion
223+caseEmptyStrings = do
224+ let m =
225+ [ ("foo", "bar")
226+ , ("baz", "")
227+ , ("bin", "")
228+ ]
229+ let m' = map (toSBS *** toSBS) m
230+ let m'' = map (toLBS *** toLBS) m
231+ let test' :: (ConvertSuccess x TextObject,
232+ ConvertSuccess TextObject x,
233+ Eq x,
234+ Show x)
235+ => x
236+ -> Assertion
237+ test' x = do
238+ let to :: TextObject
239+ to = cs x
240+ yd :: YamlDoc
241+ yd = cs to
242+ to' :: Attempt TextObject
243+ to' = ca yd
244+ to'' <- fa to'
245+ to'' @?= to
246+ test' $ toTextObject m
247+ test' $ toTextObject m'
248+ test' $ toTextObject m''
249+
250+{-
251+-- FIXME remove the following
252+instance ToObject [(String, String)] Text Text where
253+ toObject = Mapping . map (cs *** toObject)
254+instance ToObject [(ByteString, ByteString)] Text Text where
255+ toObject = Mapping . map (cs *** toObject)
256+instance ToObject [(BL.ByteString, BL.ByteString)] Text Text where
257+ toObject = Mapping . map (cs *** toObject)
258+instance ToObject [(String, TextObject)] Text Text where
259+ toObject = Mapping . map (cs *** id)
260+-}
261+
262+caseLargeObjects :: Assertion
263+caseLargeObjects = do
264+ let level3 = toTextObject (convertSuccess "X" :: Text)
265+ level2 = toTextObject $ replicate 10000 level3
266+ level1 = toTextObject $ zip (map (: []) ['A'..'Z']) $ repeat level2
267+ decoded :: Maybe TextObject
268+ decoded = fa $ ca $ (cs level1 :: YamlDoc)
269+ assertEqual "encode/decode identity" decoded $ Just level1
270+ putStrLn "encoding the file..."
271+ writeYamlDoc "test.yaml" $ cs level1
272+
273+testSuite :: Test
274+testSuite = testGroup "Text.Yaml"
275+ [ testProperty "propEncodeDecode" propEncodeDecode
276+ , testCase "empty strings" caseEmptyStrings
277+ , testCase "encode large objects" caseLargeObjects
278+ ]
279+
280+instance Arbitrary (Object MyString MyString) where
281+ coarbitrary = undefined
282+ arbitrary = oneof [arbS, arbL, arbM] where
283+ arbS = Scalar `fmap` (arbitrary :: Gen MyString)
284+ arbL = Sequence `fmap` vector 1
285+ arbM = Mapping `fmap` vector 1
286+
287+instance Arbitrary MyString where
288+ coarbitrary = undefined
289+ arbitrary = do
290+ size <- arbitrary
291+ s <- replicateM (size `mod` 5) $ elements ['A'..'Z']
292+ return $! MyString s
293+#endif
Data/Object/Yaml/Internal.hsnew file+90
@@ -0,0 +1,90 @@
1+{-# LANGUAGE TypeSynonymInstances #-}
2+{-# LANGUAGE MultiParamTypeClasses #-}
3+{-# LANGUAGE DeriveDataTypeable #-}
4+module Data.Object.Yaml.Internal
5+ ( -- * The event stream
6+ Event (..)
7+ , Style (..)
8+ , Tag (..)
9+ -- * Exceptions
10+ , YamlException (..)
11+ ) where
12+
13+import Data.ByteString (ByteString)
14+import Control.Exception (Exception)
15+import Data.Typeable (Typeable)
16+import Data.Convertible.Text
17+
18+data Event =
19+ EventNone
20+ | EventStreamStart
21+ | EventStreamEnd
22+ | EventDocumentStart
23+ | EventDocumentEnd
24+ | EventAlias
25+ | EventScalar ByteString Tag Style
26+ | EventSequenceStart
27+ | EventSequenceEnd
28+ | EventMappingStart
29+ | EventMappingEnd
30+ deriving (Show, Eq)
31+
32+data Style = Any
33+ | Plain
34+ | SingleQuoted
35+ | DoubleQuoted
36+ | Literal
37+ | Folded
38+ deriving (Show, Eq, Enum, Bounded, Ord)
39+
40+data Tag = StrTag
41+ | FloatTag
42+ | NullTag
43+ | BoolTag
44+ | SetTag
45+ | IntTag
46+ | SeqTag
47+ | MapTag
48+ | UriTag String
49+ | NoTag
50+ deriving (Show, Eq)
51+instance ConvertSuccess Tag String where
52+ convertSuccess StrTag = "tag:yaml.org,2002:str"
53+ convertSuccess FloatTag = "tag:yaml.org,2002:float"
54+ convertSuccess NullTag = "tag:yaml.org,2002:null"
55+ convertSuccess BoolTag = "tag:yaml.org,2002:bool"
56+ convertSuccess SetTag = "tag:yaml.org,2002:set"
57+ convertSuccess IntTag = "tag:yaml.org,2002:int"
58+ convertSuccess SeqTag = "tag:yaml.org,2002:seq"
59+ convertSuccess MapTag = "tag:yaml.org,2002:map"
60+ convertSuccess (UriTag s) = s
61+ convertSuccess NoTag = ""
62+instance ConvertSuccess ByteString Tag where
63+ convertSuccess = (cs :: String -> Tag) . cs
64+instance ConvertSuccess String Tag where
65+ convertSuccess "tag:yaml.org,2002:str" = StrTag
66+ convertSuccess "tag:yaml.org,2002:float" = FloatTag
67+ convertSuccess "tag:yaml.org,2002:null" = NullTag
68+ convertSuccess "tag:yaml.org,2002:bool" = BoolTag
69+ convertSuccess "tag:yaml.org,2002:set" = SetTag
70+ convertSuccess "tag:yaml.org,2002:int" = IntTag
71+ convertSuccess "tag:yaml.org,2002:seq" = SeqTag
72+ convertSuccess "tag:yaml.org,2002:map" = MapTag
73+ convertSuccess "" = NoTag
74+ convertSuccess s = UriTag s
75+
76+data YamlException =
77+ YamlParserException
78+ { parserProblem :: String
79+ , parserContext :: String
80+ , parserOffset :: Int
81+ }
82+ | YamlEmitterException { emitterProblem :: String }
83+ | YamlOutOfMemory
84+ | YamlInvalidEventStreamBeginning [Event]
85+ | YamlInvalidEventStreamEnd [Event]
86+ | YamlPrematureEventStreamEnd
87+ | YamlNonScalarKey
88+ | YamlInvalidStartingEvent Event
89+ deriving (Show, Typeable)
90+instance Exception YamlException
Text/Libyaml.hs → Data/Object/Yaml/Lib.hsrenamed+17−5
@@ -6,12 +6,14 @@
6
6
7{-# INCLUDE <yaml.h> #-}
7{-# INCLUDE <yaml.h> #-}
8{-# INCLUDE <helper.h> #-}
8{-# INCLUDE <helper.h> #-}
9−module Text.Libyaml
9+module Data.Object.Yaml.Lib
10− ( YamlException (..)
11− , withEmitter
10+ ( withEmitter
12 , emitEvents
11 , emitEvents
13 , withParser
12 , withParser
14 , parserParse
13 , parserParse
14+ -- * Higher level functions
15+ , encode
16+ , decode
15 ) where
17 ) where
16
18
17import qualified Data.ByteString.Internal as B
19import qualified Data.ByteString.Internal as B
@@ -21,12 +23,12 @@ import Foreign.Ptr
21import Foreign.ForeignPtr
23import Foreign.ForeignPtr
22import Foreign.Marshal.Alloc
24import Foreign.Marshal.Alloc
23
25
24−import Control.Failure
26+import Data.Attempt -- exports failure
25
27
26import Data.Convertible.Text
28import Data.Convertible.Text
27import Control.Applicative
29import Control.Applicative
28
30
29−import Data.Object.Yaml hiding (style, value)
31+import Data.Object.Yaml.Internal
30import Control.Exception (throwIO)
32import Control.Exception (throwIO)
31
33
32data ParserStruct
34data ParserStruct
@@ -379,3 +381,13 @@ toEventRaw e f = withEventRaw $ \er -> do
379 EventAlias -> error "toEventRaw: EventAlias not supported"
381 EventAlias -> error "toEventRaw: EventAlias not supported"
380 EventNone -> error "toEventRaw: EventNone not supported"
382 EventNone -> error "toEventRaw: EventNone not supported"
381 f er
383 f er
384+
385+encode :: MonadFailure YamlException m
386+ => [Event]
387+ -> IO (m B.ByteString)
388+encode = withEmitter . flip emitEvents
389+
390+decode :: MonadFailure YamlException m
391+ => B.ByteString
392+ -> IO (m [Event])
393+decode bs = withParser bs parserParse
Text/Yaml.hsdeleted−278
@@ -1,278 +0,0 @@
1−{-# LANGUAGE FlexibleInstances #-}
2−{-# LANGUAGE FlexibleContexts #-}
3−{-# LANGUAGE MultiParamTypeClasses #-}
4−{-# LANGUAGE CPP #-}
5−{-# LANGUAGE PackageImports #-}
6−{-# LANGUAGE TypeSynonymInstances #-}
7−{-# OPTIONS_GHC -fno-warn-orphans #-}
8−---------------------------------------------------------
9−--
10−-- Module : Text.Yaml
11−-- Copyright : Michael Snoyman
12−-- License : BSD3
13−--
14−-- Maintainer : Michael Snoyman <michael@snoyman.com>
15−-- Stability : Stable
16−-- Portability : portable
17−--
18−-- Provides a user friendly interface for serializing Yaml data.
19−--
20−---------------------------------------------------------
21−
22−module Text.Yaml
23− (
24− -- * Exceptions
25− YamlException (..)
26− -- * 'YamlDoc's <-> file conversion
27− , YamlDoc (..)
28− , readYamlDoc
29− , writeYamlDoc
30− -- * Converting to/from 'YamlObject's
31− , encodeYaml'
32− , decodeYaml'
33− , encodeYaml
34− , decodeYaml
35− , decodeYamlSuccess
36− -- * Converting to/from 'TextObject's
37− , encodeText'
38− , decodeText'
39− , encodeText
40− , decodeText
41− , decodeTextSuccess
42− -- * Converting to/from 'ScalarObject's
43− , encodeScalar'
44− , decodeScalar'
45− , encodeScalar
46− , decodeScalar
47− , decodeScalarSuccess
48−#if TEST
49− , testSuite
50−#endif
51− ) where
52−
53−import Prelude hiding (readList)
54−import Text.Libyaml
55−import Data.ByteString (ByteString)
56−import qualified Data.ByteString as B
57−import System.IO.Unsafe
58−import Control.Monad (join)
59−import Data.Convertible.Text
60−import Data.Attempt
61−
62−import Data.Object.Text
63−import Data.Object.Scalar
64−import Data.Object.Yaml
65−
66−#if TEST
67−import Data.Object
68−import Test.Framework (testGroup, Test)
69−import Test.Framework.Providers.HUnit
70−import Test.Framework.Providers.QuickCheck (testProperty)
71−import Test.HUnit hiding (Test, path)
72−import Test.QuickCheck
73−
74−import Control.Monad (replicateM)
75−import qualified Data.Text.Lazy as LT
76−import qualified Data.ByteString.Lazy as BL
77−import qualified Data.ByteString as B
78−import Data.Attempt
79−import Control.Arrow ((***))
80−#endif
81−
82−readYamlDoc :: FilePath -> IO YamlDoc
83−readYamlDoc = fmap YamlDoc . B.readFile
84−
85−writeYamlDoc :: FilePath -> YamlDoc -> IO ()
86−writeYamlDoc fp = B.writeFile fp . unYamlDoc
87−
88−-- Low level, non-exported functions
89−encode' :: MonadFailure YamlException m
90− => YamlObject
91− -> IO (m ByteString)
92−encode' = withEmitter . flip emitEvents . convertSuccess
93−
94−decode' :: MonadFailure YamlException m
95− => ByteString
96− -> IO (m YamlObject)
97−decode' bs = do
98− events <- withParser bs parserParse
99− return $ events >>= eventsToYamlObject
100−
101−-- Convert to YamlObject directly
102−encodeYaml' :: YamlObject -> ByteString
103−encodeYaml' = unsafePerformIO . join . encode'
104−
105−decodeYaml' :: MonadFailure YamlException m => ByteString -> m YamlObject
106−decodeYaml' = unsafePerformIO . decode'
107−
108−instance ConvertSuccess YamlObject YamlDoc where
109− convertSuccess = YamlDoc . encodeYaml'
110−instance ConvertAttempt YamlDoc YamlObject where
111− convertAttempt = decodeYaml' . unYamlDoc
112−
113−-- Convert to YamlObject conversions
114−encodeYaml :: ConvertSuccess x YamlObject => x -> ByteString
115−encodeYaml = encodeYaml' . convertSuccess
116−
117−decodeYaml :: ( ConvertAttempt YamlObject x
118− , Failure ConversionException m
119− , MonadFailure YamlException m
120− )
121− => ByteString
122− -> m x
123−decodeYaml b = decodeYaml' b >>= convertAttemptWrap
124−
125−decodeYamlSuccess :: ( ConvertSuccess YamlObject x
126− , MonadFailure YamlException m
127− )
128− => ByteString
129− -> m x
130−decodeYamlSuccess = fmap convertSuccess . decodeYaml'
131−
132−-- TextObjects
133−encodeText' :: TextObject -> ByteString
134−encodeText' = encodeYaml
135−
136−decodeText' :: MonadFailure YamlException m => ByteString -> m TextObject
137−decodeText' = decodeYamlSuccess
138−
139−instance ConvertSuccess TextObject YamlDoc where
140− convertSuccess = YamlDoc . encodeText'
141−instance ConvertAttempt YamlDoc TextObject where
142− convertAttempt = decodeText' . unYamlDoc
143−
144−-- TextObject conversions
145−encodeText :: ConvertSuccess x TextObject => x -> ByteString
146−encodeText = encodeText' . convertSuccess
147−
148−decodeText :: ( MonadFailure YamlException m
149− , ConvertAttempt TextObject x
150− , Failure ConversionException m
151− )
152− => ByteString
153− -> m x
154−decodeText bs = decodeText' bs >>= convertAttemptWrap
155−
156−decodeTextSuccess :: ( MonadFailure YamlException m
157− , ConvertSuccess TextObject x
158− )
159− => ByteString
160− -> m x
161−decodeTextSuccess = fmap convertSuccess . decodeText'
162−
163−-- ScalarObjects
164−encodeScalar' :: ScalarObject -> ByteString
165−encodeScalar' = encodeYaml
166−
167−decodeScalar' :: MonadFailure YamlException m
168− => ByteString
169− -> m ScalarObject
170−decodeScalar' = decodeYamlSuccess
171−
172−instance ConvertSuccess ScalarObject YamlDoc where
173− convertSuccess = YamlDoc . encodeScalar'
174−instance ConvertAttempt YamlDoc ScalarObject where
175− convertAttempt = decodeScalar' . unYamlDoc
176−
177−-- ScalarObject conversions
178−encodeScalar :: ConvertSuccess x ScalarObject => x -> ByteString
179−encodeScalar = encodeScalar' . convertSuccess
180−
181−decodeScalar :: ( MonadFailure YamlException m
182− , ConvertAttempt ScalarObject x
183− , Failure ConversionException m
184− )
185− => ByteString
186− -> m x
187−decodeScalar bs = decodeScalar' bs >>= convertAttemptWrap
188−
189−decodeScalarSuccess :: ( MonadFailure YamlException m
190− , ConvertSuccess ScalarObject x
191− )
192− => ByteString
193− -> m x
194−decodeScalarSuccess = fmap convertSuccess . decodeScalar'
195−
196−#if TEST
197−newtype MyString = MyString String
198− deriving (Eq, Show)
199−instance ConvertSuccess MyString Text where
200− convertSuccess (MyString s) = convertSuccess s
201−instance ConvertSuccess Text MyString where
202− convertSuccess = MyString . convertSuccess
203−instance ConvertSuccess (Object Text Text) (Object MyString MyString) where
204− convertSuccess = mapKeysValues convertSuccess convertSuccess
205−instance ConvertSuccess (Object MyString MyString) (Object Text Text) where
206− convertSuccess = mapKeysValues convertSuccess convertSuccess
207−
208−myEquals :: Eq v => Attempt v -> Attempt v -> Bool
209−myEquals a1 a2
210− | isSuccess a1 && isSuccess a2 = fromSuccess a1 == fromSuccess a2
211− | otherwise = False
212−
213−propEncodeDecode :: Object MyString MyString -> Bool
214−propEncodeDecode o =
215− (decodeTextSuccess $ encodeText' $ convertSuccess o)
216− `myEquals` return o
217−
218−toSBS :: ConvertSuccess a ByteString => a -> ByteString
219−toSBS = convertSuccess
220−
221−toLBS :: ConvertSuccess a BL.ByteString => a -> BL.ByteString
222−toLBS = convertSuccess
223−
224−caseEmptyStrings :: Assertion
225−caseEmptyStrings = do
226− let m =
227− [ ("foo", "bar")
228− , ("baz", "")
229− , ("bin", "")
230− ]
231− let m' = map (toSBS *** toSBS) m
232− let m'' = map (toLBS *** toLBS) m
233− let test' :: (ConvertSuccess x TextObject,
234− ConvertSuccess TextObject x,
235− Eq x,
236− Show x)
237− => x
238− -> Assertion
239− test' x = do
240− let bs = encodeText x
241− x' <- decodeTextSuccess bs
242− x' @?= x
243− test' $ toTextObject m
244− test' $ toTextObject m'
245− test' $ toTextObject m''
246−
247−caseLargeObjects :: Assertion
248−caseLargeObjects = do
249− let level3 = toTextObject (convertSuccess "X" :: Text)
250− level2 = toTextObject $ replicate 10000 level3
251− level1 = toTextObject $ zip (map (: []) ['A'..'Z']) $ repeat level2
252− decoded :: Maybe TextObject
253− decoded = decodeText $ encodeText level1
254− assertEqual "encode/decode identity" decoded $ Just level1
255− putStrLn "encoding the file..."
256− B.writeFile "test.yaml" $ encodeText' level1
257−
258−testSuite :: Test
259−testSuite = testGroup "Text.Yaml"
260− [ testProperty "propEncodeDecode" propEncodeDecode
261− , testCase "empty strings" caseEmptyStrings
262− , testCase "encode large objects" caseLargeObjects
263− ]
264−
265−instance Arbitrary (Object MyString MyString) where
266− coarbitrary = undefined
267− arbitrary = oneof [arbS, arbL, arbM] where
268− arbS = Scalar `fmap` (arbitrary :: Gen MyString)
269− arbL = Sequence `fmap` vector 1
270− arbM = Mapping `fmap` vector 1
271−
272−instance Arbitrary MyString where
273− coarbitrary = undefined
274− arbitrary = do
275− size <- arbitrary
276− s <- replicateM (size `mod` 5) $ elements ['A'..'Z']
277− return $! MyString s
278−#endif
yaml.cabal → data-object-yaml.cabalrenamed+6−10
@@ -1,5 +1,5 @@
1−name: yaml
1+name: data-object-yaml
2−version: 0.2.0
2+version: 0.0.0
3license: BSD3
3license: BSD3
4license-file: LICENSE
4license-file: LICENSE
5author: Michael Snoyman <michael@snoyman.com>
5author: Michael Snoyman <michael@snoyman.com>
@@ -27,16 +27,12 @@ library
27 build-depends: base >= 4 && < 5,
27 build-depends: base >= 4 && < 5,
28 data-object >= 0.2.0 && < 0.3,
28 data-object >= 0.2.0 && < 0.3,
29 bytestring >= 0.9.1.4 && < 0.10,
29 bytestring >= 0.9.1.4 && < 0.10,
30− time >= 1.1.4 && < 1.2,
31− safe-failure >= 0.4 && < 0.5,
32− transformers >= 0.1.4.0 && < 0.2,
33− failure >= 0.0.0 && < 0.1,
34 text >= 0.5 && < 0.6,
30 text >= 0.5 && < 0.6,
35− convertible-text >= 0.0.0 && < 0.1,
31+ convertible-text >= 0.2.0 && < 0.3,
36 attempt >= 0.2.0 && < 0.3
32 attempt >= 0.2.0 && < 0.3
37− exposed-modules: Text.Yaml
33+ exposed-modules: Data.Object.Yaml
38− Data.Object.Yaml
34+ Data.Object.Yaml.Internal
39− other-modules: Text.Libyaml
35+ other-modules: Data.Object.Yaml.Lib
40 ghc-options: -Wall
36 ghc-options: -Wall
41 c-sources: c/helper.c,
37 c-sources: c/helper.c,
42 c/api.c,
38 c/api.c,
runtests.hs+2−2
@@ -1,8 +1,8 @@
1import Test.Framework (defaultMain)
1import Test.Framework (defaultMain)
2
2
3−import qualified Text.Yaml
3+import qualified Data.Object.Yaml
4
4
5main :: IO ()
5main :: IO ()
6main = defaultMain
6main = defaultMain
7− [ Text.Yaml.testSuite
7+ [ Data.Object.Yaml.testSuite
8 ]
8 ]