78d7840 · typeable/yaml

Data/Yaml.hs+1

compare with master

unifiedsplit

@@ -183,6 +183,7 @@ data ParseException = NonScalarKey

183 | AesonException String

184 | OtherParseException SomeException

185 | NonStringKeyAlias Y.AnchorName Value

186+ | CyclicIncludes

186 deriving (Show, Typeable)

187 deriving (Show, Typeable)

187instance Exception ParseException

188instance Exception ParseException

188

189

Data/Yaml/Include.hsnew file+62

@@ -0,0 +1,62 @@

1+{-# LANGUAGE RankNTypes #-}

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

3+

4+import Control.Applicative

5+import Control.Monad (when)

6+import Control.Exception (throwIO)

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

8+import Control.Monad.Trans.Resource (MonadResource)

9+import System.Directory

10+import System.FilePath

11+import Data.Text (unpack)

12+import Data.Text.Encoding (decodeUtf8)

13+import Data.Aeson (FromJSON)

14+import Data.Conduit

15+import qualified Data.Conduit.List as CL

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

17+import Text.Libyaml hiding (decodeFile)

18+import qualified Text.Libyaml as Y

19+

20+eventsFromFile

21+ :: MonadResource m

22+ => FilePath

23+ -> Producer m Event

24+eventsFromFile = go []

25+ where

26+ go :: MonadResource m => [FilePath] -> FilePath -> Producer m Event

27+ go seen fp = do

28+ cfp <- liftIO $ canonicalizePath fp

29+ when (cfp `elem` seen) $ do

30+ liftIO $ throwIO CyclicIncludes

31+ Y.decodeFile cfp $= do

32+ awaitForever $ \event -> case event of

33+ EventScalar f (UriTag "!include") _ _ -> do

34+ let includeFile = takeDirectory cfp </> unpack (decodeUtf8 f)

35+ go (cfp : seen) includeFile $= CL.filter (`notElem` irrelevantEvents)

36+ _ -> yield event

37+

38+ irrelevantEvents = [EventStreamStart, EventDocumentStart, EventDocumentEnd, EventStreamEnd]

39+

40+-- | Like `Data.Yaml.decodeFile` but with support for relative and absolute

41+-- includes.

42+--

43+-- The syntax for includes follows the form:

44+--

45+-- > somekey: !include ./somefile.yaml

46+decodeFile

47+ :: FromJSON a

48+ => FilePath

49+ -> IO (Maybe a)

50+decodeFile fp = decodeHelper (eventsFromFile fp) >>= either throwIO (return . either (const Nothing) id)

51+

52+-- | Like `Data.Yaml.decodeFileEither` but with support for relative and

53+-- absolute includes.

54+--

55+-- The syntax for includes follows the form:

56+--

57+-- > somekey: !include ./somefile.yaml

58+decodeFileEither

59+ :: FromJSON a

60+ => FilePath

61+ -> IO (Either ParseException a)

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

test/Data/Yaml/IncludeSpec.hsnew file+37

@@ -0,0 +1,37 @@

1+{-# LANGUAGE QuasiQuotes #-}

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

3+

4+import Test.Hspec

5+import Data.Aeson

6+import Data.Aeson.QQ

7+

8+import Data.Yaml.Include

9+

10+main :: IO ()

11+main = hspec spec

12+

13+spec :: Spec

14+spec = do

15+ describe "decodeFile" $ do

16+ it "supports includes" $ do

17+ decodeFile "test/resources/foo.yaml" `shouldReturn` Just [aesonQQ|

18+ {

19+ foo: 23,

20+ bar: {one: 1, two: 2},

21+ baz: 42

22+ }

23+ |]

24+

25+ it "supports recursive includes" $ do

26+ decodeFile "test/resources/baz.yaml" `shouldReturn` Just [aesonQQ|

27+ {

28+ foo: {

29+ foo: 23,

30+ bar: {one: 1, two: 2},

31+ baz: 42

32+ }

33+ }

34+ |]

35+

36+ it "aborts on cyclic includes" $ do

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

test/resources/bar.yamlnew file+2

@@ -0,0 +1,2 @@

1+one: 1

2+two: 2

test/resources/baz.yamlnew file+1

@@ -0,0 +1 @@

1+foo: !include foo.yaml

test/resources/foo.yamlnew file+3

@@ -0,0 +1,3 @@

1+foo: 23

2+bar: !include bar.yaml

3+baz: 42

test/resources/loop/bar.yamlnew file+2

@@ -0,0 +1,2 @@

1+one: 1

2+two: !include foo.yaml

test/resources/loop/foo.yamlnew file+3

@@ -0,0 +1,3 @@

1+foo: 23

2+bar: !include bar.yaml

3+baz: 42

yaml.cabal+11−2

@@ -24,10 +24,14 @@ homepage: http://github.com/snoyberg/yaml/

24extra-source-files: c/helper.h,

25 libyaml/yaml_private.h,

26 libyaml/yaml.h,

27− libyaml/LICENSE

27+ libyaml/LICENSE

28− test/main.hs

29 test/largest-string.yaml

28 test/largest-string.yaml

30 test/json.yaml

29 test/json.yaml

30+ test/resources/foo.yaml

31+ test/resources/bar.yaml

32+ test/resources/baz.yaml

33+ test/resources/loop/foo.yaml

34+ test/resources/loop/bar.yaml

31

35

32flag no-exe

36flag no-exe

33 description: don't install the yaml2json or json2yaml executables

37 description: don't install the yaml2json or json2yaml executables

@@ -54,11 +58,14 @@ library

54 , text

58 , text

55 , attoparsec

59 , attoparsec

56 , scientific

60 , scientific

61+ , filepath

62+ , directory

57 exposed-modules: Text.Libyaml

63 exposed-modules: Text.Libyaml

58 Data.Yaml

64 Data.Yaml

59 Data.Yaml.Aeson

65 Data.Yaml.Aeson

60 Data.Yaml.Builder

66 Data.Yaml.Builder

61 Data.Yaml.Parser

67 Data.Yaml.Parser

68+ Data.Yaml.Include

62 ghc-options: -Wall

69 ghc-options: -Wall

63 c-sources: c/helper.c

70 c-sources: c/helper.c

64 include-dirs: c

71 include-dirs: c

@@ -109,6 +116,7 @@ test-suite spec

109 hs-source-dirs: test

116 hs-source-dirs: test

110 main-is: Spec.hs

117 main-is: Spec.hs

111 other-modules: Data.YamlSpec

118 other-modules: Data.YamlSpec

119+ Data.Yaml.IncludeSpec

112 cpp-options: -DTEST

120 cpp-options: -DTEST

113 build-depends: hspec >= 1.3

121 build-depends: hspec >= 1.3

114 , HUnit

122 , HUnit

@@ -123,6 +131,7 @@ test-suite spec

123 , unordered-containers

131 , unordered-containers

124 , vector

132 , vector

125 , resourcet

133 , resourcet

134+ , aeson-qq

126 ghc-options: -Wall

135 ghc-options: -Wall

127

136

128source-repository head

137source-repository head