yaml-0.11.4.0/examples/0000755000000000000000000000000013560466562012716 5ustar0000000000000000yaml-0.11.4.0/exe/0000755000000000000000000000000013560466562011661 5ustar0000000000000000yaml-0.11.4.0/src/0000755000000000000000000000000013560466562011667 5ustar0000000000000000yaml-0.11.4.0/src/Data/0000755000000000000000000000000013560466562012540 5ustar0000000000000000yaml-0.11.4.0/src/Data/Yaml/0000755000000000000000000000000013654740177013443 5ustar0000000000000000yaml-0.11.4.0/test/0000755000000000000000000000000013560466562012057 5ustar0000000000000000yaml-0.11.4.0/test/Data/0000755000000000000000000000000013560466562012730 5ustar0000000000000000yaml-0.11.4.0/test/Data/Yaml/0000755000000000000000000000000013560466562013632 5ustar0000000000000000yaml-0.11.4.0/test/resources/0000755000000000000000000000000013560466562014071 5ustar0000000000000000yaml-0.11.4.0/test/resources/accent/0000755000000000000000000000000013560466562015326 5ustar0000000000000000yaml-0.11.4.0/test/resources/loop/0000755000000000000000000000000013560466562015042 5ustar0000000000000000yaml-0.11.4.0/src/Data/Yaml.hs0000644000000000000000000001765713560466562014016 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} -- | Provides a high-level interface for processing YAML files. -- -- This module reuses most of the infrastructure from the @aeson@ package. -- This means that you can use all of the existing tools for JSON -- processing for processing YAML files. As a result, much of the -- documentation below mentions JSON; do not let that confuse you, it's -- intentional. -- -- For the most part, YAML content translates directly into JSON, and -- therefore there is very little data loss. If you need to deal with YAML -- more directly (e.g., directly deal with aliases), you should use the -- "Text.Libyaml" module instead. -- -- For documentation on the @aeson@ types, functions, classes, and -- operators, please see the @Data.Aeson@ module of the @aeson@ package. -- -- Look in the examples directory of the source repository for some initial -- pointers on how to use this library. #if (defined (ghcjs_HOST_OS)) module Data.Yaml {-# WARNING "GHCJS is not supported yet (will break at runtime once called)." #-} #else module Data.Yaml #endif ( -- * Encoding encode , encodeWith , encodeFile , encodeFileWith -- * Decoding , decodeEither' , decodeFileEither , decodeFileWithWarnings , decodeThrow , decodeFileThrow -- ** More control over decoding , decodeHelper -- * Types , Value (..) , Parser , Object , Array , ParseException(..) , prettyPrintParseException , YamlException (..) , YamlMark (..) -- * Constructors and accessors , object , array , (.=) , (.:) , (.:?) , (.!=) -- ** With helpers (since 0.8.23) , withObject , withText , withArray , withScientific , withBool -- * Parsing , parseMonad , parseEither , parseMaybe -- * Classes , ToJSON (..) , FromJSON (..) -- * Custom encoding , isSpecialString , EncodeOptions , defaultEncodeOptions , defaultStringStyle , setStringStyle , setFormat , FormatOptions , defaultFormatOptions , setWidth -- * Deprecated , decode , decodeFile , decodeEither ) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative((<$>)) #endif import Control.Exception import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Resource (MonadThrow, throwM) import Data.Aeson ( Value (..), ToJSON (..), FromJSON (..), object , (.=) , (.:) , (.:?) , (.!=) , Object, Array , withObject, withText, withArray, withScientific, withBool ) import Data.Aeson.Types (parseMaybe, parseEither, Parser) import Data.ByteString (ByteString) import Data.Conduit ((.|), runConduitRes) import qualified Data.Conduit.List as CL import qualified Data.Vector as V import System.IO.Unsafe (unsafePerformIO) import Data.Text (Text) import Data.Yaml.Internal import Text.Libyaml hiding (encode, decode, encodeFile, decodeFile, encodeWith, encodeFileWith) import qualified Text.Libyaml as Y -- | Set the string style in the encoded YAML. This is a function that decides -- for each string the type of YAML string to output. -- -- __WARNING__: You must ensure that special strings (like @"yes"@\/@"no"@\/@"null"@\/@"1234"@) are not encoded with the 'Plain' style, because -- then they will be decoded as boolean, null or numeric values. You can use 'isSpecialString' to detect them. -- -- By default, strings are encoded as follows: -- -- * Any string containing a newline character uses the 'Literal' style -- -- * Otherwise, any special string (see 'isSpecialString') uses 'SingleQuoted' -- -- * Otherwise, use 'Plain' -- -- @since 0.10.2.0 setStringStyle :: (Text -> ( Tag, Style )) -> EncodeOptions -> EncodeOptions setStringStyle s opts = opts { encodeOptionsStringStyle = s } -- | Set the encoding formatting for the encoded YAML. By default, this is `defaultFormatOptions`. -- -- @since 0.10.2.0 setFormat :: FormatOptions -> EncodeOptions -> EncodeOptions setFormat f opts = opts { encodeOptionsFormat = f } -- | -- @since 0.10.2.0 data EncodeOptions = EncodeOptions { encodeOptionsStringStyle :: Text -> ( Tag, Style ) , encodeOptionsFormat :: FormatOptions } -- | -- @since 0.10.2.0 defaultEncodeOptions :: EncodeOptions defaultEncodeOptions = EncodeOptions { encodeOptionsStringStyle = defaultStringStyle , encodeOptionsFormat = defaultFormatOptions } -- | Encode a value into its YAML representation. encode :: ToJSON a => a -> ByteString encode = encodeWith defaultEncodeOptions -- | Encode a value into its YAML representation with custom styling. -- -- @since 0.10.2.0 encodeWith :: ToJSON a => EncodeOptions -> a -> ByteString encodeWith opts obj = unsafePerformIO $ runConduitRes $ CL.sourceList (objToStream (encodeOptionsStringStyle opts) $ toJSON obj) .| Y.encodeWith (encodeOptionsFormat opts) -- | Encode a value into its YAML representation and save to the given file. encodeFile :: ToJSON a => FilePath -> a -> IO () encodeFile = encodeFileWith defaultEncodeOptions -- | Encode a value into its YAML representation with custom styling and save to the given file. -- -- @since 0.10.2.0 encodeFileWith :: ToJSON a => EncodeOptions -> FilePath -> a -> IO () encodeFileWith opts fp obj = runConduitRes $ CL.sourceList (objToStream (encodeOptionsStringStyle opts) $ toJSON obj) .| Y.encodeFileWith (encodeOptionsFormat opts) fp decode :: FromJSON a => ByteString -> Maybe a decode bs = unsafePerformIO $ either (const Nothing) snd <$> decodeHelper_ (Y.decode bs) {-# DEPRECATED decode "Please use decodeEither or decodeThrow, which provide information on how the decode failed" #-} decodeFile :: FromJSON a => FilePath -> IO (Maybe a) decodeFile fp = (fmap snd <$> decodeHelper (Y.decodeFile fp)) >>= either throwIO (return . either (const Nothing) id) {-# DEPRECATED decodeFile "Please use decodeFileEither, which does not confused type-directed and runtime exceptions." #-} -- | A version of 'decodeFile' which should not throw runtime exceptions. -- -- @since 0.8.4 decodeFileEither :: FromJSON a => FilePath -> IO (Either ParseException a) decodeFileEither = fmap (fmap snd) . decodeFileWithWarnings -- | A version of `decodeFileEither` that returns warnings along with the parse -- result. -- -- @since 0.10.0 decodeFileWithWarnings :: FromJSON a => FilePath -> IO (Either ParseException ([Warning], a)) decodeFileWithWarnings = decodeHelper_ . Y.decodeFile decodeEither :: FromJSON a => ByteString -> Either String a decodeEither bs = unsafePerformIO $ either (Left . prettyPrintParseException) id <$> (fmap snd <$> decodeHelper (Y.decode bs)) {-# DEPRECATED decodeEither "Please use decodeEither' or decodeThrow, which provide more useful failures" #-} -- | More helpful version of 'decodeEither' which returns the 'YamlException'. -- -- @since 0.8.3 decodeEither' :: FromJSON a => ByteString -> Either ParseException a decodeEither' = either Left (either (Left . AesonException) Right) . unsafePerformIO . fmap (fmap snd) . decodeHelper . Y.decode -- | A version of 'decodeEither'' lifted to MonadThrow -- -- @since 0.8.31 decodeThrow :: (MonadThrow m, FromJSON a) => ByteString -> m a decodeThrow = either throwM return . decodeEither' -- | A version of 'decodeFileEither' lifted to MonadIO -- -- @since 0.8.31 decodeFileThrow :: (MonadIO m, FromJSON a) => FilePath -> m a decodeFileThrow f = liftIO $ decodeFileEither f >>= either throwIO return -- | Construct a new 'Value' from a list of 'Value's. array :: [Value] -> Value array = Array . V.fromList #if MIN_VERSION_base(4, 13, 0) parseMonad :: MonadFail m => (a -> Parser b) -> a -> m b #else parseMonad :: Monad m => (a -> Parser b) -> a -> m b #endif parseMonad p = either fail return . parseEither p {-# DEPRECATED parseMonad "With the MonadFail split, this function is going to be removed in the future. Please migrate to parseEither." #-} yaml-0.11.4.0/src/Data/Yaml/Aeson.hs0000644000000000000000000000030113560466562015035 0ustar0000000000000000-- | Just a re-export of @Data.Yaml@. In the future, this will be the canonical -- name for that module\'s contents. module Data.Yaml.Aeson ( module Data.Yaml ) where import Data.Yaml yaml-0.11.4.0/src/Data/Yaml/Builder.hs0000644000000000000000000001542013654740177015367 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} -- | NOTE: This module is a highly experimental preview release. It may change -- drastically, or be entirely removed, in a future release. module Data.Yaml.Builder ( YamlBuilder (..) , ToYaml (..) , mapping , namedMapping , maybeNamedMapping , mappingComplex , namedMappingComplex , maybeNamedMappingComplex , array , namedArray , maybeNamedArray , string , namedString , maybeNamedString , bool , namedBool , maybeNamedBool , null , namedNull , maybeNamedNull , scientific , namedScientific , maybeNamedScientific , alias , number , toByteString , toByteStringWith , writeYamlFile , writeYamlFileWith , (.=) , FormatOptions , setWidth ) where import Prelude hiding (null) #if MIN_VERSION_aeson(1,0,0) import Data.Aeson.Text (encodeToTextBuilder) #else import Data.Aeson.Encode (encodeToTextBuilder) #endif import Data.Aeson.Types (Value(..)) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as S8 import Data.Conduit import Data.Scientific (Scientific) import Data.Text (Text, unpack) import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Builder (toLazyText) import System.IO.Unsafe (unsafePerformIO) import Data.Yaml.Internal import Text.Libyaml (.=) :: ToYaml a => Text -> a -> (Text, YamlBuilder) k .= v = (k, toYaml v) newtype YamlBuilder = YamlBuilder { unYamlBuilder :: [Event] -> [Event] } class ToYaml a where toYaml :: a -> YamlBuilder instance ToYaml YamlBuilder where toYaml = id instance (ToYaml a, ToYaml b) => ToYaml [(a, b)] where toYaml = mappingComplex . map (\(k, v) -> (toYaml k, toYaml v)) instance ToYaml a => ToYaml [a] where toYaml = array . map toYaml instance ToYaml Text where toYaml = string instance {-# OVERLAPPING #-} ToYaml String where toYaml = string . T.pack instance ToYaml Int where toYaml i = YamlBuilder (EventScalar (S8.pack $ show i) NoTag PlainNoTag Nothing:) instance ToYaml Double where toYaml i = YamlBuilder (EventScalar (S8.pack $ show i) NoTag PlainNoTag Nothing:) instance ToYaml Scientific where toYaml = scientific instance ToYaml Bool where toYaml = bool instance ToYaml a => ToYaml (Maybe a) where toYaml = maybe null toYaml -- | -- @since 0.10.3.0 maybeNamedMapping :: Maybe Text -> [(Text, YamlBuilder)] -> YamlBuilder maybeNamedMapping anchor pairs = maybeNamedMappingComplex anchor complexPairs where complexPairs = map (\(k, v) -> (string k, v)) pairs -- | -- @since 0.8.7 mapping :: [(Text, YamlBuilder)] -> YamlBuilder mapping = maybeNamedMapping Nothing -- | -- @since 0.10.3.0 namedMapping :: Text -> [(Text, YamlBuilder)] -> YamlBuilder namedMapping name = maybeNamedMapping $ Just name -- | -- @since 0.11.2.0 maybeNamedMappingComplex :: Maybe Text -> [(YamlBuilder, YamlBuilder)] -> YamlBuilder maybeNamedMappingComplex anchor pairs = YamlBuilder $ \rest -> EventMappingStart NoTag AnyMapping (unpack <$> anchor) : foldr addPair (EventMappingEnd : rest) pairs where addPair (YamlBuilder key, YamlBuilder value) after = key $ value after -- | -- @since 0.11.2.0 mappingComplex :: [(YamlBuilder, YamlBuilder)] -> YamlBuilder mappingComplex = maybeNamedMappingComplex Nothing -- | -- @since 0.11.2.0 namedMappingComplex :: Text -> [(YamlBuilder, YamlBuilder)] -> YamlBuilder namedMappingComplex name = maybeNamedMappingComplex $ Just name -- | -- @since 0.10.3.0 maybeNamedArray :: Maybe Text -> [YamlBuilder] -> YamlBuilder maybeNamedArray anchor bs = YamlBuilder $ (EventSequenceStart NoTag AnySequence (unpack <$> anchor):) . flip (foldr go) bs . (EventSequenceEnd:) where go (YamlBuilder b) = b -- | -- @since 0.8.7 array :: [YamlBuilder] -> YamlBuilder array = maybeNamedArray Nothing -- | -- @since 0.10.3.0 namedArray :: Text -> [YamlBuilder] -> YamlBuilder namedArray name = maybeNamedArray $ Just name -- | -- @since 0.10.3.0 maybeNamedString :: Maybe Text -> Text -> YamlBuilder maybeNamedString anchor s = YamlBuilder (stringScalar defaultStringStyle anchor s :) -- | -- @since 0.8.7 string :: Text -> YamlBuilder string = maybeNamedString Nothing -- | -- @since 0.10.3.0 namedString :: Text -> Text -> YamlBuilder namedString name = maybeNamedString $ Just name -- Use aeson's implementation which gets rid of annoying decimal points -- | -- @since 0.10.3.0 maybeNamedScientific :: Maybe Text -> Scientific -> YamlBuilder maybeNamedScientific anchor n = YamlBuilder (EventScalar (TE.encodeUtf8 $ TL.toStrict $ toLazyText $ encodeToTextBuilder (Number n)) NoTag PlainNoTag (unpack <$> anchor) :) -- | -- @since 0.8.13 scientific :: Scientific -> YamlBuilder scientific = maybeNamedScientific Nothing -- | -- @since 0.10.3.0 namedScientific :: Text -> Scientific -> YamlBuilder namedScientific name = maybeNamedScientific $ Just name -- | -- @since 0.8.13 {-# DEPRECATED number "Use scientific" #-} number :: Scientific -> YamlBuilder number = scientific -- | -- @since 0.10.3.0 maybeNamedBool :: Maybe Text -> Bool -> YamlBuilder maybeNamedBool anchor True = YamlBuilder (EventScalar "true" NoTag PlainNoTag (unpack <$> anchor) :) maybeNamedBool anchor False = YamlBuilder (EventScalar "false" NoTag PlainNoTag (unpack <$> anchor) :) -- | -- @since 0.8.13 bool :: Bool -> YamlBuilder bool = maybeNamedBool Nothing -- | -- @since 0.10.3.0 namedBool :: Text -> Bool -> YamlBuilder namedBool name = maybeNamedBool $ Just name -- | -- @since 0.10.3.0 maybeNamedNull :: Maybe Text -> YamlBuilder maybeNamedNull anchor = YamlBuilder (EventScalar "null" NoTag PlainNoTag (unpack <$> anchor) :) -- | -- @since 0.8.13 null :: YamlBuilder null = maybeNamedNull Nothing -- | -- @since 0.10.3.0 namedNull :: Text -> YamlBuilder namedNull name = maybeNamedNull $ Just name -- | -- @since 0.10.3.0 alias :: Text -> YamlBuilder alias anchor = YamlBuilder (EventAlias (unpack anchor) :) toEvents :: YamlBuilder -> [Event] toEvents (YamlBuilder front) = EventStreamStart : EventDocumentStart : front [EventDocumentEnd, EventStreamEnd] toSource :: (Monad m, ToYaml a) => a -> ConduitM i Event m () toSource = mapM_ yield . toEvents . toYaml -- | -- @since 0.8.7 toByteString :: ToYaml a => a -> ByteString toByteString = toByteStringWith defaultFormatOptions -- | -- @since 0.10.2.0 toByteStringWith :: ToYaml a => FormatOptions -> a -> ByteString toByteStringWith opts yb = unsafePerformIO $ runConduitRes $ toSource yb .| encodeWith opts writeYamlFile :: ToYaml a => FilePath -> a -> IO () writeYamlFile = writeYamlFileWith defaultFormatOptions -- | -- @since 0.10.2.0 writeYamlFileWith :: ToYaml a => FormatOptions -> FilePath -> a -> IO () writeYamlFileWith opts fp yb = runConduitRes $ toSource yb .| encodeFileWith opts fp yaml-0.11.4.0/src/Data/Yaml/Config.hs0000644000000000000000000001623113560466562015206 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -- | Functionality for using YAML as configuration files -- -- In particular, merging environment variables with yaml values -- -- 'loadYamlSettings' is a high-level API for loading YAML and merging environment variables. -- A yaml value of @_env:ENV_VAR:default@ will lookup the environment variable @ENV_VAR@. -- -- On a historical note, this code was taken directly from the yesod web framework's configuration module. module Data.Yaml.Config ( -- * High-level loadYamlSettings , loadYamlSettingsArgs -- ** EnvUsage , EnvUsage , ignoreEnv , useEnv , requireEnv , useCustomEnv , requireCustomEnv -- * Lower level , applyCurrentEnv , getCurrentEnv , applyEnvValue ) where #if __GLASGOW_HASKELL__ < 710 import Control.Applicative ((<$>)) import Data.Monoid #endif import Data.Semigroup import Data.List.NonEmpty (nonEmpty) import Data.Aeson import qualified Data.HashMap.Strict as H import Data.Text (Text, pack) import System.Environment (getArgs, getEnvironment) import Control.Arrow ((***)) import Control.Monad (forM) import Control.Exception (throwIO) import Data.Text.Encoding (encodeUtf8) import qualified Data.Yaml as Y import qualified Data.Yaml.Include as YI import Data.Maybe (fromMaybe) import qualified Data.Text as T newtype MergedValue = MergedValue { getMergedValue :: Value } instance Semigroup MergedValue where MergedValue x <> MergedValue y = MergedValue $ mergeValues x y -- | Left biased mergeValues :: Value -> Value -> Value mergeValues (Object x) (Object y) = Object $ H.unionWith mergeValues x y mergeValues x _ = x -- | Override environment variable placeholders in the given @Value@ with -- values from the environment. -- -- If the first argument is @True@, then all placeholders _must_ be provided by -- the actual environment. Otherwise, default values from the @Value@ will be -- used. -- -- @since 0.8.16 applyEnvValue :: Bool -- ^ require an environment variable to be present? -> H.HashMap Text Text -> Value -> Value applyEnvValue requireEnv' env = goV where goV (Object o) = Object $ goV <$> o goV (Array a) = Array (goV <$> a) goV (String t1) = fromMaybe (String t1) $ do t2 <- T.stripPrefix "_env:" t1 let (name, t3) = T.break (== ':') t2 mdef = fmap parseValue $ T.stripPrefix ":" t3 Just $ case H.lookup name env of Just val -> -- If the default value parses as a String, we treat the -- environment variable as a raw value and do not parse it. -- This means that things like numeric passwords just work. -- However, for originally numerical or boolean values (e.g., -- port numbers), we still perform a normal YAML parse. -- -- For details, see: -- https://github.com/yesodweb/yesod/issues/1061 case mdef of Just (String _) -> String val _ -> parseValue val Nothing -> case mdef of Just val | not requireEnv' -> val _ -> Null goV v = v parseValue val = either (const (String val)) id (Y.decodeThrow $ encodeUtf8 val) -- | Get the actual environment as a @HashMap@ from @Text@ to @Text@. -- -- @since 0.8.16 getCurrentEnv :: IO (H.HashMap Text Text) getCurrentEnv = fmap (H.fromList . map (pack *** pack)) getEnvironment -- | A convenience wrapper around 'applyEnvValue' and 'getCurrentEnv' -- -- @since 0.8.16 applyCurrentEnv :: Bool -- ^ require an environment variable to be present? -> Value -> IO Value applyCurrentEnv requireEnv' orig = flip (applyEnvValue requireEnv') orig <$> getCurrentEnv -- | Defines how we want to use the environment variables when loading a config -- file. Use the smart constructors provided by this module. -- -- @since 0.8.16 data EnvUsage = IgnoreEnv | UseEnv | RequireEnv | UseCustomEnv (H.HashMap Text Text) | RequireCustomEnv (H.HashMap Text Text) -- | Do not use any environment variables, instead relying on defaults values -- in the config file. -- -- @since 0.8.16 ignoreEnv :: EnvUsage ignoreEnv = IgnoreEnv -- | Use environment variables when available, otherwise use defaults. -- -- @since 0.8.16 useEnv :: EnvUsage useEnv = UseEnv -- | Do not use default values from the config file, but instead take all -- overrides from the environment. If a value is missing, loading the file will -- throw an exception. -- -- @since 0.8.16 requireEnv :: EnvUsage requireEnv = RequireEnv -- | Same as 'useEnv', but instead of the actual environment, use the provided -- @HashMap@ as the environment. -- -- @since 0.8.16 useCustomEnv :: H.HashMap Text Text -> EnvUsage useCustomEnv = UseCustomEnv -- | Same as 'requireEnv', but instead of the actual environment, use the -- provided @HashMap@ as the environment. -- -- @since 0.8.16 requireCustomEnv :: H.HashMap Text Text -> EnvUsage requireCustomEnv = RequireCustomEnv -- | Load the settings from the following three sources: -- -- * Run time config files -- -- * Run time environment variables -- -- * The default compile time config file -- -- For example, to load up settings from @config/foo.yaml@ and allow overriding -- from the actual environment, you can use: -- -- > loadYamlSettings ["config/foo.yaml"] [] useEnv -- -- @since 0.8.16 loadYamlSettings :: FromJSON settings => [FilePath] -- ^ run time config files to use, earlier files have precedence -> [Value] -- ^ any other values to use, usually from compile time config. overridden by files -> EnvUsage -> IO settings loadYamlSettings runTimeFiles compileValues envUsage = do runValues <- forM runTimeFiles $ \fp -> do eres <- YI.decodeFileEither fp case eres of Left e -> throwIO (Y.LoadSettingsException fp e) Right value -> return value value' <- case nonEmpty $ map MergedValue $ runValues ++ compileValues of Nothing -> error "loadYamlSettings: No configuration provided" Just ne -> return $ getMergedValue $ sconcat ne value <- case envUsage of IgnoreEnv -> return $ applyEnvValue False mempty value' UseEnv -> applyCurrentEnv False value' RequireEnv -> applyCurrentEnv True value' UseCustomEnv env -> return $ applyEnvValue False env value' RequireCustomEnv env -> return $ applyEnvValue True env value' case Y.parseEither parseJSON value of Left s -> error $ "Could not convert to expected type: " ++ s Right settings -> return settings -- | Same as @loadYamlSettings@, but get the list of runtime config files from -- the command line arguments. -- -- @since 0.8.17 loadYamlSettingsArgs :: FromJSON settings => [Value] -- ^ any other values to use, usually from compile time config. overridden by files -> EnvUsage -- ^ use environment variables -> IO settings loadYamlSettingsArgs values env = do args <- getArgs loadYamlSettings args values env yaml-0.11.4.0/src/Data/Yaml/Include.hs0000644000000000000000000000557413560466562015374 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} module Data.Yaml.Include ( decodeFile , decodeFileEither , decodeFileWithWarnings ) where #if !MIN_VERSION_directory(1, 2, 3) import Control.Exception (handleJust) import Control.Monad (guard) import System.IO.Error (ioeGetFileName, ioeGetLocation, isDoesNotExistError) #endif import Control.Exception (throwIO) import Control.Monad (when) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Resource (MonadResource) 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(..), Warning(..), decodeHelper_, decodeHelper) import Text.Libyaml hiding (decodeFile) import qualified Text.Libyaml as Y eventsFromFile :: MonadResource m => FilePath -> ConduitM i Event m () eventsFromFile = go [] where go :: MonadResource m => [FilePath] -> FilePath -> ConduitM i Event m () go seen fp = do cfp <- liftIO $ handleNotFound $ canonicalizePath fp when (cfp `elem` seen) $ do liftIO $ throwIO CyclicIncludes Y.decodeFile cfp .| do awaitForever $ \event -> case event of EventScalar f (UriTag "!include") _ _ -> do let includeFile = takeDirectory cfp unpack (decodeUtf8 f) go (cfp : seen) includeFile .| CL.filter (`notElem` irrelevantEvents) _ -> yield event irrelevantEvents = [EventStreamStart, EventDocumentStart, EventDocumentEnd, EventStreamEnd] #if !MIN_VERSION_directory(1, 2, 3) handleNotFound = handleJust (\e -> do guard (isDoesNotExistError e) guard (ioeGetLocation e == "canonicalizePath") ioeGetFileName e) (throwIO . YamlException . ("Yaml file not found: " ++)) #else handleNotFound = id #endif -- | Like `Data.Yaml.decodeFile` but with support for relative and absolute -- includes. -- -- The syntax for includes follows the form: -- -- > somekey: !include ./somefile.yaml decodeFile :: FromJSON a => FilePath -> IO (Maybe a) decodeFile fp = (fmap snd <$> decodeHelper (eventsFromFile fp)) >>= either throwIO (return . either (const Nothing) id) -- | Like `Data.Yaml.decodeFileEither` but with support for relative and -- absolute includes. -- -- The syntax for includes follows the form: -- -- > somekey: !include ./somefile.yaml decodeFileEither :: FromJSON a => FilePath -> IO (Either ParseException a) decodeFileEither = fmap (fmap snd) . decodeFileWithWarnings -- | A version of `decodeFileEither` that returns warnings along with the parse -- result. -- -- @since 0.10.0 decodeFileWithWarnings :: FromJSON a => FilePath -> IO (Either ParseException ([Warning], a)) decodeFileWithWarnings = decodeHelper_ . eventsFromFile yaml-0.11.4.0/src/Data/Yaml/Internal.hs0000644000000000000000000003623713631616153015555 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE BangPatterns #-} module Data.Yaml.Internal ( ParseException(..) , prettyPrintParseException , Warning(..) , parse , decodeHelper , decodeHelper_ , textToScientific , stringScalar , defaultStringStyle , isSpecialString , specialStrings , isNumeric , objToStream , objToEvents ) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>), Applicative(..)) #endif import Control.Applicative ((<|>)) import Control.Exception import Control.Monad (when, unless) import Control.Monad.Trans.Resource (ResourceT, runResourceT) import Control.Monad.State.Strict import Control.Monad.Reader import Data.Aeson import Data.Aeson.Internal (JSONPath, JSONPathElement(..), formatError) import Data.Aeson.Types hiding (parse) import qualified Data.Attoparsec.Text as Atto import Data.Bits (shiftL, (.|.)) import Data.ByteString (ByteString) import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Lazy as BL import Data.ByteString.Builder.Scientific (scientificBuilder) import Data.Char (toUpper, ord) import Data.List import Data.Conduit ((.|), ConduitM, runConduit) import qualified Data.Conduit.List as CL import qualified Data.HashMap.Strict as M import qualified Data.HashSet as HashSet import Data.Map (Map) import qualified Data.Map as Map import Data.Set (Set) import qualified Data.Set as Set import Data.Scientific (Scientific, base10Exponent, coefficient) import Data.Text (Text, pack) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8With, encodeUtf8) import Data.Text.Encoding.Error (lenientDecode) import Data.Typeable 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 , _expected :: Maybe Event } | InvalidYaml (Maybe YamlException) | AesonException String | OtherParseException SomeException | NonStringKey JSONPath | NonStringKeyAlias Y.AnchorName Value | CyclicIncludes | LoadSettingsException FilePath ParseException deriving (Show, Typeable) instance Exception ParseException where #if MIN_VERSION_base(4, 8, 0) displayException = prettyPrintParseException #endif -- | Alternative to 'show' to display a 'ParseException' on the screen. -- Instead of displaying the data constructors applied to their arguments, -- a more textual output is returned. For example, instead of printing: -- -- > InvalidYaml (Just (YamlParseException {yamlProblem = "did not find expected ',' or '}'", yamlContext = "while parsing a flow mapping", yamlProblemMark = YamlMark {yamlIndex = 42, yamlLine = 2, yamlColumn = 12}}))) -- -- It looks more pleasant to print: -- -- > YAML parse exception at line 2, column 12, -- > while parsing a flow mapping: -- > did not find expected ',' or '}' -- -- Since 0.8.11 prettyPrintParseException :: ParseException -> String prettyPrintParseException pe = case pe of NonScalarKey -> "Non scalar key" UnknownAlias anchor -> "Unknown alias `" ++ anchor ++ "`" UnexpectedEvent { _expected = mbExpected, _received = mbUnexpected } -> unlines [ "Unexpected event: expected" , " " ++ show mbExpected , "but received" , " " ++ show mbUnexpected ] InvalidYaml mbYamlError -> case mbYamlError of Nothing -> "Unspecified YAML error" Just yamlError -> case yamlError of YamlException s -> "YAML exception:\n" ++ s YamlParseException problem context mark -> concat [ "YAML parse exception at line " ++ show (yamlLine mark) ++ ", column " ++ show (yamlColumn mark) , case context of "" -> ":\n" -- The context seems to include a leading "while" or similar. _ -> ",\n" ++ context ++ ":\n" , problem ] AesonException s -> "Aeson exception:\n" ++ s OtherParseException exc -> "Generic parse exception:\n" ++ show exc NonStringKey path -> formatError path "Non-string keys are not supported" NonStringKeyAlias anchor value -> unlines [ "Non-string key alias:" , " Anchor name: " ++ anchor , " Value: " ++ show value ] CyclicIncludes -> "Cyclic includes" LoadSettingsException fp exc -> "Could not parse file as YAML: " ++ fp ++ "\n" ++ prettyPrintParseException exc defineAnchor :: Value -> String -> ReaderT JSONPath (ConduitM e o Parse) () defineAnchor value name = modify (modifyAnchors $ Map.insert name value) where modifyAnchors :: (Map String Value -> Map String Value) -> ParseState -> ParseState modifyAnchors f st = st {parseStateAnchors = f (parseStateAnchors st)} lookupAnchor :: String -> ReaderT JSONPath (ConduitM e o Parse) (Maybe Value) lookupAnchor name = gets (Map.lookup name . parseStateAnchors) data Warning = DuplicateKey JSONPath deriving (Eq, Show) addWarning :: Warning -> ReaderT JSONPath (ConduitM e o Parse) () addWarning w = modify (modifyWarnings (w :)) where modifyWarnings :: ([Warning] -> [Warning]) -> ParseState -> ParseState modifyWarnings f st = st {parseStateWarnings = f (parseStateWarnings st)} data ParseState = ParseState { parseStateAnchors :: Map String Value , parseStateWarnings :: [Warning] } type Parse = StateT ParseState (ResourceT IO) requireEvent :: Event -> ReaderT JSONPath (ConduitM Event o Parse) () requireEvent e = do f <- lift CL.head unless (f == Just e) $ liftIO $ throwIO $ UnexpectedEvent f $ Just e parse :: ReaderT JSONPath (ConduitM Event o Parse) Value parse = do streamStart <- lift CL.head case streamStart of Nothing -> -- empty string input return Null Just EventStreamStart -> do documentStart <- lift CL.head case documentStart of Just EventStreamEnd -> -- empty file input, comment only string/file input return Null Just EventDocumentStart -> do res <- parseO requireEvent EventDocumentEnd requireEvent EventStreamEnd return res _ -> liftIO $ throwIO $ UnexpectedEvent documentStart Nothing _ -> liftIO $ throwIO $ UnexpectedEvent streamStart Nothing parseScalar :: ByteString -> Anchor -> Style -> Tag -> ReaderT JSONPath (ConduitM Event o Parse) Text parseScalar v a style tag = do let res = decodeUtf8With lenientDecode v mapM_ (defineAnchor (textToValue style tag res)) a return res textToValue :: Style -> Tag -> Text -> Value textToValue SingleQuoted _ t = String t textToValue DoubleQuoted _ t = String t textToValue _ StrTag t = String t textToValue Folded _ t = String t textToValue _ _ t | t `elem` ["null", "Null", "NULL", "~", ""] = Null | any (t `isLike`) ["y", "yes", "on", "true"] = Bool True | any (t `isLike`) ["n", "no", "off", "false"] = Bool False | Right x <- textToScientific t = Number x | 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 textToScientific :: Text -> Either String Scientific textToScientific = Atto.parseOnly (num <* Atto.endOfInput) where num = (fromInteger <$> ("0x" *> Atto.hexadecimal)) <|> (fromInteger <$> ("0o" *> octal)) <|> Atto.scientific octal = T.foldl' step 0 <$> Atto.takeWhile1 isOctalDigit where isOctalDigit c = (c >= '0' && c <= '7') step a c = (a `shiftL` 3) .|. fromIntegral (ord c - 48) parseO :: ReaderT JSONPath (ConduitM Event o Parse) Value parseO = do me <- lift CL.head case me of Just (EventScalar v tag style a) -> textToValue style tag <$> parseScalar v a style tag Just (EventSequenceStart _ _ a) -> parseS 0 a id Just (EventMappingStart _ _ a) -> parseM mempty a M.empty Just (EventAlias an) -> do m <- lookupAnchor an case m of Nothing -> liftIO $ throwIO $ UnknownAlias an Just v -> return v _ -> liftIO $ throwIO $ UnexpectedEvent me Nothing parseS :: Int -> Y.Anchor -> ([Value] -> [Value]) -> ReaderT JSONPath (ConduitM Event o Parse) Value parseS !n a front = do me <- lift CL.peek case me of Just EventSequenceEnd -> do lift $ CL.drop 1 let res = Array $ V.fromList $ front [] mapM_ (defineAnchor res) a return res _ -> do o <- local (Index n :) parseO parseS (succ n) a $ front . (:) o parseM :: Set Text -> Y.Anchor -> M.HashMap Text Value -> ReaderT JSONPath (ConduitM Event o Parse) Value parseM mergedKeys a front = do me <- lift CL.head case me of Just EventMappingEnd -> do let res = Object front mapM_ (defineAnchor res) a return res _ -> do s <- case me of Just (EventScalar v tag style a') -> parseScalar v a' style tag Just (EventAlias an) -> do m <- lookupAnchor an case m of Nothing -> liftIO $ throwIO $ UnknownAlias an Just (String t) -> return t Just v -> liftIO $ throwIO $ NonStringKeyAlias an v _ -> do path <- ask liftIO $ throwIO $ NonStringKey path (mergedKeys', al') <- local (Key s :) $ do o <- parseO let al = do when (M.member s front && Set.notMember s mergedKeys) $ do path <- reverse <$> ask addWarning (DuplicateKey path) return (Set.delete s mergedKeys, M.insert s o front) if s == pack "<<" then case o of Object l -> return (merge l) Array l -> return $ merge $ foldl' mergeObjects M.empty $ V.toList l _ -> al else al parseM mergedKeys' a al' where mergeObjects al (Object om) = M.union al om mergeObjects al _ = al merge xs = (Set.fromList (M.keys xs \\ M.keys front), M.union front xs) decodeHelper :: FromJSON a => ConduitM () Y.Event Parse () -> IO (Either ParseException ([Warning], Either String a)) decodeHelper src = do -- This used to be tryAny, but the fact is that catching async -- exceptions is fine here. We'll rethrow them immediately in the -- otherwise clause. x <- try $ runResourceT $ runStateT (runConduit $ src .| runReaderT parse []) (ParseState Map.empty []) case x of Left e | Just pe <- fromException e -> return $ Left pe | Just ye <- fromException e -> return $ Left $ InvalidYaml $ Just (ye :: YamlException) | otherwise -> throwIO e Right (y, st) -> return $ Right (parseStateWarnings st, parseEither parseJSON y) decodeHelper_ :: FromJSON a => ConduitM () Event Parse () -> IO (Either ParseException ([Warning], a)) decodeHelper_ src = do x <- try $ runResourceT $ runStateT (runConduit $ src .| runReaderT parse []) (ParseState Map.empty []) case x of Left e | Just pe <- fromException e -> return $ Left pe | Just ye <- fromException e -> return $ Left $ InvalidYaml $ Just (ye :: YamlException) | Just sae <- fromException e -> throwIO (sae :: SomeAsyncException) | otherwise -> return $ Left $ OtherParseException e Right (y, st) -> return $ either (Left . AesonException) Right ((,) (parseStateWarnings st) <$> parseEither parseJSON y) type StringStyle = Text -> ( Tag, Style ) -- | Encodes a string with the supplied style. This function handles the empty -- string case properly to avoid https://github.com/snoyberg/yaml/issues/24 -- -- @since 0.11.2.0 stringScalar :: StringStyle -> Maybe Text -> Text -> Event stringScalar _ anchor "" = EventScalar "" NoTag SingleQuoted (T.unpack <$> anchor) stringScalar stringStyle anchor s = EventScalar (encodeUtf8 s) tag style (T.unpack <$> anchor) where ( tag, style ) = stringStyle s -- | -- @since 0.11.2.0 defaultStringStyle :: StringStyle defaultStringStyle = \s -> case () of () | "\n" `T.isInfixOf` s -> ( NoTag, Literal ) | isSpecialString s -> ( NoTag, SingleQuoted ) | otherwise -> ( NoTag, PlainNoTag ) -- | Determine whether a string must be quoted in YAML and can't appear as plain text. -- Useful if you want to use 'setStringStyle'. -- -- @since 0.10.2.0 isSpecialString :: Text -> Bool isSpecialString s = s `HashSet.member` specialStrings || isNumeric s -- | Strings which must be escaped so as not to be treated as non-string scalars. -- -- @since 0.8.32 specialStrings :: HashSet.HashSet Text specialStrings = HashSet.fromList $ T.words "y Y yes Yes YES n N no No NO true True TRUE false False FALSE on On ON off Off OFF null Null NULL ~ *" -- | -- @since 0.8.32 isNumeric :: Text -> Bool isNumeric = either (const False) (const True) . textToScientific -- | Encode a value as a YAML document stream. -- -- @since 0.11.2.0 objToStream :: ToJSON a => StringStyle -> a -> [Y.Event] objToStream stringStyle o = (:) EventStreamStart . (:) EventDocumentStart $ objToEvents stringStyle o [ EventDocumentEnd , EventStreamEnd ] -- | Encode a value as a list of 'Event's. -- -- @since 0.11.2.0 objToEvents :: ToJSON a => StringStyle -> a -> [Y.Event] -> [Y.Event] objToEvents stringStyle = objToEvents' . toJSON where objToEvents' (Array list) rest = EventSequenceStart NoTag AnySequence Nothing : foldr objToEvents' (EventSequenceEnd : rest) (V.toList list) objToEvents' (Object o) rest = EventMappingStart NoTag AnyMapping Nothing : foldr pairToEvents (EventMappingEnd : rest) (M.toList o) where pairToEvents :: Pair -> [Y.Event] -> [Y.Event] pairToEvents (k, v) = objToEvents' (String k) . objToEvents' v objToEvents' (String s) rest = stringScalar stringStyle Nothing s : rest 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 objToEvents' (Number s) rest = let builder -- Special case the 0 exponent to remove the trailing .0 | base10Exponent s == 0 = BB.integerDec $ coefficient s | otherwise = scientificBuilder s lbs = BB.toLazyByteString builder bs = BL.toStrict lbs in EventScalar bs IntTag PlainNoTag Nothing : rest yaml-0.11.4.0/src/Data/Yaml/Parser.hs0000644000000000000000000001451613560466562015241 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} -- | NOTE: This module is a highly experimental preview release. It may change -- drastically, or be entirely removed, in a future release. module Data.Yaml.Parser where import Control.Applicative import Control.Exception (Exception) import Control.Monad (MonadPlus (..), liftM, ap) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Resource (MonadThrow, throwM) import Control.Monad.Trans.Writer.Strict (tell, WriterT) import Data.ByteString (ByteString) import Data.Conduit import Data.Conduit.Lift (runWriterC) import qualified Data.Map as Map #if !MIN_VERSION_base(4,8,0) import Data.Monoid (Monoid (..)) #endif #if !MIN_VERSION_base(4,11,0) import Data.Semigroup (Semigroup(..)) #endif import Data.Text (Text, pack, unpack) import Data.Text.Encoding (decodeUtf8) 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 = YamlParser . const . Right (<*>) = ap instance Alternative YamlParser where empty = fail "empty" (<|>) = mplus instance Semigroup (YamlParser a) where (<>) = mplus instance Monoid (YamlParser a) where mempty = fail "mempty" #if !MIN_VERSION_base(4,11,0) mappend = (<>) #endif instance Monad YamlParser where return = pure YamlParser f >>= g = YamlParser $ \am -> case f am of Left t -> Left t Right x -> unYamlParser (g x) am #if MIN_VERSION_base(4,13,0) instance MonadFail YamlParser where #endif fail = YamlParser . const . Left . pack instance MonadPlus YamlParser where mzero = fail "mzero" mplus a b = YamlParser $ \am -> case unYamlParser a am of Left _ -> unYamlParser b am x -> x lookupAnchor :: AnchorName -> YamlParser (Maybe YamlValue) lookupAnchor name = YamlParser $ Right . Map.lookup name withAnchor :: AnchorName -> Text -> (YamlValue -> YamlParser a) -> YamlParser a withAnchor name expected f = do mv <- lookupAnchor name case mv of Nothing -> fail $ unpack expected ++ ": unknown alias " ++ name Just v -> f v withMapping :: Text -> ([(Text, YamlValue)] -> YamlParser a) -> YamlValue -> YamlParser a withMapping _ f (Mapping m _) = f m withMapping expected f (Alias an) = withAnchor an expected $ withMapping expected f withMapping expected _ v = typeMismatch expected v withSequence :: Text -> ([YamlValue] -> YamlParser a) -> YamlValue -> YamlParser a withSequence _ f (Sequence s _) = f s withSequence expected f (Alias an) = withAnchor an expected $ withSequence expected f withSequence expected _ v = typeMismatch expected v withText :: Text -> (Text -> YamlParser a) -> YamlValue -> YamlParser a withText _ f (Scalar s _ _ _) = f $ decodeUtf8 s withText expected f (Alias an) = withAnchor an expected $ withText expected f withText expected _ v = typeMismatch expected v typeMismatch :: Text -> YamlValue -> YamlParser a typeMismatch expected v = fail $ concat [ "Expected " , unpack expected , ", but got: " , t ] where t = case v of Mapping _ _ -> "mapping" Sequence _ _ -> "sequence" Scalar _ _ _ _ -> "scalar" Alias _ -> "alias" class FromYaml a where fromYaml :: YamlValue -> YamlParser a instance FromYaml YamlValue where fromYaml = return instance FromYaml a => FromYaml [a] where fromYaml = withSequence "[a]" (mapM fromYaml) instance FromYaml Text where fromYaml = withText "Text" return instance FromYaml Int where fromYaml = withText "Int" go where go t = case signed decimal t of Right (i, "") -> return i _ -> fail $ "Invalid Int: " ++ unpack t data YamlValue = Mapping [(Text, YamlValue)] Anchor | Sequence [YamlValue] Anchor | Scalar ByteString Tag Style Anchor | Alias AnchorName deriving Show type AnchorMap = Map.Map AnchorName YamlValue data RawDoc = RawDoc YamlValue AnchorMap deriving Show parseRawDoc :: (FromYaml a, MonadThrow m) => RawDoc -> m a parseRawDoc (RawDoc val am) = case unYamlParser (fromYaml val) am of Left t -> throwM $ FromYamlException t Right x -> return x (.:) :: FromYaml a => [(Text, YamlValue)] -> Text -> YamlParser a o .: k = case lookup k o of Nothing -> fail $ "Key not found: " ++ unpack k Just v -> fromYaml v data YamlParseException = UnexpectedEndOfEvents | UnexpectedEvent Event | FromYamlException Text deriving (Show, Typeable) instance Exception YamlParseException sinkValue :: MonadThrow m => ConduitM Event o (WriterT AnchorMap m) YamlValue sinkValue = start where start = await >>= maybe (throwM UnexpectedEndOfEvents) go tell' Nothing val = return val tell' (Just name) val = do lift $ tell $ Map.singleton name val return val go EventStreamStart = start go EventDocumentStart = start go (EventAlias a) = return $ Alias a go (EventScalar a b c d) = tell' d $ Scalar a b c d go (EventSequenceStart _tag _style mname) = do vals <- goS id let val = Sequence vals mname tell' mname val go (EventMappingStart _tag _style mname) = do pairs <- goM id let val = Mapping pairs mname tell' mname val go e = throwM $ UnexpectedEvent e goS front = do me <- await case me of Nothing -> throwM UnexpectedEndOfEvents Just EventSequenceEnd -> return $ front [] Just e -> do val <- go e goS (front . (val:)) goM front = do mk <- await case mk of Nothing -> throwM UnexpectedEndOfEvents Just EventMappingEnd -> return $ front [] Just (EventScalar a b c d) -> do _ <- tell' d $ Scalar a b c d let k = decodeUtf8 a v <- start goM (front . ((k, v):)) Just e -> throwM $ UnexpectedEvent e sinkRawDoc :: MonadThrow m => ConduitM Event o m RawDoc sinkRawDoc = uncurry RawDoc <$> runWriterC sinkValue readYamlFile :: FromYaml a => FilePath -> IO a readYamlFile fp = runConduitRes (decodeFile fp .| sinkRawDoc) >>= parseRawDoc yaml-0.11.4.0/src/Data/Yaml/Pretty.hs0000644000000000000000000000425513560466562015273 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | Prettier YAML encoding. -- -- @since 0.8.13 module Data.Yaml.Pretty ( encodePretty , Config , getConfCompare , setConfCompare , getConfDropNull , setConfDropNull , defConfig , pretty ) where import Prelude hiding (null) #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif import Data.Aeson.Types import Data.ByteString (ByteString) import Data.Function (on) import qualified Data.HashMap.Strict as HM import Data.List (sortBy) #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 { confCompare :: Text -> Text -> Ordering -- ^ Function used to sort keys in objects , confDropNull :: Bool -- ^ Drop null values from objects } -- | The default configuration: do not sort objects or drop keys -- -- @since 0.8.13 defConfig :: Config defConfig = Config mempty False -- | -- @since 0.8.13 getConfCompare :: Config -> Text -> Text -> Ordering getConfCompare = confCompare -- | Sets ordering for object keys -- -- @since 0.8.13 setConfCompare :: (Text -> Text -> Ordering) -> Config -> Config setConfCompare cmp c = c { confCompare = cmp } -- | -- @since 0.8.24 getConfDropNull :: Config -> Bool getConfDropNull = confDropNull -- | Drop entries with `Null` value from objects, if set to `True` -- -- @since 0.8.24 setConfDropNull :: Bool -> Config -> Config setConfDropNull m c = c { confDropNull = m } pretty :: Config -> Value -> YamlBuilder pretty cfg = go where go (Object o) = let sort = sortBy (confCompare cfg `on` fst) select | confDropNull cfg = HM.filter (/= Null) | otherwise = id in mapping (sort $ HM.toList $ HM.map go $ select o) go (Array a) = array (go <$> V.toList a) go Null = null go (String s) = string s go (Number n) = scientific n go (Bool b) = bool b -- | Configurable 'encode'. -- -- @since 0.8.13 encodePretty :: ToJSON a => Config -> a -> ByteString encodePretty cfg = toByteString . pretty cfg . toJSON yaml-0.11.4.0/src/Data/Yaml/TH.hs0000644000000000000000000000321213560466562014307 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} module Data.Yaml.TH ( -- * Decoding yamlQQ #if MIN_VERSION_template_haskell(2,9,0) , decodeFile #endif -- * Re-exports from "Data.Yaml" , Value (..) , Parser , Object , Array , object , array , (.=) , (.:) , (.:?) , (.!=) , FromJSON (..) ) where import Data.Text.Encoding import qualified Data.Text as T import Language.Haskell.TH import Language.Haskell.TH.Syntax import Language.Haskell.TH.Quote import Data.Yaml hiding (decodeFile) -- | Decode a YAML file at compile time. Only available on GHC version @7.8.1@ -- or higher. -- -- @since 0.8.19.0 -- -- ==== __Examples__ -- -- @ -- {-\# LANGUAGE TemplateHaskell \#-} -- -- config :: Config -- config = $$('decodeFile' "config.yaml") -- @ decodeFile :: forall a. (Lift a, FromJSON a) => FilePath -> Q (TExp a) decodeFile path = do addDependentFile path x <- runIO $ decodeFileThrow path fmap TExp (lift (x :: a)) yamlExp :: String -> Q Exp yamlExp input = do val <- runIO $ decodeThrow $ encodeUtf8 $ T.pack input lift (val :: Value) -- | A @QuasiQuoter@ for YAML. -- -- @since 0.8.28.0 -- -- ==== __Examples__ -- -- @ -- {-\# LANGUAGE QuasiQuotes \#-} -- import Data.Yaml.TH -- -- value :: Value -- value = [yamlQQ| -- name: John Doe -- age: 23 -- |] -- @ yamlQQ :: QuasiQuoter yamlQQ = QuasiQuoter { quoteExp = yamlExp , quotePat = notDefined "quotePat" , quoteType = notDefined "quoteType" , quoteDec = notDefined "quoteDec" } where notDefined name _ = fail (name ++ " is not defined for yamlQQ") yaml-0.11.4.0/exe/yaml2json.hs0000644000000000000000000000167013560466562014137 0ustar0000000000000000import Prelude hiding (putStr, getContents) import Data.Aeson (encode, Value) import Data.ByteString (getContents) import Data.ByteString.Lazy (putStr) import System.Environment (getArgs) import System.Exit import System.IO (stderr, hPutStrLn) import Data.Yaml (decodeFileEither, decodeEither') helpMessage :: IO () helpMessage = putStrLn "Usage: yaml2json FILE\n\nuse '-' as FILE to indicate stdin" >> exitFailure showJSON :: Show a => Either a Value -> IO b showJSON ejson = case ejson of Left err -> hPutStrLn stderr (show err) >> exitFailure Right res -> putStr (encode (res :: Value)) >> exitSuccess main :: IO () main = do args <- getArgs case args of -- strict getContents will read in all of stdin at once (["-h"]) -> helpMessage (["--help"]) -> helpMessage (["-"]) -> getContents >>= showJSON . decodeEither' ([f]) -> decodeFileEither f >>= showJSON _ -> helpMessage yaml-0.11.4.0/exe/json2yaml.hs0000644000000000000000000000126313560466562014135 0ustar0000000000000000import qualified Data.Aeson as J import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import System.Environment (getArgs) import qualified Data.Yaml as Y main :: IO () main = do args <- getArgs (input, output) <- case args ++ replicate (2 - length args) "-" of [i, o] -> return (i, o) _ -> fail "Usage: json2yaml [in] [out]" mval <- fmap J.decode $ case input of "-" -> L.getContents _ -> L.readFile input case mval of Nothing -> error "Invalid input JSON" Just val -> case output of "-" -> S.putStr $ Y.encode (val :: Y.Value) _ -> Y.encodeFile output val yaml-0.11.4.0/examples/Main.hs0000644000000000000000000000017113560466562014135 0ustar0000000000000000module Main where import qualified Config import qualified Simple main :: IO () main = do Simple.main Config.main yaml-0.11.4.0/examples/Config.hs0000644000000000000000000000222313560466562014456 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} module Config where import Data.Text (Text) import qualified Data.Yaml as Y import Data.Yaml (FromJSON(..), (.:)) import Text.RawString.QQ import Data.ByteString (ByteString) import Control.Applicative import Prelude -- Ensure Applicative is in scope and we have no warnings, before/after AMP. configYaml :: ByteString configYaml = [r| resolver: lts-3.7 packages: - ./yesod-core - ./yesod-static - ./yesod-persistent - ./yesod-newsfeed - ./yesod-form - ./yesod-auth - ./yesod-auth-oauth - ./yesod-sitemap - ./yesod-test - ./yesod-bin - ./yesod - ./yesod-eventsource - ./yesod-websockets # Needed for LTS 2 extra-deps: - wai-app-static-3.1.4.1 |] data Config = Config { resolver :: Text , packages :: [FilePath] , extraDeps :: [Text] } deriving (Eq, Show) instance FromJSON Config where parseJSON (Y.Object v) = Config <$> v .: "resolver" <*> v .: "packages" <*> v .: "extra-deps" parseJSON _ = fail "Expected Object for Config value" main :: IO () main = do config <- Y.decodeThrow configYaml print (config :: Config) yaml-0.11.4.0/examples/Simple.hs0000644000000000000000000000061613560466562014506 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Simple where import qualified Data.Yaml as Y main :: IO () main = do res <- Y.decodeThrow "[1,2,3]" print (res :: [Integer]) -- You can go one step further and decode into a custom type by implementing -- 'FromJSON' for that type. This is also appropriate where extra -- normalization, formatting or manipulation of the YAML is required on decode. yaml-0.11.4.0/test/Spec.hs0000644000000000000000000000005413560466562013304 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} yaml-0.11.4.0/test/Data/Yaml/IncludeSpec.hs0000644000000000000000000001015513560466562016366 0ustar0000000000000000{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-} module Data.Yaml.IncludeSpec (main, spec) where import Test.Hspec import Data.List (isPrefixOf) import qualified Data.ByteString.Lazy as LB import Data.Aeson import Data.Aeson.Internal (JSONPathElement(..)) import Data.Yaml (ParseException(InvalidYaml)) import Data.Yaml.Include import Data.Yaml.Internal import Text.Libyaml (YamlException(YamlException)) import Test.Mockery.Directory import Text.RawString.QQ import Data.Yaml.TH (yamlQQ) main :: IO () main = hspec spec asInt :: Int -> Int asInt = id spec :: Spec spec = do describe "decodeFile" $ do it "supports includes" $ do decodeFile "test/resources/foo.yaml" `shouldReturn` Just (object [ "foo" .= asInt 23 , "bar" .= object [ "one" .= asInt 1 , "two" .= asInt 2 ] , "baz" .= asInt 42 ]) it "supports recursive includes" $ do decodeFile "test/resources/baz.yaml" `shouldReturn` Just (object [ "foo" .= object [ "foo" .= asInt 23 , "bar" .= object [ "one" .= asInt 1 , "two" .= asInt 2 ] , "baz" .= asInt 42 ] ]) it "aborts on cyclic includes" $ do (decodeFile "test/resources/loop/foo.yaml" :: IO (Maybe Value)) `shouldThrow` anyException context "when file does not exist" $ do it "throws Left (InvalidYaml (Just (YamlException \"Yaml file not found: ...\")))" $ do (decodeFile "./does_not_exist.yaml" :: IO (Maybe Value)) `shouldThrow` isYamlFileNotFoundException context "with a 1K stack size limit" $ around_ inTempDirectory $ do context "with a large list" $ do it "succeeds" $ do let xs :: [Value] xs = replicate 5000 (Number 23) LB.writeFile "foo.yaml" (encode xs) decodeFile "foo.yaml" `shouldReturn` Just xs describe "decodeFileEither" $ do context "when file does not exist" $ do it "returns Left (InvalidYaml (Just (YamlException \"Yaml file not found: ...\")))" $ do (decodeFileEither "./does_not_exist.yaml" :: IO (Either ParseException Value)) >>= (`shouldSatisfy` either isYamlFileNotFoundException (const False)) describe "decodeFileWithWarnings" $ around_ inTempDirectory $ do it "warns on duplicate keys" $ do writeFile "foo.yaml" [r| foo: 23 foo: bar |] Right result <- decodeFileWithWarnings "foo.yaml" result `shouldBe` ([DuplicateKey [Key "foo"]], [yamlQQ| foo: bar |]) it "warns on nested duplicate keys" $ do writeFile "foo.yaml" [r| foo: - 42 - bar: 23 bar: baz |] Right result <- decodeFileWithWarnings "foo.yaml" result `shouldBe` ([DuplicateKey [Key "foo", Index 1, Key "bar"]], [yamlQQ| foo: - 42 - bar: baz |]) context "when overriding a merged key" $ do it "does not warn" $ do writeFile "foo.yaml" [r| foo-1: &my-ref bar: 23 foo-2: <<: *my-ref bar: 42 |] Right result <- decodeFileWithWarnings "foo.yaml" result `shouldBe` ([], [yamlQQ| foo-1: bar: 23 foo-2: bar: 42 |]) context "when overriding twice" $ do it "warns" $ do writeFile "foo.yaml" [r| foo-1: &my-ref bar: 23 foo-2: <<: *my-ref bar: 42 bar: 65 |] Right result <- decodeFileWithWarnings "foo.yaml" result `shouldBe` ([DuplicateKey [Key "foo-2", Key "bar"]], [yamlQQ| foo-1: bar: 23 foo-2: bar: 65 |]) isYamlFileNotFoundException :: ParseException -> Bool isYamlFileNotFoundException (InvalidYaml (Just (YamlException msg))) | "Yaml file not found: " `isPrefixOf` msg = True isYamlFileNotFoundException _ = False yaml-0.11.4.0/test/Data/Yaml/THSpec.hs0000644000000000000000000000061013560466562015311 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} module Data.Yaml.THSpec (spec) where import Test.Hspec import Data.Aeson import Data.Yaml.TH spec :: Spec spec = do describe "yamlQQ" $ do it "parses yaml" $ do [yamlQQ| name: John Doe age: 23 |] `shouldBe` object ["name" .= String "John Doe", "age" .= Number 23] yaml-0.11.4.0/test/Data/YamlSpec.hs0000644000000000000000000010067313560466562015010 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} module Data.YamlSpec (main, spec) where import qualified Text.Libyaml as Y import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B8 import Data.Int (Int64) import qualified Data.Scientific as S import Test.HUnit hiding (Test, path) import Data.Conduit (runConduitRes, (.|), ConduitM) import qualified Data.Conduit.List as CL import Control.Monad import Control.Exception (try, SomeException) import Test.Hspec import Test.Hspec.QuickCheck import Data.Either.Compat import System.Directory (createDirectory, createDirectoryIfMissing) import Test.Mockery.Directory import qualified Data.Yaml as D import qualified Data.Yaml.Builder as B import qualified Data.Yaml.Internal as Internal import qualified Data.Yaml.Pretty as Pretty import Data.Yaml (object, array, (.=)) import Data.Maybe import qualified Data.HashMap.Strict as M import qualified Data.Text as T import Data.Aeson.TH import Data.Scientific (Scientific) import Data.Text (Text) import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Vector (Vector) import qualified Data.Vector as V import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM import System.IO (hClose) import System.IO.Temp (withSystemTempFile) data TestJSON = TestJSON { string :: Text , number :: Int , anArray :: Vector Text , hash :: HashMap Text Text , extrastring :: Text } deriving (Show, Eq) deriveJSON defaultOptions ''TestJSON testJSON :: TestJSON testJSON = TestJSON { string = "str" , number = 2 , anArray = V.fromList ["a", "b"] , hash = HM.fromList [("key1", "value1"), ("key2", "value2")] , extrastring = "1234-foo" } shouldDecode :: (Show a, D.FromJSON a, Eq a) => B8.ByteString -> a -> IO () shouldDecode bs expected = do actual <- D.decodeThrow bs actual `shouldBe` expected shouldDecodeEvents :: B8.ByteString -> [Y.Event] -> IO () shouldDecodeEvents bs expected = do actual <- runConduitRes $ Y.decode bs .| CL.consume map anyStyle actual `shouldBe` map anyStyle expected anyStyle :: Y.Event -> Y.Event anyStyle (Y.EventScalar bs tag _ anchor) = Y.EventScalar bs tag Y.Any anchor anyStyle (Y.EventSequenceStart tag _ anchor) = Y.EventSequenceStart tag Y.AnySequence anchor anyStyle (Y.EventMappingStart tag _ anchor) = Y.EventMappingStart tag Y.AnyMapping anchor anyStyle event = event testEncodeWith :: Y.FormatOptions -> [Y.Event] -> IO BS.ByteString testEncodeWith opts es = runConduitRes $ CL.sourceList (eventStream es) .| Y.encodeWith opts eventStream :: [Y.Event] -> [Y.Event] eventStream events = [Y.EventStreamStart, Y.EventDocumentStart] ++ events ++ [Y.EventDocumentEnd, Y.EventStreamEnd] main :: IO () main = hspec spec spec :: Spec spec = do describe "streaming" $ do it "count scalars with anchor" caseCountScalarsWithAnchor it "count sequences with anchor" caseCountSequencesWithAnchor it "count mappings with anchor" caseCountMappingsWithAnchor it "count sequences with custom tag" caseCountSequenceTags it "count mappings with custom tag" caseCountMappingTags it "count count sequences with ! tag" caseCountEmptySequenceTags it "count count mappings with ! tag" caseCountEmptyMappingTags it "count block style sequences" caseCountBlockStyleSequences it "count flow style sequences" caseCountFlowStyleSequences it "count block style mappings" caseCountBlockStyleMappings it "count flow style mappings" caseCountFlowStyleMappings it "count aliases" caseCountAliases it "count scalars" caseCountScalars it "largest string" caseLargestString it "encode/decode" caseEncodeDecode it "encode/decode events" caseEncodeDecodeEvents it "encode/decode file" caseEncodeDecodeFile it "interleaved encode/decode" caseInterleave it "decode invalid document (without segfault)" caseDecodeInvalidDocument describe "Data.Yaml" $ do it "encode/decode" caseEncodeDecodeData it "encode/decode file" caseEncodeDecodeFileData it "encode/decode files with non-ASCII names" caseEncodeDecodeNonAsciiFileData it "encode/decode strings" caseEncodeDecodeStrings it "decode invalid file" caseDecodeInvalid it "processes datatypes" caseDataTypes it "encode invalid numbers" caseEncodeInvalidNumbers describe "Data.Yaml.Pretty" $ do it "encode/decode" caseEncodeDecodeDataPretty it "encode/decode strings" caseEncodeDecodeStringsPretty it "processes datatypes" caseDataTypesPretty describe "Data.Yaml.Builder" $ do it "encode/decode" caseEncodeDecodeDataBuilder it "encode/decode complex mapping" caseEncodeDecodeComplexMappingBuilder describe "Data.Yaml aliases" $ do it "simple scalar alias" caseSimpleScalarAlias it "simple sequence alias" caseSimpleSequenceAlias it "simple mapping alias" caseSimpleMappingAlias it "mapping alias before anchor" caseMappingAliasBeforeAnchor it "mapping alias inside anchor" caseMappingAliasInsideAnchor it "scalar alias overriding" caseScalarAliasOverriding describe "Data.Yaml merge keys" $ do it "test uniqueness of keys" caseAllKeysShouldBeUnique it "test mapping merge" caseSimpleMappingMerge it "test sequence of mappings merging" caseMergeSequence describe "numbers" $ do it "parses as string when quoted" caseQuotedNumber it "parses as number when unquoted" caseUnquotedNumber it "parses as number !!str is present" caseAttribNumber it "integers have no decimals" caseIntegerDecimals describe "booleans" $ do it "parses when all lowercase" caseLowercaseBool it "parses when all uppercase" caseUppercaseBool it "parses when titlecase" caseTitlecaseBool describe "empty input" $ do it "parses as Null" caseEmptyInput it "parses as Null from file" caseEmptyInputFile describe "comment only input" $ do it "parses as Null" caseCommentOnlyInput it "parses as Null from file" caseCommentOnlyInputFile describe "alias stripping" $ do it "works" caseStripAlias describe "nulls" $ do checkNull "null" checkNull "Null" checkNull "NULL" checkNull "~" checkNull "" describe "pretty output" $ do it "simple nulls" $ D.encode (object ["foo" .= D.Null]) `shouldBe` "foo: null\n" it "simple numbers" $ D.encode (object ["foo" .= (4 :: Int)]) `shouldBe` "foo: 4\n" it "True" $ D.encode (object ["foo" .= True]) `shouldBe` "foo: true\n" it "False" $ D.encode (object ["foo" .= False]) `shouldBe` "foo: false\n" it "simple string" $ D.encode (object ["foo" .= ("bar" :: T.Text)]) `shouldBe` "foo: bar\n" it "*" $ D.encode (object ["foo" .= ("*" :: T.Text)]) `shouldBe` "foo: '*'\n" describe "special keys" $ do let tester key = it (T.unpack key) $ let value = object [key .= True] in D.encode value `shouldDecode` value mapM_ tester specialStrings describe "special values" $ do let tester value = it (T.unpack value) $ let value' = object ["foo" .= value] in D.encode value' `shouldDecode` value' mapM_ tester specialStrings describe "decodeFileEither" $ do it "loads YAML through JSON into Haskell data" $ do tj <- either (error . show) id `fmap` D.decodeFileEither "test/json.yaml" tj `shouldBe` testJSON context "when file does not exist" $ do it "returns Left" $ do (D.decodeFileEither "./does_not_exist.yaml" :: IO (Either D.ParseException D.Value)) >>= (`shouldSatisfy` isLeft) describe "round-tripping of special scalars" $ do let special = words "y Y On ON false 12345 12345.0 12345a 12e3" forM_ special $ \w -> it w $ let v = object ["word" .= w] in D.encode v `shouldDecode` v it "no tags" $ D.encode (object ["word" .= ("true" :: String)]) `shouldBe` "word: 'true'\n" it "aliases in keys #49" caseIssue49 it "serialization of +123 #64" $ do D.encode ("+123" :: String) `shouldDecode` ("+123" :: String) it "preserves Scientific precision" casePreservesScientificPrecision it "truncates files" caseTruncatesFiles it "encode quotes special keys #137" $ caseSpecialKeys D.encode it "encodePretty quotes special keys #179" $ caseSpecialKeys (Pretty.encodePretty Pretty.defConfig) describe "non-decimal numbers #135" $ do let go str val = it str $ encodeUtf8 (T.pack str) `shouldDecode` val go "12345" (12345 :: Int) go "+12345" (12345 :: Int) go "0o14" (12 :: Int) go "0o123" (83 :: Int) go "0xC" (12 :: Int) go "0xc" (12 :: Int) go "0xdeadBEEF" (3735928559 :: Int64) go "0xDEADBEEF" (3735928559 :: Int64) go "1.23015e+3" (1230.15 :: Scientific) go "12.3015e+02" (1230.15 :: Scientific) go "1230.15" (1230.15 :: Scientific) describe "Text.Libyaml with default tag rendering" $ do let enc = testEncodeWith Y.defaultFormatOptions it "elides custom sequence tags" $ enc taggedSequence `shouldReturn` "[]\n" it "elides custom mapping tags" $ enc taggedMapping `shouldReturn` "{}\n" it "elides default sequence tags" $ enc defaultTaggedSequence `shouldReturn` "[]\n" it "elides default mapping tags" $ enc defaultTaggedMapping `shouldReturn` "{}\n" it "handles NoTag on sequences" $ enc untaggedSequence `shouldReturn` "[]\n" it "handles NoTag on mappings" $ enc untaggedMapping `shouldReturn` "{}\n" it "handles mixed tag usages but elides all mapping and sequence tags" $ enc mixedTagSampleA `shouldReturn` "- {}\n" it "in combination of tags, anchors and styles, outputs only the scalar tags" $ enc mixedTagSampleB `shouldReturn` "&a\n&b ! foo: &c [&d !!null '']\n" it "outputs tags when double quoted" $ enc [Y.EventScalar "foo" Y.StrTag Y.DoubleQuoted Nothing] `shouldReturn` "!!str \"foo\"\n" it "outputs tags when single quoted" $ enc [Y.EventScalar "foo" Y.StrTag Y.SingleQuoted Nothing] `shouldReturn` "!!str 'foo'\n" it "outputs tags on literal text" $ enc [Y.EventScalar "foo" Y.StrTag Y.Literal Nothing] `shouldReturn` "!!str |-\n foo\n" it "outputs tags on folded text" $ enc [Y.EventScalar "foo" Y.StrTag Y.Folded Nothing] `shouldReturn` "!!str >-\n foo\n" describe "Text.Libyaml with all tags on" $ do let enc = testEncodeWith $ Y.setTagRendering Y.renderAllTags Y.defaultFormatOptions it "will output custom sequence tags" $ enc taggedSequence `shouldReturn` "!foo []\n" it "will output custom mapping tags" $ enc taggedMapping `shouldReturn` "!foo {}\n" it "will output default sequence tags" $ enc defaultTaggedSequence `shouldReturn` "!!seq []\n" it "will output default mapping tags" $ enc defaultTaggedMapping `shouldReturn` "!!map {}\n" it "handles NoTag on sequences" $ enc untaggedSequence `shouldReturn` "[]\n" it "handles NoTag on mappings" $ enc untaggedMapping `shouldReturn` "{}\n" it "handles mixed tag usages outputting all mapping and sequence tags" $ enc mixedTagSampleA `shouldReturn` "- !foo {}\n" it "in combination of tags, anchors and styles, outputs all the tags" $ enc mixedTagSampleB `shouldReturn` "&a\n&b ! foo: &c !baz [&d !!null '']\n" it "outputs plain tags" $ enc [Y.EventScalar "foo" Y.StrTag Y.Plain Nothing] `shouldReturn` "!!str foo\n" it "respects PlainNoTag tags" $ enc [Y.EventScalar "foo" Y.StrTag Y.PlainNoTag Nothing] `shouldReturn` "foo\n" describe "Text.Libyaml with uri tags on" $ do let enc = testEncodeWith $ Y.setTagRendering Y.renderUriTags Y.defaultFormatOptions it "will output custom sequence tags" $ enc taggedSequence `shouldReturn` "!foo []\n" it "will output custom mapping tags" $ enc taggedMapping `shouldReturn` "!foo {}\n" it "will output default sequence tags" $ enc defaultTaggedSequence `shouldReturn` "[]\n" it "will output default mapping tags" $ enc defaultTaggedMapping `shouldReturn` "{}\n" it "handles NoTag on sequences" $ enc untaggedSequence `shouldReturn` "[]\n" it "handles NoTag on mappings" $ enc untaggedMapping `shouldReturn` "{}\n" it "handles mixed tag usages outputting all mapping and sequence tags" $ enc mixedTagSampleA `shouldReturn` "- !foo {}\n" it "in combination of tags, anchors and styles, outputs all the tags" $ enc mixedTagSampleB `shouldReturn` "&a\n&b ! foo: &c !baz [&d '']\n" describe "Text.Libyaml with tags off" $ do let enc = testEncodeWith $ Y.setTagRendering Y.renderNoTags Y.defaultFormatOptions it "outputs plain tags" $ enc [Y.EventScalar "foo" Y.StrTag Y.Plain Nothing] `shouldReturn` "foo\n" it "respects PlainNoTag tags" $ enc [Y.EventScalar "foo" Y.StrTag Y.PlainNoTag Nothing] `shouldReturn` "foo\n" it "elides tags when double quoted" $ enc [Y.EventScalar "foo" Y.StrTag Y.DoubleQuoted Nothing] `shouldReturn` "\"foo\"\n" it "elides tags when single quoted" $ enc [Y.EventScalar "foo" Y.StrTag Y.SingleQuoted Nothing] `shouldReturn` "'foo'\n" it "elides tags on literal text" $ enc [Y.EventScalar "foo" Y.StrTag Y.Literal Nothing] `shouldReturn` "|-\n foo\n" it "elides tags on folded text" $ enc [Y.EventScalar "foo" Y.StrTag Y.Folded Nothing] `shouldReturn` ">-\n foo\n" describe "Text.Libyaml with only UriTags set to render " $ do let enc = testEncodeWith $ Y.setTagRendering Y.renderUriTags $ Y.defaultFormatOptions it "outputs only UriTags" $ enc [ Y.EventSequenceStart Y.NoTag Y.FlowSequence Nothing , Y.EventScalar "foo" Y.StrTag Y.DoubleQuoted Nothing , Y.EventScalar "99" Y.IntTag Y.Plain Nothing , Y.EventScalar "99.99" Y.FloatTag Y.Plain Nothing , Y.EventScalar "bar" Y.NoTag Y.Plain Nothing , Y.EventScalar "foo" (Y.UriTag "!foo") Y.DoubleQuoted Nothing , Y.EventScalar "foo" (Y.UriTag "!foo") Y.Plain Nothing , Y.EventSequenceEnd ] `shouldReturn` "[\"foo\", 99, 99.99, bar, !foo \"foo\", !foo foo]\n" prop "Scientific values round-trip" $ \coeff expon -> do let val = D.Number $ S.scientific coeff expon let rendered = D.encode val case D.decodeEither' rendered of Left e -> error $ show (coeff, expon, e) Right val' -> val' `shouldBe` val specialStrings :: [T.Text] specialStrings = [ "fo\"o" , "fo\'o" , "fo\\'o" , "fo: o" , "foo\nbar\nbaz\n" ] counter :: Monad m => (Y.Event -> Bool) -> ConduitM Y.Event o m Int counter pred' = CL.fold (\cnt e -> (if pred' e then 1 else 0) + cnt) 0 caseHelper :: String -> (Y.Event -> Bool) -> Int -> Assertion caseHelper yamlString pred' expRes = do res <- runConduitRes $ Y.decode (B8.pack yamlString) .| counter pred' res @?= expRes caseCountScalarsWithAnchor :: Assertion caseCountScalarsWithAnchor = caseHelper yamlString isScalarA 1 where yamlString = "foo:\n - &anchor bin1\n - bin2\n - bin3" isScalarA (Y.EventScalar _ _ _ (Just _)) = True isScalarA _ = False caseCountSequencesWithAnchor :: Assertion caseCountSequencesWithAnchor = caseHelper yamlString isSequenceStartA 1 where yamlString = "foo: &anchor\n - bin1\n - bin2\n - bin3" isSequenceStartA (Y.EventSequenceStart Y.NoTag _ (Just _)) = True isSequenceStartA _ = False caseCountMappingsWithAnchor :: Assertion caseCountMappingsWithAnchor = caseHelper yamlString isMappingA 1 where yamlString = "foo: &anchor\n key1: bin1\n key2: bin2\n key3: bin3" isMappingA (Y.EventMappingStart _ _ (Just _)) = True isMappingA _ = False caseCountAliases :: Assertion caseCountAliases = caseHelper yamlString isAlias 1 where yamlString = "foo: &anchor\n key1: bin1\n key2: bin2\n key3: bin3\nboo: *anchor" isAlias Y.EventAlias{} = True isAlias _ = False caseCountMappingTags :: Assertion caseCountMappingTags = caseHelper yamlString isCustomTaggedMapping 1 where yamlString = "foo: !bar\n k: v\n k2: v2" isCustomTaggedMapping (Y.EventMappingStart (Y.UriTag "!bar") _ _) = True isCustomTaggedMapping _ = False caseCountEmptyMappingTags :: Assertion caseCountEmptyMappingTags = caseHelper yamlString isCustomTaggedMapping 1 where yamlString = "foo: !\n k: v\n k2: v2" isCustomTaggedMapping (Y.EventMappingStart (Y.UriTag "!") _ _) = True isCustomTaggedMapping _ = False caseCountSequenceTags :: Assertion caseCountSequenceTags = caseHelper yamlString isCustomTaggedSequence 1 where yamlString = "foo: !bar [x, y, z]" isCustomTaggedSequence (Y.EventSequenceStart (Y.UriTag "!bar") _ _) = True isCustomTaggedSequence _ = False caseCountEmptySequenceTags :: Assertion caseCountEmptySequenceTags = caseHelper yamlString isCustomTaggedSequence 1 where yamlString = "foo: ! [x, y, z]" isCustomTaggedSequence (Y.EventSequenceStart (Y.UriTag "!") _ _) = True isCustomTaggedSequence _ = False caseCountFlowStyleSequences :: Assertion caseCountFlowStyleSequences = caseHelper yamlString isFlowStyleSequence 1 where yamlString = "foo: [x, y, z]" isFlowStyleSequence (Y.EventSequenceStart _ Y.FlowSequence _) = True isFlowStyleSequence _ = False caseCountBlockStyleSequences :: Assertion caseCountBlockStyleSequences = caseHelper yamlString isBlockStyleSequence 1 where yamlString = "foo:\n- x\n- y\n- z\n" isBlockStyleSequence (Y.EventSequenceStart _ Y.BlockSequence _) = True isBlockStyleSequence _ = False caseCountFlowStyleMappings :: Assertion caseCountFlowStyleMappings = caseHelper yamlString isFlowStyleMapping 1 where yamlString = "foo: { bar: 1, baz: 2 }" isFlowStyleMapping (Y.EventMappingStart _ Y.FlowMapping _) = True isFlowStyleMapping _ = False caseCountBlockStyleMappings :: Assertion caseCountBlockStyleMappings = caseHelper yamlString isBlockStyleMapping 1 where yamlString = "foo: bar\nbaz: quux" isBlockStyleMapping (Y.EventMappingStart _ Y.BlockMapping _) = True isBlockStyleMapping _ = False caseCountScalars :: Assertion caseCountScalars = do res <- runConduitRes $ Y.decode yamlBS .| CL.fold adder accum res @?= (7, 1, 2) where yamlString = "foo:\n baz: [bin1, bin2, bin3]\nbaz: bazval" yamlBS = B8.pack yamlString adder (s, l, m) (Y.EventScalar{}) = (s + 1, l, m) adder (s, l, m) (Y.EventSequenceStart{}) = (s, l + 1, m) adder (s, l, m) (Y.EventMappingStart{}) = (s, l, m + 1) adder a _ = a accum = (0, 0, 0) :: (Int, Int, Int) caseLargestString :: Assertion caseLargestString = do res <- runConduitRes $ Y.decodeFile filePath .| CL.fold adder accum res @?= (length expected, expected) where expected = "this one is just a little bit bigger than the others" filePath = "test/largest-string.yaml" adder (i, s) (Y.EventScalar bs _ _ _) = let s' = B8.unpack bs i' = length s' in if i' > i then (i', s') else (i, s) adder acc _ = acc accum = (0, "no strings found") newtype MyEvent = MyEvent Y.Event deriving Show instance Eq MyEvent where (MyEvent (Y.EventScalar s t _ _)) == (MyEvent (Y.EventScalar s' t' _ _)) = s == s' && t == t' MyEvent e1 == MyEvent e2 = e1 == e2 caseEncodeDecode :: Assertion caseEncodeDecode = do eList <- runConduitRes $ Y.decode yamlBS .| CL.consume bs <- runConduitRes $ CL.sourceList eList .| Y.encode eList2 <- runConduitRes $ Y.decode bs .| CL.consume map MyEvent eList @=? map MyEvent eList2 where yamlString = "foo: bar\nbaz:\n - bin1\n - bin2\n" yamlBS = B8.pack yamlString caseEncodeDecodeEvents :: Assertion caseEncodeDecodeEvents = do let events = Internal.objToEvents D.defaultStringStyle testJSON [] result <- Internal.decodeHelper_ . CL.sourceList $ eventStream events let (_, value) = either (error . show) id result value @?= testJSON caseEncodeDecodeFile :: Assertion caseEncodeDecodeFile = withFile "" $ \tmpPath -> do eList <- runConduitRes $ Y.decodeFile filePath .| CL.consume runConduitRes $ CL.sourceList eList .| Y.encodeFile tmpPath eList2 <- runConduitRes $ Y.decodeFile filePath .| CL.consume map MyEvent eList @=? map MyEvent eList2 where filePath = "test/largest-string.yaml" caseInterleave :: Assertion caseInterleave = withFile "" $ \tmpPath -> withFile "" $ \tmpPath2 -> do () <- runConduitRes $ Y.decodeFile filePath .| Y.encodeFile tmpPath () <- runConduitRes $ Y.decodeFile tmpPath .| Y.encodeFile tmpPath2 f1 <- readFile tmpPath f2 <- readFile tmpPath2 f1 @=? f2 where filePath = "test/largest-string.yaml" caseDecodeInvalidDocument :: Assertion caseDecodeInvalidDocument = do x <- try $ runConduitRes $ Y.decode yamlBS .| CL.sinkNull case x of Left (_ :: SomeException) -> return () Right y -> do putStrLn $ "bad return value: " ++ show y assertFailure "expected parsing exception, but got no errors" where yamlString = " - foo\n - baz\nbuz" yamlBS = B8.pack yamlString mkScalar :: String -> D.Value mkScalar = mkStrScalar mkStrScalar :: String -> D.Value mkStrScalar = D.String . T.pack mappingKey :: D.Value-> String -> D.Value mappingKey (D.Object m) k = (fromJust . M.lookup (T.pack k) $ m) mappingKey _ _ = error "expected Object" sample :: D.Value sample = array [ D.String "foo" , object [ ("bar1", D.String "bar2") , ("bar3", D.String "") ] , D.String "" , D.Number 1 , D.Number 0.1 , D.Bool True , D.Null ] sampleBuilder :: B.YamlBuilder sampleBuilder = B.array [ B.string "foo" , B.mapping [ ("bar1", B.string "bar2") , ("bar3", B.string "") ] , B.string "" , B.scientific 1 , B.scientific 0.1 , B.bool True , B.null ] caseEncodeDecodeData :: Assertion caseEncodeDecodeData = D.encode sample `shouldDecode` sample caseEncodeDecodeDataPretty :: Assertion caseEncodeDecodeDataPretty = Pretty.encodePretty Pretty.defConfig sample `shouldDecode` sample caseEncodeDecodeDataBuilder :: Assertion caseEncodeDecodeDataBuilder = do let events = B.unYamlBuilder sampleBuilder [] bs <- testEncodeWith Y.defaultFormatOptions events bs `shouldDecodeEvents` eventStream events caseEncodeDecodeComplexMappingBuilder :: Assertion caseEncodeDecodeComplexMappingBuilder = do let events = B.unYamlBuilder builder [] bs <- testEncodeWith Y.defaultFormatOptions events bs `shouldDecodeEvents` eventStream events where builder :: B.YamlBuilder builder = B.mappingComplex [ ( B.mapping [ ("foo", B.scientific 1) , ("bar", B.scientific 2) ] , B.bool True ) ] caseEncodeDecodeFileData :: Assertion caseEncodeDecodeFileData = withFile "" $ \fp -> do D.encodeFile fp sample out <- D.decodeFileThrow fp out @?= sample caseEncodeDecodeNonAsciiFileData :: Assertion caseEncodeDecodeNonAsciiFileData = do let mySample = (object ["foo" .= True]) inTempDirectory $ do createDirectory "accenté" D.encodeFile "accenté/bar.yaml" mySample out1 <- D.decodeFileThrow "accenté/bar.yaml" out1 @?= mySample c <- readFile "test/resources/accent/foo.yaml" inTempDirectory $ do createDirectoryIfMissing True "test/resources/unicode/accenté/" writeFile "test/resources/unicode/accenté/foo.yaml" c out2 <- D.decodeFileThrow "test/resources/unicode/accenté/foo.yaml" out2 @?= mySample caseEncodeDecodeStrings :: Assertion caseEncodeDecodeStrings = D.encode sample `shouldDecode` sample caseEncodeDecodeStringsPretty :: Assertion caseEncodeDecodeStringsPretty = Pretty.encodePretty Pretty.defConfig sample `shouldDecode` sample caseDecodeInvalid :: Assertion caseDecodeInvalid = D.decodeThrow "\tthis is 'not' valid :-)" `shouldBe` (Nothing :: Maybe D.Value) caseSimpleScalarAlias :: Assertion caseSimpleScalarAlias = "- &anch foo\n- baz\n- *anch" `shouldDecode` array [(mkScalar "foo"), (mkScalar "baz"), (mkScalar "foo")] caseSimpleSequenceAlias :: Assertion caseSimpleSequenceAlias = "seq: &anch\n - foo\n - baz\nseq2: *anch" `shouldDecode` object [("seq", array [(mkScalar "foo"), (mkScalar "baz")]), ("seq2", array [(mkScalar "foo"), (mkScalar "baz")])] caseSimpleMappingAlias :: Assertion caseSimpleMappingAlias = "map: &anch\n key1: foo\n key2: baz\nmap2: *anch" `shouldDecode` object [(T.pack "map", object [("key1", mkScalar "foo"), ("key2", (mkScalar "baz"))]), (T.pack "map2", object [("key1", (mkScalar "foo")), ("key2", mkScalar "baz")])] caseMappingAliasBeforeAnchor :: Assertion caseMappingAliasBeforeAnchor = case D.decodeThrow "map: *anch\nmap2: &anch\n key1: foo\n key2: baz" of Nothing -> pure () Just (_ :: D.Value) -> error "decode should return Nothing due to unknown alias" caseMappingAliasInsideAnchor :: Assertion caseMappingAliasInsideAnchor = do case D.decodeThrow "map: &anch\n key1: foo\n key2: *anch" of Nothing -> pure () Just (_ :: D.Value) -> error "decode should return Nothing due to unknown alias" caseScalarAliasOverriding :: Assertion caseScalarAliasOverriding = "- &anch foo\n- baz\n- *anch\n- &anch boo\n- buz\n- *anch" `shouldDecode` array [(mkScalar "foo"), (mkScalar "baz"), (mkScalar "foo"), (mkScalar "boo"), (mkScalar "buz"), (mkScalar "boo")] caseAllKeysShouldBeUnique :: Assertion caseAllKeysShouldBeUnique = do res <- D.decodeThrow "foo1: foo\nfoo2: baz\nfoo1: buz" mappingKey res "foo1" `shouldBe` mkScalar "buz" caseSimpleMappingMerge :: Assertion caseSimpleMappingMerge = do res <- D.decodeThrow "foo1: foo\nfoo2: baz\n<<:\n foo1: buz\n foo3: fuz" mappingKey res "foo1" `shouldBe` mkScalar "foo" mappingKey res "foo3" `shouldBe` mkScalar "fuz" caseMergeSequence :: Assertion caseMergeSequence = do res <- D.decodeThrow "m1: &m1\n k1: !!str 1\n k2: !!str 2\nm2: &m2\n k1: !!str 3\n k3: !!str 4\nfoo1: foo\n<<: [ *m1, *m2 ]" mappingKey res "foo1" @?= (mkScalar "foo") mappingKey res "k1" @?= (D.String "1") mappingKey res "k2" @?= (D.String "2") mappingKey res "k3" @?= (D.String "4") caseDataTypes :: Assertion caseDataTypes = D.encode val `shouldDecode` val where val = object [ ("string", D.String "foo") , ("int", D.Number 5) , ("float", D.Number 4.3) , ("true", D.Bool True) , ("false", D.Bool False) , ("null", D.Null) ] caseEncodeInvalidNumbers :: Assertion caseEncodeInvalidNumbers = D.encode (D.String ".") `shouldBe` ".\n" caseDataTypesPretty :: Assertion caseDataTypesPretty = Pretty.encodePretty Pretty.defConfig val `shouldDecode` val where val = object [ ("string", D.String "foo") , ("int", D.Number 5) , ("float", D.Number 4.3) , ("true", D.Bool True) , ("false", D.Bool False) , ("null", D.Null) ] caseQuotedNumber, caseUnquotedNumber, caseAttribNumber, caseIntegerDecimals :: Assertion caseQuotedNumber = "foo: \"1234\"" `shouldDecode` object [("foo", D.String "1234")] caseUnquotedNumber = "foo: 1234" `shouldDecode` object [("foo", D.Number 1234)] caseAttribNumber = "foo: !!str 1234" `shouldDecode` object [("foo", D.String "1234")] caseIntegerDecimals = "1\n" `shouldDecode` (1 :: Int) obj :: D.Value obj = object [("foo", D.Bool False), ("bar", D.Bool True), ("baz", D.Bool True)] caseLowercaseBool, caseUppercaseBool, caseTitlecaseBool :: Assertion caseLowercaseBool = "foo: off\nbar: y\nbaz: true" `shouldDecode` obj caseUppercaseBool = "foo: FALSE\nbar: Y\nbaz: ON" `shouldDecode` obj caseTitlecaseBool = "foo: No\nbar: Yes\nbaz: True" `shouldDecode` obj caseEmptyInput :: Assertion caseEmptyInput = B8.empty `shouldDecode` D.Null caseEmptyInputFile :: Assertion caseEmptyInputFile = do out <- D.decodeFileEither "test/resources/empty.yaml" either (Left . D.prettyPrintParseException) Right out @?= Right D.Null caseCommentOnlyInput :: Assertion caseCommentOnlyInput = "# comment\n" `shouldDecode` D.Null caseCommentOnlyInputFile :: Assertion caseCommentOnlyInputFile = do out <- D.decodeFileEither "test/resources/empty2.yaml" either (Left . D.prettyPrintParseException) Right out @?= Right D.Null checkNull :: T.Text -> Spec checkNull x = it ("null recognized: " ++ show x) $ B8.pack ("foo: " ++ T.unpack x) `shouldDecode` object [("foo", D.Null)] caseStripAlias :: Assertion caseStripAlias = src `shouldDecode` object [ "Default" .= object [ "foo" .= (1 :: Int) , "bar" .= (2 :: Int) ] , "Obj" .= object [ "foo" .= (1 :: Int) , "bar" .= (2 :: Int) , "key" .= (3 :: Int) ] ] where src = "Default: &def\n foo: 1\n bar: 2\nObj:\n <<: *def\n key: 3\n" caseIssue49 :: Assertion caseIssue49 = src `shouldDecode` object [ "a" .= object [ "value" .= (1.0 :: Double) ] , "b" .= object [ "value" .= (1.2 :: Double) ] ] where src = "---\na:\n &id5 value: 1.0\nb:\n *id5: 1.2" -- | We cannot guarantee this before aeson started using 'Scientific'. casePreservesScientificPrecision :: Assertion casePreservesScientificPrecision = do "x: 1e-100000" `shouldDecode` object [ "x" .= D.Number (read "1e-100000") ] -- Note that this ought to work also without 'Scientific', given -- that @read (show "9.78159610558926e-5") == 9.78159610558926e-5@. -- However, it didn't work (and still doesn't work with aeson < 0.7) -- for two reasons: -- -- * We use 'Data.Text.Read.double', which is not as accurate as it -- can be; -- * Even if we used 'Data.Text.Read.rational' we would not get good -- results, because of . "x: 9.78159610558926e-5" `shouldDecode` object [ "x" .= D.Number (read "9.78159610558926e-5") ] caseTruncatesFiles :: Assertion caseTruncatesFiles = withSystemTempFile "truncate.yaml" $ \fp h -> do replicateM_ 500 $ B8.hPut h "HELLO WORLD!!!!!\n" hClose h let val = object ["hello" .= ("world" :: String)] D.encodeFile fp val res <- D.decodeFileEither fp either (Left . show) Right res `shouldBe` Right val caseSpecialKeys :: (HashMap Text () -> B8.ByteString) -> Assertion caseSpecialKeys encoder = do let keys = T.words "true false NO YES 1.2 1e5 null" bs = encoder $ M.fromList $ map (, ()) keys text = decodeUtf8 bs forM_ keys $ \key -> do let quoted = T.concat ["'", key, "'"] unless (quoted `T.isInfixOf` text) $ error $ concat [ "Could not find quoted key: " , T.unpack quoted , "\n\n" , T.unpack text ] :: IO () taggedSequence :: [Y.Event] taggedSequence = [ Y.EventSequenceStart (Y.UriTag "!foo") Y.FlowSequence Nothing , Y.EventSequenceEnd ] taggedMapping :: [Y.Event] taggedMapping = [ Y.EventMappingStart (Y.UriTag "!foo") Y.FlowMapping Nothing , Y.EventMappingEnd ] defaultTaggedSequence :: [Y.Event] defaultTaggedSequence = [Y.EventSequenceStart Y.SeqTag Y.FlowSequence Nothing, Y.EventSequenceEnd] defaultTaggedMapping :: [Y.Event] defaultTaggedMapping = [Y.EventMappingStart Y.MapTag Y.FlowMapping Nothing, Y.EventMappingEnd] untaggedSequence :: [Y.Event] untaggedSequence = [Y.EventSequenceStart Y.NoTag Y.FlowSequence Nothing, Y.EventSequenceEnd] untaggedMapping :: [Y.Event] untaggedMapping = [Y.EventMappingStart Y.NoTag Y.FlowMapping Nothing, Y.EventMappingEnd] mixedTagSampleA :: [Y.Event] mixedTagSampleA = [ Y.EventSequenceStart Y.NoTag Y.BlockSequence Nothing , Y.EventMappingStart (Y.UriTag "!foo") Y.FlowMapping Nothing , Y.EventMappingEnd , Y.EventSequenceEnd ] mixedTagSampleB :: [Y.Event] mixedTagSampleB = [ Y.EventMappingStart Y.NoTag Y.BlockMapping (Just "a") , Y.EventScalar "foo" (Y.UriTag "bar") Y.Plain (Just "b") , Y.EventSequenceStart (Y.UriTag "!baz") Y.FlowSequence (Just "c") , Y.EventScalar "" Y.NullTag Y.Plain (Just "d") , Y.EventSequenceEnd , Y.EventMappingEnd ] yaml-0.11.4.0/LICENSE0000644000000000000000000000253013560466562012105 0ustar0000000000000000The following license covers this documentation, and the source code, except where otherwise indicated. Copyright 2008, Michael Snoyman. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. yaml-0.11.4.0/Setup.lhs0000644000000000000000000000016213560466562012707 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain yaml-0.11.4.0/yaml.cabal0000644000000000000000000001176513654740177013041 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack -- -- hash: 1f75743c2fefefb33f6f3e8a51fce90cb3f286c975d205d7ded3789d5b15c488 name: yaml version: 0.11.4.0 synopsis: Support for parsing and rendering YAML documents. description: README and API documentation are available at category: Data stability: stable homepage: https://github.com/snoyberg/yaml#readme bug-reports: https://github.com/snoyberg/yaml/issues author: Michael Snoyman , Anton Ageev ,Kirill Simonov maintainer: Michael Snoyman license: BSD3 license-file: LICENSE build-type: Simple extra-source-files: test/largest-string.yaml test/json.yaml test/resources/foo.yaml test/resources/bar.yaml test/resources/baz.yaml test/resources/accent/foo.yaml test/resources/loop/foo.yaml test/resources/loop/bar.yaml test/resources/empty.yaml test/resources/empty2.yaml README.md ChangeLog.md source-repository head type: git location: https://github.com/snoyberg/yaml flag no-examples description: don't build the examples manual: False default: True flag no-exe description: don't install the yaml2json or json2yaml executables manual: False default: True library exposed-modules: Data.Yaml Data.Yaml.Aeson Data.Yaml.Builder Data.Yaml.Config Data.Yaml.Include Data.Yaml.Internal Data.Yaml.Parser Data.Yaml.Pretty Data.Yaml.TH other-modules: Paths_yaml hs-source-dirs: src other-extensions: LambdaCase ghc-options: -Wall build-depends: aeson >=0.11 , attoparsec >=0.11.3.0 , base >=4.9.1 && <5 , bytestring >=0.9.1.4 , conduit >=1.2.8 && <1.4 , containers , directory , filepath , libyaml >=0.1 && <0.2 , mtl , resourcet >=0.3 && <1.3 , scientific >=0.3 , template-haskell , text , transformers >=0.1 , unordered-containers , vector if !impl(ghc >= 8.0) build-depends: semigroups default-language: Haskell2010 executable examples main-is: Main.hs other-modules: Config Simple Paths_yaml hs-source-dirs: examples ghc-options: -Wall build-depends: aeson >=0.11 , attoparsec >=0.11.3.0 , base >=4.9.1 && <5 , bytestring >=0.9.1.4 , conduit >=1.2.8 && <1.4 , containers , directory , filepath , libyaml >=0.1 && <0.2 , mtl , resourcet >=0.3 && <1.3 , scientific >=0.3 , template-haskell , text , transformers >=0.1 , unordered-containers , vector if !impl(ghc >= 8.0) build-depends: semigroups if flag(no-examples) buildable: False else build-depends: raw-strings-qq , yaml default-language: Haskell2010 executable json2yaml main-is: json2yaml.hs other-modules: Paths_yaml hs-source-dirs: exe build-depends: aeson >=0.11 , attoparsec >=0.11.3.0 , base >=4.9.1 && <5 , bytestring >=0.9.1.4 , conduit >=1.2.8 && <1.4 , containers , directory , filepath , libyaml >=0.1 && <0.2 , mtl , resourcet >=0.3 && <1.3 , scientific >=0.3 , template-haskell , text , transformers >=0.1 , unordered-containers , vector , yaml if !impl(ghc >= 8.0) build-depends: semigroups if flag(no-exe) buildable: False default-language: Haskell2010 executable yaml2json main-is: yaml2json.hs other-modules: Paths_yaml hs-source-dirs: exe build-depends: aeson >=0.11 , attoparsec >=0.11.3.0 , base >=4.9.1 && <5 , bytestring >=0.9.1.4 , conduit >=1.2.8 && <1.4 , containers , directory , filepath , libyaml >=0.1 && <0.2 , mtl , resourcet >=0.3 && <1.3 , scientific >=0.3 , template-haskell , text , transformers >=0.1 , unordered-containers , vector , yaml if !impl(ghc >= 8.0) build-depends: semigroups if flag(no-exe) buildable: False default-language: Haskell2010 test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: Data.Yaml.IncludeSpec Data.Yaml.THSpec Data.YamlSpec Paths_yaml hs-source-dirs: test ghc-options: -Wall "-with-rtsopts=-K1K" cpp-options: -DTEST build-depends: HUnit , aeson >=0.11 , attoparsec >=0.11.3.0 , base >=4.9.1 && <5 , base-compat , bytestring >=0.9.1.4 , conduit >=1.2.8 && <1.4 , containers , directory , filepath , hspec >=1.3 , libyaml >=0.1 && <0.2 , mockery , mtl , raw-strings-qq , resourcet >=0.3 && <1.3 , scientific >=0.3 , template-haskell , temporary , text , transformers >=0.1 , unordered-containers , vector , yaml if !impl(ghc >= 8.0) build-depends: semigroups default-language: Haskell2010 yaml-0.11.4.0/test/largest-string.yaml0000644000000000000000000000026013560466562015706 0ustar0000000000000000this is a long string: but this one is even longer this is shorter: - many - tiny - string one the other hand: this one is just a little bit bigger than the others yaml-0.11.4.0/test/json.yaml0000644000000000000000000000014513560466562013714 0ustar0000000000000000string: str number: 2 anArray: - a - b hash: key1: value1 key2: value2 extrastring: 1234-foo yaml-0.11.4.0/test/resources/foo.yaml0000644000000000000000000000004713560466562015541 0ustar0000000000000000foo: 23 bar: !include bar.yaml baz: 42 yaml-0.11.4.0/test/resources/bar.yaml0000644000000000000000000000001613560466562015516 0ustar0000000000000000one: 1 two: 2 yaml-0.11.4.0/test/resources/baz.yaml0000644000000000000000000000002713560466562015530 0ustar0000000000000000foo: !include foo.yaml yaml-0.11.4.0/test/resources/accent/foo.yaml0000644000000000000000000000001213560466562016766 0ustar0000000000000000foo: true yaml-0.11.4.0/test/resources/loop/foo.yaml0000644000000000000000000000004713560466562016512 0ustar0000000000000000foo: 23 bar: !include bar.yaml baz: 42 yaml-0.11.4.0/test/resources/loop/bar.yaml0000644000000000000000000000003613560466562016471 0ustar0000000000000000one: 1 two: !include foo.yaml yaml-0.11.4.0/test/resources/empty.yaml0000644000000000000000000000000013560466562016101 0ustar0000000000000000yaml-0.11.4.0/test/resources/empty2.yaml0000644000000000000000000000001213560466562016166 0ustar0000000000000000# comment yaml-0.11.4.0/README.md0000644000000000000000000000216313560466562012361 0ustar0000000000000000## yaml [![Build Status](https://travis-ci.org/snoyberg/yaml.svg?branch=master)](https://travis-ci.org/snoyberg/yaml) [![Build status](https://ci.appveyor.com/api/projects/status/hqy2jketp8m502so/branch/master?svg=true)](https://ci.appveyor.com/project/snoyberg/yaml/branch/master) Provides support for parsing and emitting Yaml documents. `Data.Yaml` provides a high-level interface based around the JSON datatypes provided by the `aeson` package. It uses `Text.Libyaml` from `libyaml` in its implementation of the low-level yaml encoder/decoder. ### Examples Usage examples can be found in the `Data.Yaml` documentation or in the [examples](https://github.com/snoyberg/yaml/tree/master/yaml/examples) directory. ### Additional `yaml` modules * `Data.Yaml.Include` supports adding `!include` directives to your YAML files. * `Data.Yaml.Builder` and `Data.Yaml.Parser` allow more fine-grained control of parsing an rendering, as opposed to just using the aeson typeclass and datatype system for parsing and rendering. * `Data.Yaml.Aeson` is currently a re-export of `Data.Yaml` to explicitly choose to use the aeson-compatible API. yaml-0.11.4.0/ChangeLog.md0000644000000000000000000001621113654740177013253 0ustar0000000000000000# ChangeLog for yaml ## 0.11.4.0 * add `ToYaml` instance for `String` [#186](https://github.com/snoyberg/yaml/pull/186) ## 0.11.3.0 * Don't wrap up async exceptions [#185](https://github.com/snoyberg/yaml/issues/185) ## 0.11.2.0 * Reduces some of the code duplication between the `encode` and `encodePretty` functions * The output of `encodePretty` has been improved: - Multiline strings now use `Literal` style instead of `SingleQuoted` - Special keys are now quoted in mappings [#179](https://github.com/snoyberg/yaml/issues/179) * Support for complex keys in mappings: [#182](https://github.com/snoyberg/yaml/issues/182) - Adds `complexMapping` function to `Data.Yaml.Builder` - Decode functions now return a `NonStringKey` error when attempting to decode a mapping with a complex key as it is not possible to decode these to an Aeson `Value` * Adds missing `ToYaml` instances ## 0.11.1.2 * Compiles with GHC 8.8.1 (`MonadFail` split) ## 0.11.1.1 * Use the appropriate `Scientific` rendering function to avoid a memory overflow when rendering. The previously used function from `aeson` would not use scientific notation, and could use large amounts of memory for values such as `1e9999999999999`. ## 0.11.1.0 * Better error messages in the `Data.Yaml.Config` module [#168](https://github.com/snoyberg/yaml/issues/168) * Add `LoadSettingsException` exception and remove error printing from `loadYamlSettings` [#172](https://github.com/snoyberg/yaml/pull/172) ## 0.11.0.0 * Split out the `libyaml` and `Text.Libyaml` code into its own package. [#145](https://github.com/snoyberg/yaml/issues/145) ## 0.10.4.0 * Add `decodeMarked` and `decodeFileMarked` functions to `Text.Libyaml`, and extend native bindings to extract mark information. [#157](https://github.com/snoyberg/yaml/issues/157) ## 0.10.3.0 * Add support for anchors and aliases to Data.Yaml.Builder [#155](https://github.com/snoyberg/yaml/pull/155) * Fix test suite for 32 bit machines [#158](https://github.com/snoyberg/yaml/issues/158) ## 0.10.2.0 * Add `EncodeOptions` and `FormatOptions` to control the style of the encoded YAML. [#153](https://github.com/snoyberg/yaml/pull/153) * Default to using literal style for multiline strings [#152](https://github.com/snoyberg/yaml/issues/152) ## 0.10.1.1 * Correctly declare libyaml dependency on system-libyaml flag [#151](https://github.com/snoyberg/yaml/pull/151) ## 0.10.1 * Avoid incurring a `semigroups` dependency on recent GHCs. * Fix a space leak that was introduced with `0.10.0` [#147](https://github.com/snoyberg/yaml/issues/147) ## 0.10.0 * Add `decodeFileWithWarnings` which returns warnings for duplicate fields ## 0.9.0 * Expose style and tags on mappings and sequences in Text.Libyaml [#141](https://github.com/snoyberg/yaml/pull/141) ## 0.8.32 * Escape keys as necessary [#137](https://github.com/snoyberg/yaml/issues/137) * Support hexadecimal and octal number values [#135](https://github.com/snoyberg/yaml/issues/135) * More resilient `isNumeric` (should reduce cases of unneeded quoting) * hpackify * src subdir ## 0.8.31.1 * Add a workaround for a cabal bug [haskell-infra/hackage-trustees#165](https://github.com/haskell-infra/hackage-trustees/issues/165) ## 0.8.31 * Add `decodeThrow` and `decodeFileThrow` convenience functions. * Upgrade libyaml versions * Deprecate `decode` and `decodeEither` ## 0.8.30 * Removed `AppSettings` mentioned in `loadYamlSettings` error message. ## 0.8.29 * Deprecated `decodeFile` [#129](https://github.com/snoyberg/yaml/issues/129) * Turn off executables by default [#103](https://github.com/snoyberg/yaml/issues/103) ## 0.8.28 * Add `Data.Yaml.TH.yamlQQ` ## 0.8.27 * Support conduit 1.3 ## 0.8.26 * Add `Semigroup` instance [#123](https://github.com/snoyberg/yaml/pull/123) ## 0.8.25.2 * Use `throwM` instead of `monadThrow` ## 0.8.25.1 * Drop aeson-qq dep (incompatible with Stackage Nightly) ## 0.8.25 * Tweaks to the executable `yaml2json` [#119](https://github.com/snoyberg/yaml/pull/119): - Add command-line option `-h` and `--help` to show help message - Error messages are now written to `stderr` instead of `stdout` ## 0.8.24 * New encodePretty option `setConfDropNull` to drop null values from objects [#116](https://github.com/snoyberg/yaml/issues/116) ## 0.8.23.3 * Avoid over-escaping `*` [#113](https://github.com/snoyberg/yaml/issues/113) ## 0.8.23.2 * Update libyaml [#110](https://github.com/snoyberg/yaml/issues/110) ## 0.8.23.1 * Update CPP `MIN_VERSION_*` checks [#109](https://github.com/snoyberg/yaml/pull/109) ## 0.8.23 * Re-export the with helpers from aeson ## 0.8.22.1 * Make numeric string detection slightly smarter so, e.g., `.` does not get quoted ## 0.8.22 * Update to libyaml hosted on Github [#105](https://github.com/snoyberg/yaml/issues/105) ## 0.8.21.2 * Fix wrong file not found exception in `Data.Yaml.Include` with pre-1.2.3.0 `directory` [#104](https://github.com/snoyberg/yaml/pull/104) ## 0.8.21.1 * Add missing test files [#102](https://github.com/snoyberg/yaml/pull/102) ## 0.8.21 * Decode empty inputs as Null [#101](https://github.com/snoyberg/yaml/pull/101) ## 0.8.20 * Upgrade to libyaml 0.1.7 ## 0.8.19.0 * Add `Data.Yaml.TH` module ## 0.8.18.7 * Add `O_TRUNC` when opening files ## 0.8.18.6 * s/fdopen/_fdopen on Windows [#96](https://github.com/snoyberg/yaml/issues/96) ## 0.8.18.5 * Properly fix previous bug (fixes #94) ## 0.8.18.4 * Remove file with non-ASCII name due to Stack/cabal-install/Hackage restrictions (see [#92](https://github.com/snoyberg/yaml/issues/92)) ## 0.8.18.2 * Handle non-ASCII filenames correctly on Windows [#91](https://github.com/snoyberg/yaml/pull/91) ## 0.8.18.1 * Improve prettyPrintParseException when context is empty [#89](https://github.com/snoyberg/yaml/pull/89) ## 0.8.18 * Switched yaml decode function for config file readers in `Data.Yaml.Config` to the one from `Data.Yaml.Include` that supports `!include` syntax. ## 0.8.17.2 * Fix pretty-printing order of UnexpectedEvent's fields (fixes [#84](https://github.com/snoyberg/yaml/issues/84)) [#85](https://github.com/snoyberg/yaml/pull/85) ## 0.8.17.1 * Avoid bug in Cabal [#83](https://github.com/snoyberg/yaml/pull/83) ## 0.8.17 * `loadYamlSettingsArgs` ## 0.8.16.1 * Slight doc improvement ## 0.8.16 Add env variable parsing. `loadYamlSettings` can read config values from the environment with Yaml that specifies an env var. The syntax is `var: _env:ENV_VAR:default` ## 0.8.15.3 * Give a warning when compiling with GHCJS ## 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) ## 0.8.15 * Parse `Scientific` directly, avoiding loss in precision. [#68](https://github.com/snoyberg/yaml/pull/68) ## 0.8.14 * Pretty print improvements for exceptions [#67](https://github.com/snoyberg/yaml/pull/67) ## 0.8.13 * Pretty module [#66](https://github.com/snoyberg/yaml/pull/66) ## 0.8.12 * Proper handling of `String "+123"` [#64](https://github.com/snoyberg/yaml/issues/64) ## 0.8.11 * Function to print prettier parse exceptions [#59](https://github.com/snoyberg/yaml/pull/59) ## 0.8.10 Add the Data.Yaml.Include module