45f6459 · typeable/yaml

Data/Yaml.hs+4−23

compare with master

unifiedsplit

@@ -62,10 +62,8 @@ import Data.Aeson

62import Data.Aeson.Types (Pair, parseMaybe, parseEither, Parser)

63import Text.Libyaml hiding (encode, decode, encodeFile, decodeFile)

64import Data.ByteString (ByteString)

65−import qualified Data.Map as Map

66import System.IO.Unsafe (unsafePerformIO)

65import System.IO.Unsafe (unsafePerformIO)

67−import Control.Exception (try, throwIO, fromException, AsyncException)

66+import Control.Exception

68−import Control.Monad.Trans.State

69import qualified Data.Conduit as C

67import qualified Data.Conduit as C

70import qualified Data.Conduit.List as CL

68import qualified Data.Conduit.List as CL

71import qualified Data.Vector as V

69import qualified Data.Vector as V

@@ -164,8 +162,8 @@ decode :: FromJSON a

164 => ByteString

162 => ByteString

165 -> Maybe a

163 -> Maybe a

166decode bs = unsafePerformIO

164decode bs = unsafePerformIO

167− $ fmap (either (const Nothing) (either (const Nothing) Just))

165+ $ fmap (either (const Nothing) id)

168− $ decodeHelper (Y.decode bs)

166+ $ decodeHelper_ (Y.decode bs)

169

167

170decodeFile :: FromJSON a

168decodeFile :: FromJSON a

171 => FilePath

169 => FilePath

@@ -179,24 +177,7 @@ decodeFileEither

179 :: FromJSON a

177 :: FromJSON a

180 => FilePath

178 => FilePath

181 -> IO (Either ParseException a)

179 -> IO (Either ParseException a)

182−decodeFileEither fp = do

180+decodeFileEither = decodeHelper_ . Y.decodeFile

183− x <- try $ runResourceT $ flip evalStateT Map.empty $ Y.decodeFile fp C.$$ parse

184− case x of

185− Left e

186− | Just pe <- fromException e -> return $ Left pe

187− | Just ye <- fromException e -> return $ Left $ InvalidYaml $ Just (ye :: YamlException)

188− | shouldBeCaught e -> return $ Left $ OtherParseException e

189− | otherwise -> throwIO e

190− Right y ->

191− return $ case parseEither parseJSON y of

192− Left s -> Left $ AesonException s

193− Right v -> Right v

194− where

195− -- FIXME this function needs more thought

196− shouldBeCaught e

197− | Just (_ :: AsyncException) <- fromException e = False

198− -- Would be nice... | Just (_ :: Timeout) <- fromException e = False

199− | otherwise = True

200

181

201decodeEither :: FromJSON a => ByteString -> Either String a

182decodeEither :: FromJSON a => ByteString -> Either String a

202decodeEither bs = unsafePerformIO

183decodeEither bs = unsafePerformIO

Data/Yaml/Include.hs+2−3

@@ -1,7 +1,6 @@

1{-# LANGUAGE RankNTypes #-}

2module Data.Yaml.Include (decodeFile, decodeFileEither) where

3

4−import Control.Applicative

5import Control.Monad (when)

4import Control.Monad (when)

6import Control.Exception (throwIO)

5import Control.Exception (throwIO)

7import Control.Monad.IO.Class (liftIO)

6import Control.Monad.IO.Class (liftIO)

@@ -13,7 +12,7 @@ import Data.Text.Encoding (decodeUtf8)

13import Data.Aeson (FromJSON)

12import Data.Aeson (FromJSON)

14import Data.Conduit

13import Data.Conduit

15import qualified Data.Conduit.List as CL

14import qualified Data.Conduit.List as CL

16−import Data.Yaml (ParseException(..), decodeHelper)

15+import Data.Yaml.Internal (ParseException(..), decodeHelper_, decodeHelper)

17import Text.Libyaml hiding (decodeFile)

16import Text.Libyaml hiding (decodeFile)

18import qualified Text.Libyaml as Y

17import qualified Text.Libyaml as Y

19

18

@@ -59,4 +58,4 @@ decodeFileEither

59 :: FromJSON a

58 :: FromJSON a

60 => FilePath

59 => FilePath

61 -> IO (Either ParseException a)

60 -> IO (Either ParseException a)

62−decodeFileEither fp = either Left (either (Left . AesonException) Right) <$> decodeHelper (eventsFromFile fp)

61+decodeFileEither = decodeHelper_ . eventsFromFile

Data/Yaml/Internal.hs+18−1

@@ -7,6 +7,7 @@ module Data.Yaml.Internal

7 ParseException(..)

8 , parse

9 , decodeHelper

10+ , decodeHelper_

10 ) where

11 ) where

11

12

12import qualified Text.Libyaml as Y

13import qualified Text.Libyaml as Y

@@ -16,6 +17,7 @@ import Text.Libyaml hiding (encode, decode, encodeFile, decodeFile)

16import Data.ByteString (ByteString)

17import Data.ByteString (ByteString)

17import qualified Data.Map as Map

18import qualified Data.Map as Map

18import Control.Exception

19import Control.Exception

20+import Control.Exception.Enclosed

19import Control.Monad.Trans.State

21import Control.Monad.Trans.State

20import qualified Data.Conduit as C

22import qualified Data.Conduit as C

21import qualified Data.Conduit.List as CL

23import qualified Data.Conduit.List as CL

@@ -193,10 +195,25 @@ decodeHelper :: FromJSON a

193 => C.Source Parse Y.Event

195 => C.Source Parse Y.Event

194 -> IO (Either ParseException (Either String a))

196 -> IO (Either ParseException (Either String a))

195decodeHelper src = do

197decodeHelper src = do

196− x <- try $ runResourceT $ flip evalStateT Map.empty $ src C.$$ parse

198+ x <- tryAny $ runResourceT $ flip evalStateT Map.empty $ src C.$$ parse

197 case x of

199 case x of

198 Left e

200 Left e

199 | Just pe <- fromException e -> return $ Left pe

201 | Just pe <- fromException e -> return $ Left pe

200 | Just ye <- fromException e -> return $ Left $ InvalidYaml $ Just (ye :: YamlException)

202 | Just ye <- fromException e -> return $ Left $ InvalidYaml $ Just (ye :: YamlException)

201 | otherwise -> throwIO e

203 | otherwise -> throwIO e

202 Right y -> return $ Right $ parseEither parseJSON y

204 Right y -> return $ Right $ parseEither parseJSON y

205+

206+decodeHelper_ :: FromJSON a

207+ => C.Source Parse Event

208+ -> IO (Either ParseException a)

209+decodeHelper_ src = do

210+ x <- tryAny $ runResourceT $ flip evalStateT Map.empty $ src C.$$ parse

211+ return $ case x of

212+ Left e

213+ | Just pe <- fromException e -> Left pe

214+ | Just ye <- fromException e -> Left $ InvalidYaml $ Just (ye :: YamlException)

215+ | otherwise -> Left $ OtherParseException e

216+ Right y -> either

217+ (Left . AesonException)

218+ Right

219+ (parseEither parseJSON y)

test/Data/Yaml/IncludeSpec.hs+7

@@ -2,8 +2,10 @@

2module Data.Yaml.IncludeSpec (main, spec) where

3

4import Test.Hspec

5+import Test.Hspec.Expectations.Contrib

5import Data.Aeson

6import Data.Aeson

6import Data.Aeson.QQ

7import Data.Aeson.QQ

8+import Data.Yaml (ParseException)

7

9

8import Data.Yaml.Include

10import Data.Yaml.Include

9

11

@@ -35,3 +37,8 @@ spec = do

35

37

36 it "aborts on cyclic includes" $ do

38 it "aborts on cyclic includes" $ do

37 (decodeFile "test/resources/loop/foo.yaml" :: IO (Maybe Value)) `shouldThrow` anyException

39 (decodeFile "test/resources/loop/foo.yaml" :: IO (Maybe Value)) `shouldThrow` anyException

40+

41+ describe "decodeFileEither" $ do

42+ context "when file does not exist" $ do

43+ it "returns Left" $ do

44+ (decodeFileEither "./does_not_exist.yaml" :: IO (Either ParseException Value)) >>= (`shouldSatisfy` isLeft)

test/Data/YamlSpec.hs+7−1

@@ -19,6 +19,7 @@ import System.Directory

19import Control.Monad

20import Control.Exception (try, SomeException)

21import Test.Hspec

22+import Test.Hspec.Expectations.Contrib

22

23

23import qualified Data.Yaml as D

24import qualified Data.Yaml as D

24import Data.Yaml (object, array, (.=))

25import Data.Yaml (object, array, (.=))

@@ -114,7 +115,7 @@ spec = do

114 in D.decode (D.encode value') `shouldBe` Just value'

115 in D.decode (D.encode value') `shouldBe` Just value'

115 mapM_ tester specialStrings

116 mapM_ tester specialStrings

116

117

117− describe "yamlFileJSONparse" $

118+ describe "decodeFileEither" $ do

118 it "loads YAML through JSON into Haskell data" $ do

119 it "loads YAML through JSON into Haskell data" $ do

119 tj <- either (error . show) id `fmap` D.decodeFileEither "test/json.yaml"

120 tj <- either (error . show) id `fmap` D.decodeFileEither "test/json.yaml"

120 tj `shouldBe` TestJSON

121 tj `shouldBe` TestJSON

@@ -125,6 +126,11 @@ spec = do

125 , extrastring = "1234-foo"

126 , extrastring = "1234-foo"

126 }

127 }

127

128

129+ context "when file does not exist" $ do

130+ it "returns Left" $ do

131+ (D.decodeFileEither "./does_not_exist.yaml" :: IO (Either D.ParseException D.Value)) >>= (`shouldSatisfy` isLeft)

132+

133+

128 describe "round-tripping of special scalars" $ do

134 describe "round-tripping of special scalars" $ do

129 let special = words "y Y On ON false 12345 12345.0 12345a 12e3"

135 let special = words "y Y On ON false 12345 12345.0 12345a 12e3"

130 forM_ special $ \w -> it w $

136 forM_ special $ \w -> it w $

yaml.cabal+2

@@ -52,6 +52,7 @@ library

52 , scientific

53 , filepath

54 , directory

55+ , enclosed-exceptions

55 exposed-modules: Text.Libyaml

56 exposed-modules: Text.Libyaml

56 Data.Yaml

57 Data.Yaml

57 Data.Yaml.Aeson

58 Data.Yaml.Aeson

@@ -113,6 +114,7 @@ test-suite spec

113 Data.Yaml.IncludeSpec

114 Data.Yaml.IncludeSpec

114 cpp-options: -DTEST

115 cpp-options: -DTEST

115 build-depends: hspec >= 1.3

116 build-depends: hspec >= 1.3

117+ , hspec-expectations

116 , HUnit

118 , HUnit

117 , directory

119 , directory

118 , base >= 4 && < 5

120 , base >= 4 && < 5