yaml 0.8.15.1 → 0.8.15.2

raw patch · 12 files changed

+131/−153 lines, 12 filesdep ~aesonPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: aeson

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• Data/Yaml.hs +17/−24
• Data/Yaml/Builder.hs +15/−29
• Data/Yaml/Include.hs +6/−5
• Data/Yaml/Internal.hs +24/−35
• Data/Yaml/Parser.hs +13/−10
• Data/Yaml/Pretty.hs +16/−8
• Text/Libyaml.hs +16/−17
• exe/json2yaml.hs +8/−11
• exe/yaml2json.hs +7/−5
• test/Data/YamlSpec.hs +0/−4
• yaml.cabal +5/−5

@@ -1,3 +1,7 @@+## 0.8.15.2++* Canonicalise Monad instances [#76](https://github.com/snoyberg/yaml/pull/76)+ ## 0.8.15.1  * Compile with aeson below 0.7 [#70](https://github.com/snoyberg/yaml/pull/70)

@@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE PatternGuards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} -- | Provides a high-level interface for processing YAML files.@@ -53,35 +52,33 @@       -- ** More control over decoding     , decodeHelper     ) where--import qualified Text.Libyaml as Y+#if !MIN_VERSION_base(4,8,0)+import Control.Applicative((<$>))+#endif+import Control.Exception+import Control.Monad.Trans.Resource (runResourceT) import Data.Aeson     ( Value (..), ToJSON (..), FromJSON (..), object     , (.=) , (.:) , (.:?) , (.!=)     , Object, Array     )+import Data.Aeson.Encode (encodeToTextBuilder) import Data.Aeson.Types (Pair, parseMaybe, parseEither, Parser)-import Text.Libyaml hiding (encode, decode, encodeFile, decodeFile) import Data.ByteString (ByteString)-import System.IO.Unsafe (unsafePerformIO)-import Control.Exception import qualified Data.Conduit as C import qualified Data.Conduit.List as CL-import qualified Data.Vector as V-import Data.Text.Encoding (encodeUtf8) import qualified Data.HashMap.Strict as M import qualified Data.HashSet as HashSet-#if MIN_VERSION_aeson(0, 7, 0)+import Data.Text.Encoding (encodeUtf8) import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Builder (toLazyText)-import Data.Aeson.Encode (encodeToTextBuilder)-#else-import qualified Data.ByteString.Char8 as S8-#endif-import Control.Monad.Trans.Resource (runResourceT)+import qualified Data.Vector as V+import System.IO.Unsafe (unsafePerformIO)  import Data.Yaml.Internal+import Text.Libyaml hiding (encode, decode, encodeFile, decodeFile)+import qualified Text.Libyaml as Y  encode :: ToJSON a => a -> ByteString encode obj = unsafePerformIO $@@ -110,10 +107,10 @@ --objToEvents' (Scalar s) rest = scalarToEvent s : rest objToEvents' (Array list) rest =     EventSequenceStart Nothing-  : foldr ($) (EventSequenceEnd : rest) (map objToEvents' $ V.toList list)+  : foldr objToEvents' (EventSequenceEnd : rest) (V.toList list) objToEvents' (Object pairs) rest =     EventMappingStart Nothing-  : foldr ($) (EventMappingEnd : rest) (map pairToEvents $ M.toList pairs)+  : foldr pairToEvents (EventMappingEnd : rest) (M.toList pairs)  -- Empty strings need special handling to ensure they get quoted. This avoids: -- https://github.com/snoyberg/yaml/issues/24@@ -130,12 +127,8 @@ objToEvents' Null rest = EventScalar "null" NullTag PlainNoTag Nothing : rest objToEvents' (Bool True) rest = EventScalar "true" BoolTag PlainNoTag Nothing : rest objToEvents' (Bool False) rest = EventScalar "false" BoolTag PlainNoTag Nothing : rest-#if MIN_VERSION_aeson(0,7,0) -- Use aeson's implementation which gets rid of annoying decimal points objToEvents' n@Number{} rest = EventScalar (TE.encodeUtf8 $ TL.toStrict $ toLazyText $ encodeToTextBuilder n) IntTag PlainNoTag Nothing : rest-#else-objToEvents' (Number n) rest = EventScalar (S8.pack $ show n) IntTag PlainNoTag Nothing : rest-#endif  pairToEvents :: Pair -> [Y.Event] -> [Y.Event] pairToEvents (k, v) rest =@@ -146,8 +139,8 @@        => ByteString        -> Maybe a decode bs = unsafePerformIO-          $ fmap (either (const Nothing) id)-          $ decodeHelper_ (Y.decode bs)+          $ either (const Nothing) id+          <$> decodeHelper_ (Y.decode bs)  decodeFile :: FromJSON a            => FilePath@@ -165,8 +158,8 @@  decodeEither :: FromJSON a => ByteString -> Either String a decodeEither bs = unsafePerformIO-                $ fmap (either (Left . prettyPrintParseException) id)-                $ decodeHelper (Y.decode bs)+                $ either (Left . prettyPrintParseException) id+                <$> decodeHelper (Y.decode bs)  -- | More helpful version of 'decodeEither' which returns the 'YamlException'. --

@@ -18,31 +18,27 @@     , (.=)     ) where -import Data.Conduit-import Data.ByteString (ByteString)-import Text.Libyaml-import Data.Yaml.Internal-import Data.Text (Text)-#if MIN_VERSION_aeson(0, 7, 0)-import Data.Scientific (Scientific)+import Prelude hiding (null)++import Control.Arrow (second)+import Control.Monad.Trans.Resource (runResourceT)+import Data.Aeson.Encode (encodeToTextBuilder) import Data.Aeson.Types (Value(..))-#endif+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as S8+import Data.Conduit import qualified Data.HashSet as HashSet+import Data.Scientific (Scientific)+import Data.Text (Text) import Data.Text.Encoding (encodeUtf8)-import System.IO.Unsafe (unsafePerformIO)-import Control.Arrow (second)-import qualified Data.ByteString.Char8 as S8-import Control.Monad.Trans.Resource (runResourceT)-#if MIN_VERSION_aeson(0, 7, 0) import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Builder (toLazyText)-import Data.Aeson.Encode (encodeToTextBuilder)-#else-import Data.Attoparsec.Number-#endif-import Prelude hiding (null)+import System.IO.Unsafe (unsafePerformIO) +import Data.Yaml.Internal+import Text.Libyaml+ (.=) :: ToYaml a => Text -> a -> (Text, YamlBuilder) k .= v = (k, toYaml v) @@ -73,7 +69,7 @@ array bs =     YamlBuilder $ (EventSequenceStart Nothing:) . flip (foldr go) bs . (EventSequenceEnd:)   where-    go (YamlBuilder b) rest = b rest+    go (YamlBuilder b) = b  string :: Text -> YamlBuilder -- Empty strings need special handling to ensure they get quoted. This avoids:@@ -89,22 +85,12 @@         | otherwise = EventScalar (encodeUtf8 s) StrTag PlainNoTag Nothing   -- Use aeson's implementation which gets rid of annoying decimal points-#if MIN_VERSION_aeson(0, 7, 0) scientific :: Scientific -> YamlBuilder scientific n = YamlBuilder (EventScalar (TE.encodeUtf8 $ TL.toStrict $ toLazyText $ encodeToTextBuilder (Number n)) IntTag PlainNoTag Nothing :)-#else-scientific :: Number -> YamlBuilder-scientific n = YamlBuilder (EventScalar (S8.pack $ show n) IntTag PlainNoTag Nothing :)-#endif  {-# DEPRECATED number "Use scientific" #-}-#if MIN_VERSION_aeson(0,7,0) number :: Scientific -> YamlBuilder number = scientific-#else-number :: Number -> YamlBuilder-number n = YamlBuilder (EventScalar (S8.pack $ show n) IntTag PlainNoTag Nothing :)-#endif  bool :: Bool -> YamlBuilder bool True   = YamlBuilder (EventScalar "true" BoolTag PlainNoTag Nothing :)

@@ -1,17 +1,18 @@ {-# LANGUAGE RankNTypes #-} module Data.Yaml.Include (decodeFile, decodeFileEither) where -import Control.Monad (when) import Control.Exception (throwIO)+import Control.Monad (when) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Resource (MonadResource)-import System.Directory-import System.FilePath-import Data.Text (unpack)-import Data.Text.Encoding (decodeUtf8) import Data.Aeson (FromJSON) import Data.Conduit import qualified Data.Conduit.List as CL+import Data.Text (unpack)+import Data.Text.Encoding (decodeUtf8)+import System.Directory+import System.FilePath+ import Data.Yaml.Internal (ParseException(..), decodeHelper_, decodeHelper) import Text.Libyaml hiding (decodeFile) import qualified Text.Libyaml as Y

@@ -13,39 +13,37 @@     , isNumeric     ) where -import qualified Text.Libyaml as Y-import Data.Aeson-import Data.Aeson.Types hiding (parse)-import Text.Libyaml hiding (encode, decode, encodeFile, decodeFile)-import Data.ByteString (ByteString)-import qualified Data.Map as Map+#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>), Applicative(..))+#endif import Control.Exception import Control.Exception.Enclosed+import Control.Monad (liftM, ap, unless)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Class (MonadTrans, lift)+import Control.Monad.Trans.Resource (ResourceT, runResourceT) import Control.Monad.Trans.State+import Data.Aeson+import Data.Aeson.Types hiding (parse)+import qualified Data.Attoparsec.Text as Atto+import Data.ByteString (ByteString)+import Data.Char (toUpper) import qualified Data.Conduit as C import qualified Data.Conduit.List as CL-import Control.Monad.Trans.Class (MonadTrans, lift)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad (liftM, ap)-import Control.Applicative (Applicative(..))-import Data.Char (toUpper)-import qualified Data.Vector as V+import qualified Data.HashMap.Strict as M+import qualified Data.HashSet as HashSet+import qualified Data.Map as Map+import Data.Scientific (Scientific) import Data.Text (Text, pack) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode)-import qualified Data.HashMap.Strict as M import Data.Typeable-#if MIN_VERSION_aeson(0, 7, 0)-import qualified Data.Attoparsec.Text as Atto-import Data.Scientific (Scientific)-#else-import Data.Text.Read-import Data.Attoparsec.Number-#endif-import Control.Monad.Trans.Resource (ResourceT, runResourceT)-import qualified Data.HashSet as HashSet+import qualified Data.Vector as V +import qualified Text.Libyaml as Y+import Text.Libyaml hiding (encode, decode, encodeFile, decodeFile)+ data ParseException = NonScalarKey                     | UnknownAlias { _anchorName :: Y.AnchorName }                     | UnexpectedEvent { _received :: Maybe Event@@ -110,10 +108,10 @@ instance Monad m => Functor (PErrorT m) where     fmap = liftM instance Monad m => Applicative (PErrorT m) where-    pure  = return+    pure  = PErrorT . return . Right     (<*>) = ap instance Monad m => Monad (PErrorT m) where-    return = PErrorT . return . Right+    return = pure     (PErrorT m) >>= f = PErrorT $ do         e <- m         case e of@@ -129,9 +127,7 @@ requireEvent :: Event -> C.Sink Event Parse () requireEvent e = do     f <- CL.head-    if f == Just e-        then return ()-        else liftIO $ throwIO $ UnexpectedEvent f $ Just e+    unless (f == Just e) $ liftIO $ throwIO $ UnexpectedEvent f $ Just e  parse :: C.Sink Event Parse Value parse = do@@ -161,26 +157,19 @@     | t `elem` ["null", "Null", "NULL", "~", ""] = Null     | any (t `isLike`) ["y", "yes", "on", "true"] = Bool True     | any (t `isLike`) ["n", "no", "off", "false"] = Bool False-#if MIN_VERSION_aeson(0, 7, 0)     | Right x <- textToScientific t = Number x-#else-    | Right (x, "") <- signed decimal t = Number $ I x-    | Right (x, "") <- double t = Number $ D x-#endif     | otherwise = String t   where x `isLike` ref = x `elem` [ref, T.toUpper ref, titleCased]           where titleCased = toUpper (T.head ref) `T.cons` T.tail ref -#if MIN_VERSION_aeson(0, 7, 0) textToScientific :: Text -> Either String Scientific textToScientific = Atto.parseOnly (Atto.scientific <* Atto.endOfInput)-#endif  parseO :: C.Sink Event Parse Value parseO = do     me <- CL.head     case me of-        Just (EventScalar v tag style a) -> fmap (textToValue style tag) $ parseScalar v a style tag+        Just (EventScalar v tag style a) -> textToValue style tag <$> parseScalar v a style tag         Just (EventSequenceStart a) -> parseS a id         Just (EventMappingStart a) -> parseM a M.empty         Just (EventAlias an) -> do

@@ -5,14 +5,13 @@ -- drastically, or be entirely removed, in a future release. module Data.Yaml.Parser where -import Text.Libyaml-import Control.Applicative ((<$>), Applicative (..), Alternative (..))-import Data.Monoid (Monoid (..))+import Control.Applicative+import Control.Exception (Exception) import Control.Monad (MonadPlus (..), liftM, ap)-import Control.Monad.Trans.Writer.Strict (tell, WriterT) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Resource (MonadThrow, monadThrow, runResourceT)-import qualified Data.Map as Map+import Control.Monad.Trans.Writer.Strict (tell, WriterT)+import Data.ByteString (ByteString) import Data.Conduit #if MIN_VERSION_conduit(1,1,0) import Data.Conduit.Lift (runWriterC)@@ -20,20 +19,24 @@ #else import Data.Conduit.Lift (runWriterSC) #endif+import qualified Data.Map as Map+#if !MIN_VERSION_base(4,8,0)+import Data.Monoid (Monoid (..))+#endif import Data.Text (Text, pack, unpack) import Data.Text.Encoding (decodeUtf8)-import Data.ByteString (ByteString)-import Control.Exception (Exception)-import Data.Typeable (Typeable) import Data.Text.Read (signed, decimal)+import Data.Typeable (Typeable) +import Text.Libyaml+ newtype YamlParser a = YamlParser     { unYamlParser :: AnchorMap -> Either Text a     } instance Functor YamlParser where     fmap = liftM instance Applicative YamlParser where-    pure = return+    pure = YamlParser . const . Right     (<*>) = ap instance Alternative YamlParser where     empty = fail "empty"@@ -42,7 +45,7 @@     mempty = fail "mempty"     mappend = mplus instance Monad YamlParser where-    return = YamlParser . const . Right+    return = pure     YamlParser f >>= g = YamlParser $ \am ->         case f am of             Left t -> Left t

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | Prettier YAML encoding. -- -- Since 0.8.13@@ -9,17 +10,24 @@     , defConfig     ) where -import Data.Yaml.Builder+import Prelude hiding (null)++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>))+#endif import Data.Aeson.Types-import Data.Text (Text)-import Data.Monoid-import qualified Data.Vector as V-import qualified Data.HashMap.Strict as HM+import Data.ByteString (ByteString) import Data.Function (on)+import qualified Data.HashMap.Strict as HM import Data.List (sortBy)-import Data.ByteString (ByteString)-import Prelude hiding (null)+#if !MIN_VERSION_base(4,8,0)+import Data.Monoid+#endif+import Data.Text (Text)+import qualified Data.Vector as V +import Data.Yaml.Builder+ -- | -- Since 0.8.13 data Config = Config@@ -45,7 +53,7 @@ pretty :: Config -> Value -> YamlBuilder pretty cfg = go   where go (Object o) = mapping (sortBy (confCompare cfg `on` fst) $ HM.toList $ HM.map go o)-        go (Array a)  = array (fmap go $ V.toList a)+        go (Array a)  = array (go <$> V.toList a)         go Null       = null         go (String s) = string s         go (Number n) = scientific n

@@ -4,8 +4,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PackageImports #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-}@@ -31,12 +29,6 @@  import Prelude hiding (pi) -import qualified Data.ByteString.Internal as B-import qualified Data.ByteString.Char8 as B8-import qualified Data.ByteString-import qualified Data.ByteString.Unsafe as BU-import Data.ByteString (ByteString, packCStringLen)-import Control.Monad import Foreign.C import Foreign.Ptr import Foreign.ForeignPtr@@ -44,16 +36,23 @@ import Foreign.ForeignPtr.Unsafe #endif import Foreign.Marshal.Alloc-import Data.Data -import Control.Monad.IO.Class--import Control.Exception (throwIO, Exception, finally)+#if !MIN_VERSION_base(4,8,0) import Control.Applicative+#endif+import Control.Exception (mask_, throwIO, Exception, finally)+import Control.Monad+import Control.Monad.IO.Class import Control.Monad.Trans.Resource import Data.Conduit hiding (Source, Sink, Conduit)-import Control.Exception (mask_)+import Data.Data +import Data.ByteString (ByteString, packCStringLen)+import qualified Data.ByteString+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Internal as B+import qualified Data.ByteString.Unsafe as BU+ data Event =       EventStreamStart     | EventStreamEnd@@ -265,20 +264,20 @@             yanchor <- c_get_scalar_anchor er             anchor <- if yanchor == nullPtr                           then return Nothing-                          else fmap Just $ peekCString yanchor+                          else Just <$> peekCString yanchor             return $ Just $ EventScalar bs (bsToTag tagbs) style anchor         YamlSequenceStartEvent -> do             yanchor <- c_get_sequence_start_anchor er             anchor <- if yanchor == nullPtr                           then return Nothing-                          else fmap Just $ peekCString yanchor+                          else Just <$> peekCString yanchor             return $ Just $ EventSequenceStart anchor         YamlSequenceEndEvent -> return $ Just EventSequenceEnd         YamlMappingStartEvent -> do             yanchor <- c_get_mapping_start_anchor er             anchor <- if yanchor == nullPtr                           then return Nothing-                          else fmap Just $ peekCString yanchor+                          else Just <$> peekCString yanchor             return $ Just $ EventMappingStart anchor         YamlMappingEndEvent -> return $ Just EventMappingEnd @@ -603,7 +602,7 @@         file <- withCString filePath $                     \filePath' -> withCString "w" $                     \w' -> c_fopen filePath' w'-        if (file == nullPtr)+        if file == nullPtr             then throwIO $ YamlException $ "could not open file for write: " ++ filePath             else return file 

@@ -1,25 +1,22 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-import System.Environment (getArgs)-import qualified Data.Aeson as J-import qualified Data.Yaml as Y import Control.Monad (when)+import qualified Data.Aeson as J import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L-import Control.Applicative ((<$>))+import System.Environment (getArgs) +import qualified Data.Yaml as Y+ main :: IO () main = do     args <- getArgs     when (length args > 2) $ error "Usage: json2yaml [in] [out]"     let (input:output:_) = args ++ repeat "-"-    mval <- J.decode <$>+    mval <- fmap J.decode $         case input of             "-" -> L.getContents             _ -> L.readFile input     case mval of         Nothing -> error "Invalid input JSON"-        Just val -> do-            case output of-                "-" -> S.putStr $ Y.encode (val :: Y.Value)-                _ -> Y.encodeFile output val+        Just val -> case output of+            "-" -> S.putStr $ Y.encode (val :: Y.Value)+            _ -> Y.encodeFile output val

@@ -1,10 +1,12 @@-import Data.Yaml (decodeFileEither, decodeEither')-import System.Environment (getArgs)-import System.Exit-import Data.Aeson (encode, Value) import Prelude hiding (putStr, getContents)-import Data.ByteString.Lazy (putStr)++import Data.Aeson (encode, Value) import Data.ByteString (getContents)+import Data.ByteString.Lazy (putStr)+import System.Environment (getArgs)+import System.Exit++import Data.Yaml (decodeFileEither, decodeEither')  helpMessage :: IO () helpMessage = putStrLn "yaml2json FILE\n  use - as FILE to indicate stdin" >> exitFailure

@@ -148,9 +148,7 @@     it "serialization of +123 #64" $ do         D.decode (D.encode ("+123" :: String)) `shouldBe` Just ("+123" :: String) -#if MIN_VERSION_aeson(0, 7, 0)     it "preserves Scientific precision" casePreservesScientificPrecision-#endif   specialStrings :: [T.Text]@@ -470,7 +468,6 @@   where     src = "---\na:\n  &id5 value: 1.0\nb:\n  *id5: 1.2" -#if MIN_VERSION_aeson(0, 7, 0) -- | We cannot guarantee this before aeson started using 'Scientific'. casePreservesScientificPrecision :: Assertion casePreservesScientificPrecision = do@@ -487,4 +484,3 @@     -- results, because of <https://github.com/bos/text/issues/34>.     D.decodeEither "x: 9.78159610558926e-5" @?= Right (object         [ "x" .= D.Number (read "9.78159610558926e-5") ])-#endif

@@ -1,5 +1,5 @@ name:            yaml-version:         0.8.15.1+version:         0.8.15.2 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>, Anton Ageev <antage@gmail.com>,Kirill Simonov @@ -43,7 +43,7 @@                    , bytestring >= 0.9.1.4                    , conduit >= 1.1.0 && < 1.3                    , resourcet >= 0.3 && < 1.2-                   , aeson >= 0.5+                   , aeson >= 0.7                    , containers                    , unordered-containers                    , vector@@ -91,7 +91,7 @@     build-depends: base >= 4 && < 5                  , yaml                  , bytestring >= 0.9.1.4-                 , aeson >= 0.5+                 , aeson >= 0.7  executable json2yaml     if flag(no-exe)@@ -104,7 +104,7 @@     build-depends: base >= 4 && < 5                  , yaml                  , bytestring >= 0.9.1.4-                 , aeson >= 0.5+                 , aeson >= 0.7   test-suite spec@@ -122,7 +122,7 @@                    , conduit                    , yaml                    , text-                   , aeson+                   , aeson >= 0.7                    , unordered-containers                    , vector                    , resourcet