53f4cf3 · typeable/yaml

Data/Yaml.hs+7−7

compare with master

unifiedsplit

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

1{-# LANGUAGE CPP #-}

2−{-# LANGUAGE PatternGuards #-}

3{-# LANGUAGE ScopedTypeVariables #-}

2{-# LANGUAGE ScopedTypeVariables #-}

4{-# LANGUAGE OverloadedStrings #-}

3{-# LANGUAGE OverloadedStrings #-}

5-- | Provides a high-level interface for processing YAML files.

4-- | Provides a high-level interface for processing YAML files.

@@ -76,6 +75,7 @@ import qualified Data.Text.Lazy as TL

76import Data.Text.Lazy.Builder (toLazyText)

75import Data.Text.Lazy.Builder (toLazyText)

77import Data.Aeson.Encode (encodeToTextBuilder)

76import Data.Aeson.Encode (encodeToTextBuilder)

78import Control.Monad.Trans.Resource (runResourceT)

77import Control.Monad.Trans.Resource (runResourceT)

78+import Control.Applicative((<$>))

79

80import Data.Yaml.Internal

81

@@ -106,10 +106,10 @@ objToEvents' :: Value -> [Y.Event] -> [Y.Event]

106--objToEvents' (Scalar s) rest = scalarToEvent s : rest

107objToEvents' (Array list) rest =

108 EventSequenceStart Nothing

109− : foldr ($) (EventSequenceEnd : rest) (map objToEvents' $ V.toList list)

109+ : foldr objToEvents' (EventSequenceEnd : rest) (V.toList list)

110objToEvents' (Object pairs) rest =

111 EventMappingStart Nothing

112− : foldr ($) (EventMappingEnd : rest) (map pairToEvents $ M.toList pairs)

112+ : foldr pairToEvents (EventMappingEnd : rest) (M.toList pairs)

113

114-- Empty strings need special handling to ensure they get quoted. This avoids:

115-- https://github.com/snoyberg/yaml/issues/24

@@ -138,8 +138,8 @@ decode :: FromJSON a

138 => ByteString

139 -> Maybe a

140decode bs = unsafePerformIO

141− $ fmap (either (const Nothing) id)

141+ $ either (const Nothing) id

142− $ decodeHelper_ (Y.decode bs)

142+ <$> decodeHelper_ (Y.decode bs)

143

144decodeFile :: FromJSON a

145 => FilePath

@@ -157,8 +157,8 @@ decodeFileEither = decodeHelper_ . Y.decodeFile

157

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

159decodeEither bs = unsafePerformIO

160− $ fmap (either (Left . prettyPrintParseException) id)

160+ $ either (Left . prettyPrintParseException) id

161− $ decodeHelper (Y.decode bs)

161+ <$> decodeHelper (Y.decode bs)

162

163-- | More helpful version of 'decodeEither' which returns the 'YamlException'.

164--

Data/Yaml/Builder.hs+1−1

@@ -67,7 +67,7 @@ array :: [YamlBuilder] -> YamlBuilder

67array bs =

68 YamlBuilder $ (EventSequenceStart Nothing:) . flip (foldr go) bs . (EventSequenceEnd:)

69 where

70− go (YamlBuilder b) rest = b rest

70+ go (YamlBuilder b) = b

71

72string :: Text -> YamlBuilder

73-- Empty strings need special handling to ensure they get quoted. This avoids:

Data/Yaml/Internal.hs+4−6

@@ -26,9 +26,9 @@ import qualified Data.Conduit as C

26import qualified Data.Conduit.List as CL

27import Control.Monad.Trans.Class (MonadTrans, lift)

28import Control.Monad.IO.Class (MonadIO, liftIO)

29−import Control.Monad (liftM, ap)

29+import Control.Monad (liftM, ap, unless)

30#if !MIN_VERSION_base(4,8,0)

31−import Control.Applicative (Applicative(..))

31+import Control.Applicative ((<$>), Applicative(..))

32#endif

33import Data.Char (toUpper)

34import qualified Data.Vector as V

@@ -126,9 +126,7 @@ type Parse = StateT (Map.Map String Value) (ResourceT IO)

126requireEvent :: Event -> C.Sink Event Parse ()

127requireEvent e = do

128 f <- CL.head

129− if f == Just e

130− then return ()

131− else liftIO $ throwIO $ UnexpectedEvent f $ Just e

129+ unless (f == Just e) $ liftIO $ throwIO $ UnexpectedEvent f $ Just e

132

130

133parse :: C.Sink Event Parse Value

131parse :: C.Sink Event Parse Value

134parse = do

132parse = do

@@ -170,7 +168,7 @@ parseO :: C.Sink Event Parse Value

170parseO = do

168parseO = do

171 me <- CL.head

169 me <- CL.head

172 case me of

170 case me of

173− Just (EventScalar v tag style a) -> fmap (textToValue style tag) $ parseScalar v a style tag

171+ Just (EventScalar v tag style a) -> textToValue style tag <$> parseScalar v a style tag

174 Just (EventSequenceStart a) -> parseS a id

172 Just (EventSequenceStart a) -> parseS a id

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

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

176 Just (EventAlias an) -> do

174 Just (EventAlias an) -> do

Data/Yaml/Pretty.hs+2−1

@@ -9,6 +9,7 @@ module Data.Yaml.Pretty

9 , defConfig

10 ) where

11

12+import Control.Applicative ((<$>))

12import Data.Yaml.Builder

13import Data.Yaml.Builder

13import Data.Aeson.Types

14import Data.Aeson.Types

14import Data.Text (Text)

15import Data.Text (Text)

@@ -45,7 +46,7 @@ setConfCompare cmp c = c { confCompare = cmp }

45pretty :: Config -> Value -> YamlBuilder

46pretty :: Config -> Value -> YamlBuilder

46pretty cfg = go

47pretty cfg = go

47 where go (Object o) = mapping (sortBy (confCompare cfg `on` fst) $ HM.toList $ HM.map go o)

48 where go (Object o) = mapping (sortBy (confCompare cfg `on` fst) $ HM.toList $ HM.map go o)

48− go (Array a) = array (fmap go $ V.toList a)

49+ go (Array a) = array (go <$> V.toList a)

49 go Null = null

50 go Null = null

50 go (String s) = string s

51 go (String s) = string s

51 go (Number n) = scientific n

52 go (Number n) = scientific n

exe/json2yaml.hs+3−4

@@ -18,7 +18,6 @@ main = do

18 _ -> L.readFile input

19 case mval of

20 Nothing -> error "Invalid input JSON"

21− Just val -> do

22− case output of

21+ Just val -> case output of

23− "-" -> S.putStr $ Y.encode (val :: Y.Value)

22+ "-" -> S.putStr $ Y.encode (val :: Y.Value)

24− _ -> Y.encodeFile output val

23+ _ -> Y.encodeFile output val