72649df · typeable/yaml

git.iko.soy/typeable/yaml

on master help sign in

Proper types for values

72649dfMichael Snoyman15 years ago

Data/Yaml.hs+13−2

compare with master

unifiedsplit

@@ -54,10 +54,12 @@ import Control.Monad.IO.Class (MonadIO, liftIO)

54import Control.Monad (liftM)

55import qualified Data.Vector as V

56import Data.Text (Text, pack)

57+import Data.Text.Read (signed, decimal, double)

57import Data.Text.Encoding (encodeUtf8, decodeUtf8With)

58import Data.Text.Encoding (encodeUtf8, decodeUtf8With)

58import Data.Text.Encoding.Error (lenientDecode)

59import Data.Text.Encoding.Error (lenientDecode)

59import qualified Data.HashMap.Strict as M

60import qualified Data.HashMap.Strict as M

60import Data.Typeable

61import Data.Typeable

62+import Data.Attoparsec.Number

62encode :: ToJSON a => a -> ByteString

64encode :: ToJSON a => a -> ByteString

63encode obj = unsafePerformIO $

65encode obj = unsafePerformIO $

@@ -150,14 +152,23 @@ parseScalar v a = do

150 case a of

152 case a of

151 Nothing -> return res

153 Nothing -> return res

152 Just an -> do

154 Just an -> do

153− lift $ modify (Map.insert an $ String res)

155+ lift $ modify (Map.insert an $ textToValue res)

154 return res

156 return res

155

157

158+textToValue :: Text -> Value -- FIXME check for quoting style?

159+textToValue "true" = Bool True

160+textToValue "false" = Bool False

161+textToValue "null" = Null

162+textToValue t

163+ | Right (x, "") <- signed decimal t = Number $ I x

164+ | Right (x, "") <- double t = Number $ D x

165+ | otherwise = String t

166+

156parseO :: C.Sink Event Parse Value

167parseO :: C.Sink Event Parse Value

157parseO = do

168parseO = do

158 me <- CL.head

169 me <- CL.head

159 case me of

170 case me of

160− Just (EventScalar v _t _s a) -> fmap String $ parseScalar v a

171+ Just (EventScalar v _t _s a) -> fmap textToValue $ parseScalar v a

161 Just (EventSequenceStart a) -> parseS a id

172 Just (EventSequenceStart a) -> parseS a id

162 Just (EventMappingStart a) -> parseM a M.empty

173 Just (EventMappingStart a) -> parseM a M.empty

163 Just (EventAlias an) -> do

174 Just (EventAlias an) -> do

test/main.hs+17−3

@@ -41,6 +41,7 @@ main = hspecX $ do

41 it "encode/decode file" caseEncodeDecodeFileData

42 it "encode/decode strings" caseEncodeDecodeStrings

43 it "decode invalid file" caseDecodeInvalid

44+ it "processes datatypes" caseDataTypes

44 describe "Data.Yaml aliases" $ do

45 describe "Data.Yaml aliases" $ do

45 it "simple scalar alias" caseSimpleScalarAlias

46 it "simple scalar alias" caseSimpleScalarAlias

46 it "simple sequence alias" caseSimpleSequenceAlias

47 it "simple sequence alias" caseSimpleSequenceAlias

@@ -284,6 +285,19 @@ caseMergeSequence = do

284 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"

285 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"

285 let res = fromJust maybeRes

286 let res = fromJust maybeRes

286 mappingKey res "foo1" @?= (mkScalar "foo")

287 mappingKey res "foo1" @?= (mkScalar "foo")

287− mappingKey res "k1" @?= (mkStrScalar "1")

288+ mappingKey res "k1" @?= (D.Number 1)

288− mappingKey res "k2" @?= (mkStrScalar "2")

289+ mappingKey res "k2" @?= (D.Number 2)

289− mappingKey res "k3" @?= (mkStrScalar "4")

290+ mappingKey res "k3" @?= (D.Number 4)

291+

292+caseDataTypes :: Assertion

293+caseDataTypes =

294+ D.decode (D.encode val) @?= Just val

295+ where

296+ val = object

297+ [ ("string", D.String "foo")

298+ , ("int", D.Number 5)

299+ , ("float", D.Number 4.3)

300+ , ("true", D.Bool True)

301+ , ("false", D.Bool False)

302+ , ("null", D.Null)

303+ ]

yaml.cabal+2−1

@@ -1,5 +1,5 @@

1name: yaml

2−version: 0.5.1

2+version: 0.5.1.1

3license: BSD3

4license-file: LICENSE

5author: Michael Snoyman <michael@snoyman.com>, Anton Ageev <antage@gmail.com>,Kirill Simonov

@@ -36,6 +36,7 @@ library

36 , unordered-containers

37 , vector

38 , text

39+ , attoparsec

39 exposed-modules: Text.Libyaml

40 exposed-modules: Text.Libyaml

40 Data.Yaml

41 Data.Yaml

41 ghc-options: -Wall

42 ghc-options: -Wall