git.iko.soy/typeable/yaml
on master help sign in
Scalar interface and fixed tests
0c0ba47Michael Snoyman
Setup.lhs+1−5
compare with master
unifiedsplit
@@ -2,10 +2,6 @@
2
2
3> module Main where
3> module Main where
4> import Distribution.Simple
4> import Distribution.Simple
5−> import System.Cmd (system)
6
5
7> main :: IO ()
6> main :: IO ()
8−> main = defaultMainWithHooks (simpleUserHooks { runTests = runTests' })
7+> main = defaultMain
9−
10−> runTests' :: a -> b -> c -> d -> IO ()
11−> runTests' _ _ _ _ = system "runhaskell Test.hs" >> return ()
Text/Yaml.hs+109−36
@@ -17,10 +17,15 @@
17---------------------------------------------------------
17---------------------------------------------------------
18
18
19module Text.Yaml
19module Text.Yaml
20− ( module Data.Object
20+ (
21− , encode
21+ -- * Converting to/from 'TextObject's
22+ encodeText
23+ , decodeText
24+ -- * Convert to/from 'ScalarObejct's
25+ , encodeScalar
26+ , decodeScalar
27+ -- * Files
22 , encodeFile
28 , encodeFile
23− , decode
24 , decodeFile
29 , decodeFile
25#if TEST
30#if TEST
26 , testSuite
31 , testSuite
@@ -33,6 +38,7 @@ import qualified Data.ByteString as B
33import qualified Data.ByteString.Lazy as BL
38import qualified Data.ByteString.Lazy as BL
34import Data.Object
39import Data.Object
35import Data.Object.Text
40import Data.Object.Text
41+import Data.Object.Scalar
36import System.IO.Unsafe
42import System.IO.Unsafe
37import Control.Arrow (first)
43import Control.Arrow (first)
38import Control.Monad (liftM, join)
44import Control.Monad (liftM, join)
@@ -50,19 +56,56 @@ import Test.Framework.Providers.HUnit
50import Test.Framework.Providers.QuickCheck (testProperty)
56import Test.Framework.Providers.QuickCheck (testProperty)
51import Test.HUnit hiding (Test, path)
57import Test.HUnit hiding (Test, path)
52import Test.QuickCheck
58import Test.QuickCheck
59+
60+import Control.Monad (replicateM)
61+import Control.Arrow ((***))
53#endif
62#endif
54
63
64+-- Low level, non-exported functions
55−encode :: (ConvertSuccess B.ByteString a, ToObject o Text Text) => o -> a
65+encode' :: ConvertSuccess B.ByteString a
56−encode = unsafePerformIO . encode'
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
57
72
58−decode :: (ConvertSuccess a B.ByteString,
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,
59− MonadFailure YamlException m)
89+ MonadFailure YamlException m)
60− => a
90+ => a
61− -> m TextObject
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
62−decode = unsafePerformIO . decode'
104+decodeScalar = liftM toScalarObject . unsafePerformIO . decode'
63
105
106+-- File API
64encodeFile :: ToObject o Text Text => FilePath -> o -> IO ()
107encodeFile :: ToObject o Text Text => FilePath -> o -> IO ()
65−encodeFile path o = encode' o >>= ltWriteFile path
108+encodeFile path o = encode' (toTextObject o) >>= ltWriteFile path
66
109
67ltWriteFile :: FilePath -> Text -> IO ()
110ltWriteFile :: FilePath -> Text -> IO ()
68ltWriteFile fp = BL.writeFile fp . LTE.encodeUtf8
111ltWriteFile fp = BL.writeFile fp . LTE.encodeUtf8
@@ -78,24 +121,7 @@ decodeFile path = do
78ltReadFile :: FilePath -> IO Text
121ltReadFile :: FilePath -> IO Text
79ltReadFile = fmap LTE.decodeUtf8 . BL.readFile
122ltReadFile = fmap LTE.decodeUtf8 . BL.readFile
80
123
81−encode' :: (ConvertSuccess B.ByteString a,
124+-- The real worker functions
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−
99objectToEvents :: TextObject -> [Event]
125objectToEvents :: TextObject -> [Event]
100objectToEvents y = concat
126objectToEvents y = concat
101 [ [EventStreamStart, EventDocumentStart]
127 [ [EventStreamStart, EventDocumentStart]
@@ -144,6 +170,7 @@ eventsToTextObject = fst . readSingle . dropWhile isIgnored where
144 readMap _ (e:_) = error $ "Unexpected event in readMap: " ++ show e
170 readMap _ (e:_) = error $ "Unexpected event in readMap: " ++ show e
145 readMap _ [] = error "Unexpected empty event list in readMap"
171 readMap _ [] = error "Unexpected empty event list in readMap"
146
172
173+#if TEST
147newtype MyString = MyString String
174newtype MyString = MyString String
148 deriving (Eq, Show)
175 deriving (Eq, Show)
149instance ConvertAttempt MyString Text where
176instance ConvertAttempt MyString Text where
@@ -151,12 +178,53 @@ instance ConvertAttempt MyString Text where
151instance ConvertSuccess MyString Text where
178instance ConvertSuccess MyString Text where
152 convertSuccess (MyString s) = convertSuccess s
179 convertSuccess (MyString s) = convertSuccess s
153instance ConvertAttempt Text MyString where
180instance ConvertAttempt Text MyString where
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
154− convertAttempt raw = MyString `liftM` convertAttempt raw
192+ convertAttempt = return
155
193
156−#if TEST
157propEncodeDecode :: Object MyString MyString -> Bool
194propEncodeDecode :: Object MyString MyString -> Bool
158−propEncodeDecode o = fromAttempt (decode (encode o :: B.ByteString))
195+propEncodeDecode o =
159− == Just 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
160
228
161caseEmptyStrings :: Assertion
229caseEmptyStrings :: Assertion
162caseEmptyStrings = do
230caseEmptyStrings = do
@@ -165,9 +233,14 @@ caseEmptyStrings = do
165 , ("baz", "")
233 , ("baz", "")
166 , ("bin", "")
234 , ("bin", "")
167 ]
235 ]
168− let m' = map (toStrictByteString *** toStrictByteString) m
236+ let m' = map (toSBS *** toSBS) m
169− let m'' = map (toLazyByteString *** toLazyByteString) m
237+ let m'' = map (toLBS *** toLBS) m
170− let test' x = Just x @=? fromAttempt (decode (encode x :: String))
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)
171 test' m
244 test' m
172 test' m'
245 test' m'
173 test' m''
246 test' m''
yaml.cabal+4
@@ -20,6 +20,10 @@ flag buildtests
20 default: False
20 default: False
21
21
22library
22library
23+ if flag(buildtests)
24+ Buildable: False
25+ else
26+ Buildable: True
23 build-depends: base >= 4 && < 5,
27 build-depends: base >= 4 && < 5,
24 data-object == 0.2.0,
28 data-object == 0.2.0,
25 bytestring >= 0.9.1.4 && < 1,
29 bytestring >= 0.9.1.4 && < 1,