packages feed

yaml 0.8.31.1 → 0.8.32

raw patch · 24 files changed

+2210/−2098 lines, 24 filesdep −unsupported-ghc-versiondep ~aesondep ~basedep ~bytestring

Dependencies removed: unsupported-ghc-version

Dependency ranges changed: aeson, base, bytestring, conduit, resourcet

Files

ChangeLog.md view
@@ -1,3 +1,13 @@+# ChangeLog for yaml++## 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)
− Data/Yaml.hs 
@@ -1,219 +0,0 @@-{-# 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-    , encodeFile-      -- * Decoding-    , decodeEither'-    , decodeFileEither-    , 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 (..)-      -- * 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-    )-#if MIN_VERSION_aeson(1,0,0)-import Data.Aeson.Text (encodeToTextBuilder)-#else-import Data.Aeson.Encode (encodeToTextBuilder)-#endif-import Data.Aeson.Types (Pair, parseMaybe, parseEither, Parser)-import Data.ByteString (ByteString)-import Data.Conduit ((.|), runConduitRes)-import qualified Data.Conduit.List as CL-import qualified Data.HashMap.Strict as M-import qualified Data.HashSet as HashSet-import Data.Text.Encoding (encodeUtf8)-import qualified Data.Text.Encoding as TE-import qualified Data.Text.Lazy as TL-import Data.Text.Lazy.Builder (toLazyText)-import qualified Data.Vector as V-import System.IO.Unsafe (unsafePerformIO)--import Data.Yaml.Internal-import Text.Libyaml hiding (encode, decode, encodeFile, decodeFile)-import qualified Text.Libyaml as Y---- | Encode a value into its YAML representation.-encode :: ToJSON a => a -> ByteString-encode obj = unsafePerformIO $ runConduitRes-    $ CL.sourceList (objToEvents $ toJSON obj)-   .| Y.encode---- | Encode a value into its YAML representation and save to the given file.-encodeFile :: ToJSON a => FilePath -> a -> IO ()-encodeFile fp obj = runConduitRes-    $ CL.sourceList (objToEvents $ toJSON obj)-   .| Y.encodeFile fp--objToEvents :: Value -> [Y.Event]-objToEvents o = (:) EventStreamStart-              . (:) EventDocumentStart-              $ objToEvents' o-              [ EventDocumentEnd-              , EventStreamEnd-              ]--{- FIXME-scalarToEvent :: YamlScalar -> Event-scalarToEvent (YamlScalar v t s) = EventScalar v t s Nothing--}--objToEvents' :: Value -> [Y.Event] -> [Y.Event]---objToEvents' (Scalar s) rest = scalarToEvent s : rest-objToEvents' (Array list) rest =-    EventSequenceStart Nothing-  : foldr objToEvents' (EventSequenceEnd : rest) (V.toList list)-objToEvents' (Object pairs) rest =-    EventMappingStart Nothing-  : foldr pairToEvents (EventMappingEnd : rest) (M.toList pairs)---- Empty strings need special handling to ensure they get quoted. This avoids:--- https://github.com/snoyberg/yaml/issues/24-objToEvents' (String "") rest = EventScalar "" NoTag SingleQuoted Nothing : rest--objToEvents' (String s) rest =-    event : rest-  where-    event-        -- Make sure that special strings are encoded as strings properly.-        -- See: https://github.com/snoyberg/yaml/issues/31-        | s `HashSet.member` specialStrings || isNumeric s = EventScalar (encodeUtf8 s) NoTag SingleQuoted Nothing-        | otherwise = EventScalar (encodeUtf8 s) StrTag PlainNoTag Nothing-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--- Use aeson's implementation which gets rid of annoying decimal points-objToEvents' n@Number{} rest = EventScalar (TE.encodeUtf8 $ TL.toStrict $ toLazyText $ encodeToTextBuilder n) IntTag PlainNoTag Nothing : rest--pairToEvents :: Pair -> [Y.Event] -> [Y.Event]-pairToEvents (k, v) rest =-    EventScalar (encodeUtf8 k) StrTag PlainNoTag Nothing-  : objToEvents' v rest--decode :: FromJSON a-       => ByteString-       -> Maybe a-decode bs = unsafePerformIO-          $ either (const Nothing) id-          <$> 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 = 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 = decodeHelper_ . Y.decodeFile--decodeEither :: FromJSON a => ByteString -> Either String a-decodeEither bs = unsafePerformIO-                $ either (Left . prettyPrintParseException) id-                <$> 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-              . 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--parseMonad :: Monad m => (a -> Parser b) -> a -> m b-parseMonad p = either fail return . parseEither p
− Data/Yaml/Aeson.hs 
@@ -1,7 +0,0 @@--- | 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
− Data/Yaml/Builder.hs 
@@ -1,116 +0,0 @@-{-# 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-    , array-    , string-    , bool-    , null-    , scientific-    , number-    , toByteString-    , writeYamlFile-    , (.=)-    ) where--import Prelude hiding (null)--import Control.Arrow (second)-#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 qualified Data.HashSet as HashSet-import Data.Scientific (Scientific)-import Data.Text (Text)-import Data.Text.Encoding (encodeUtf8)-import qualified Data.Text.Encoding as TE-import qualified Data.Text.Lazy as TL-import Data.Text.Lazy.Builder (toLazyText)-import 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 [(Text, a)] where-    toYaml = mapping . map (second toYaml)-instance ToYaml a => ToYaml [a] where-    toYaml = array . map toYaml-instance ToYaml Text where-    toYaml = string-instance ToYaml Int where-    toYaml i = YamlBuilder (EventScalar (S8.pack $ show i) IntTag PlainNoTag Nothing:)--mapping :: [(Text, YamlBuilder)] -> YamlBuilder-mapping pairs = YamlBuilder $ \rest ->-    EventMappingStart Nothing : foldr addPair (EventMappingEnd : rest) pairs-  where-    addPair (key, YamlBuilder value) after-        = EventScalar (encodeUtf8 key) StrTag PlainNoTag Nothing-        : value after--array :: [YamlBuilder] -> YamlBuilder-array bs =-    YamlBuilder $ (EventSequenceStart Nothing:) . flip (foldr go) bs . (EventSequenceEnd:)-  where-    go (YamlBuilder b) = b--string :: Text -> YamlBuilder--- Empty strings need special handling to ensure they get quoted. This avoids:--- https://github.com/snoyberg/yaml/issues/24-string ""  = YamlBuilder (EventScalar "" NoTag SingleQuoted Nothing :)-string s   =-    YamlBuilder (event :)-  where-    event-        -- Make sure that special strings are encoded as strings properly.-        -- See: https://github.com/snoyberg/yaml/issues/31-        | s `HashSet.member` specialStrings || isNumeric s = EventScalar (encodeUtf8 s) NoTag SingleQuoted Nothing-        | otherwise = EventScalar (encodeUtf8 s) StrTag PlainNoTag Nothing- --- Use aeson's implementation which gets rid of annoying decimal points-scientific :: Scientific -> YamlBuilder-scientific n = YamlBuilder (EventScalar (TE.encodeUtf8 $ TL.toStrict $ toLazyText $ encodeToTextBuilder (Number n)) IntTag PlainNoTag Nothing :)--{-# DEPRECATED number "Use scientific" #-}-number :: Scientific -> YamlBuilder-number = scientific--bool :: Bool -> YamlBuilder-bool True   = YamlBuilder (EventScalar "true" BoolTag PlainNoTag Nothing :)-bool False  = YamlBuilder (EventScalar "false" BoolTag PlainNoTag Nothing :)--null :: YamlBuilder-null = YamlBuilder (EventScalar "null" NullTag PlainNoTag Nothing :)--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--toByteString :: ToYaml a => a -> ByteString-toByteString yb = unsafePerformIO $ runConduitRes $ toSource yb .| encode--writeYamlFile :: ToYaml a => FilePath -> a -> IO ()-writeYamlFile fp yb = runConduitRes $ toSource yb .| encodeFile fp
− Data/Yaml/Config.hs 
@@ -1,215 +0,0 @@-{-# 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 -> do-                putStrLn $ "loadYamlSettings: Could not parse file as YAML: " ++ fp-                throwIO 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 fromJSON value of-        Error s -> error $ "Could not convert to expected type: " ++ s-        Success 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
− Data/Yaml/Include.hs 
@@ -1,80 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE RankNTypes #-}-module Data.Yaml.Include (decodeFile, decodeFileEither) 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(..), 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 = 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 = decodeHelper_ . eventsFromFile
− Data/Yaml/Internal.hs 
@@ -1,296 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE PatternGuards #-}-{-# LANGUAGE OverloadedStrings #-}-module Data.Yaml.Internal-    (-      ParseException(..)-    , prettyPrintParseException-    , parse-    , decodeHelper-    , decodeHelper_-    , specialStrings-    , isNumeric-    ) where--#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>), Applicative(..))-#endif-import Control.Exception-import Control.Monad (liftM, ap, unless)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.Trans.Class (MonadTrans, lift)-import Control.Monad.Trans.Resource (ResourceT, runResourceT)-import Control.Monad.Trans.State-import Data.Aeson-import Data.Aeson.Types hiding (parse)-import qualified Data.Attoparsec.Text as Atto-import Data.ByteString (ByteString)-import Data.Char (toUpper)-import 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 qualified Data.Map as Map-import Data.Scientific (Scientific)-import Data.Text (Text, pack)-import qualified Data.Text as T-import Data.Text.Encoding (decodeUtf8With)-import Data.Text.Encoding.Error (lenientDecode)-import 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-                    | NonStringKeyAlias Y.AnchorName Value-                    | CyclicIncludes-    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-  NonStringKeyAlias anchor value -> unlines-    [ "Non-string key alias:"-    , "  Anchor name: " ++ anchor-    , "  Value: " ++ show value-    ]-  CyclicIncludes -> "Cyclic includes"--newtype PErrorT m a = PErrorT { runPErrorT :: m (Either ParseException a) }-instance Monad m => Functor (PErrorT m) where-    fmap = liftM-instance Monad m => Applicative (PErrorT m) where-    pure  = PErrorT . return . Right-    (<*>) = ap-instance Monad m => Monad (PErrorT m) where-    return = pure-    (PErrorT m) >>= f = PErrorT $ do-        e <- m-        case e of-            Left e' -> return $ Left e'-            Right a -> runPErrorT $ f a-instance MonadTrans PErrorT where-    lift = PErrorT . liftM Right-instance MonadIO m => MonadIO (PErrorT m) where-    liftIO = lift . liftIO--type Parse = StateT (Map.Map String Value) (ResourceT IO)--requireEvent :: Event -> ConduitM Event o Parse ()-requireEvent e = do-    f <- CL.head-    unless (f == Just e) $ liftIO $ throwIO $ UnexpectedEvent f $ Just e--parse :: ConduitM Event o Parse Value-parse = do-    streamStart <- CL.head-    case streamStart of-        Nothing ->-            -- empty string input-            return Null-        Just EventStreamStart -> do-            documentStart <- 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-            -> ConduitM Event o Parse Text-parseScalar v a style tag = do-    let res = decodeUtf8With lenientDecode v-    case a of-        Nothing -> return res-        Just an -> do-            lift $ modify (Map.insert an $ textToValue style tag res)-            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 (Atto.scientific <* Atto.endOfInput)--parseO :: ConduitM Event o Parse Value-parseO = do-    me <- CL.head-    case me of-        Just (EventScalar v tag style a) -> textToValue style tag <$> parseScalar v a style tag-        Just (EventSequenceStart a) -> parseS a id-        Just (EventMappingStart a) -> parseM a M.empty-        Just (EventAlias an) -> do-            m <- lift get-            case Map.lookup an m of-                Nothing -> liftIO $ throwIO $ UnknownAlias an-                Just v -> return v-        _ -> liftIO $ throwIO $ UnexpectedEvent me Nothing--parseS :: Y.Anchor-       -> ([Value] -> [Value])-       -> ConduitM Event o Parse Value-parseS a front = do-    me <- CL.peek-    case me of-        Just EventSequenceEnd -> do-            CL.drop 1-            let res = Array $ V.fromList $ front []-            case a of-                Nothing -> return res-                Just an -> do-                    lift $ modify $ Map.insert an res-                    return res-        _ -> do-            o <- parseO-            parseS a $ front . (:) o--parseM :: Y.Anchor-       -> M.HashMap Text Value-       -> ConduitM Event o Parse Value-parseM a front = do-    me <- CL.peek-    case me of-        Just EventMappingEnd -> do-            CL.drop 1-            let res = Object front-            case a of-                Nothing -> return res-                Just an -> do-                    lift $ modify $ Map.insert an res-                    return res-        _ -> do-            CL.drop 1-            s <- case me of-                    Just (EventScalar v tag style a') -> parseScalar v a' style tag-                    Just (EventAlias an) -> do-                        m <- lift get-                        case Map.lookup an m of-                            Nothing -> liftIO $ throwIO $ UnknownAlias an-                            Just (String t) -> return t-                            Just v -> liftIO $ throwIO $ NonStringKeyAlias an v-                    _ -> liftIO $ throwIO $ UnexpectedEvent me Nothing-            o <- parseO--            let al  = M.insert s o front-                al' = if s == pack "<<"-                         then case o of-                                  Object l  -> M.union front l-                                  Array l -> M.union front $ foldl merge' M.empty $ V.toList l-                                  _          -> al-                         else al-            parseM a al'-    where merge' al (Object om) = M.union al om-          merge' al _           = al--decodeHelper :: FromJSON a-             => ConduitM () Y.Event Parse ()-             -> IO (Either ParseException (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 $ flip evalStateT Map.empty $ runConduit $ src .| parse-    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 -> return $ Right $ parseEither parseJSON y--decodeHelper_ :: FromJSON a-              => ConduitM () Event Parse ()-              -> IO (Either ParseException a)-decodeHelper_ src = do-    x <- try $ runResourceT $ flip evalStateT Map.empty $ runConduit $ src .| parse-    return $ case x of-        Left e-            | Just pe <- fromException e -> Left pe-            | Just ye <- fromException e -> Left $ InvalidYaml $ Just (ye :: YamlException)-            | otherwise -> Left $ OtherParseException e-        Right y -> either-            (Left . AesonException)-            Right-            (parseEither parseJSON y)---- | Strings which must be escaped so as not to be treated as non-string scalars.-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 ~ *"--isNumeric :: Text -> Bool-isNumeric t =-    T.all isNumeric' t && T.any isNumber t-  where-    isNumber c = '0' <= c && c <= '9'-    isNumeric' c = isNumber c-                || c == 'e'-                || c == 'E'-                || c == '.'-                || c == '-'-                || c == '+'
− Data/Yaml/Parser.hs 
@@ -1,201 +0,0 @@-{-# 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-    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 mname) = do-        vals <- goS id-        let val = Sequence vals mname-        tell' mname val-    go (EventMappingStart 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
− Data/Yaml/Pretty.hs 
@@ -1,85 +0,0 @@-{-# LANGUAGE CPP #-}--- | Prettier YAML encoding.------ @since 0.8.13-module Data.Yaml.Pretty-    ( encodePretty-    , Config-    , getConfCompare-    , setConfCompare-    , getConfDropNull-    , setConfDropNull-    , defConfig-    ) 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-  }---- | 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
− Data/Yaml/TH.hs 
@@ -1,80 +0,0 @@-{-# 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")
README.md view
@@ -11,7 +11,7 @@  ### Examples -Usage examples can be found in the `Data.Yaml` documentation or in the [examples](./examples) directory.+Usage examples can be found in the `Data.Yaml` documentation or in the [examples](https://github.com/snoyberg/yaml/tree/master/examples) directory.  ### Additional modules
− Text/Libyaml.hs 
@@ -1,643 +0,0 @@-{-# LANGUAGE EmptyDataDecls #-}-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE TypeFamilies #-}---- | Low-level, streaming YAML interface. For a higher-level interface, see--- "Data.Yaml".-module Text.Libyaml-    ( -- * The event stream-      Event (..)-    , Style (..)-    , Tag (..)-    , AnchorName-    , Anchor-      -- * Encoding and decoding-    , encode-    , decode-    , encodeFile-    , decodeFile-      -- * Error handling-    , YamlException (..)-    , YamlMark (..)-    ) where--import Prelude hiding (pi)--import Data.Bits ((.|.))-import Foreign.C-import Foreign.Ptr-import Foreign.ForeignPtr-#if MIN_VERSION_base(4,7,0)-import Foreign.ForeignPtr.Unsafe-#endif-import Foreign.Marshal.Alloc-import qualified System.Posix.Internals as Posix--#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif-import Control.Exception (mask_, throwIO, Exception, finally)-import Control.Monad-import Control.Monad.IO.Class-import Control.Monad.Trans.Resource-import Data.Conduit hiding (Source, Sink, Conduit)-import Data.Data--import Data.ByteString (ByteString, packCStringLen)-import qualified Data.ByteString-import qualified Data.ByteString.Char8 as B8-import qualified Data.ByteString.Internal as B-import qualified Data.ByteString.Unsafe as BU--data Event =-      EventStreamStart-    | EventStreamEnd-    | EventDocumentStart-    | EventDocumentEnd-    | EventAlias !AnchorName-    | EventScalar !ByteString !Tag !Style !Anchor-    | EventSequenceStart !Anchor-    | EventSequenceEnd-    | EventMappingStart !Anchor-    | EventMappingEnd-    deriving (Show, Eq)--data Style = Any-           | Plain-           | SingleQuoted-           | DoubleQuoted-           | Literal-           | Folded-           | PlainNoTag-    deriving (Show, Read, Eq, Enum, Bounded, Ord, Data, Typeable)--data Tag = StrTag-         | FloatTag-         | NullTag-         | BoolTag-         | SetTag-         | IntTag-         | SeqTag-         | MapTag-         | UriTag String-         | NoTag-    deriving (Show, Eq, Read, Data, Typeable)--type AnchorName = String-type Anchor = Maybe AnchorName--tagToString :: Tag -> String-tagToString StrTag = "tag:yaml.org,2002:str"-tagToString FloatTag = "tag:yaml.org,2002:float"-tagToString NullTag = "tag:yaml.org,2002:null"-tagToString BoolTag = "tag:yaml.org,2002:bool"-tagToString SetTag = "tag:yaml.org,2002:set"-tagToString IntTag = "tag:yaml.org,2002:int"-tagToString SeqTag = "tag:yaml.org,2002:seq"-tagToString MapTag = "tag:yaml.org,2002:map"-tagToString (UriTag s) = s-tagToString NoTag = ""--bsToTag :: ByteString -> Tag-bsToTag = stringToTag . B8.unpack--stringToTag :: String -> Tag-stringToTag "tag:yaml.org,2002:str" = StrTag-stringToTag "tag:yaml.org,2002:float" = FloatTag-stringToTag "tag:yaml.org,2002:null" = NullTag-stringToTag "tag:yaml.org,2002:bool" = BoolTag-stringToTag "tag:yaml.org,2002:set" = SetTag-stringToTag "tag:yaml.org,2002:int" = IntTag-stringToTag "tag:yaml.org,2002:seq" = SeqTag-stringToTag "tag:yaml.org,2002:map" = MapTag-stringToTag "" = NoTag-stringToTag s = UriTag s--data ParserStruct-type Parser = Ptr ParserStruct-parserSize :: Int-parserSize = 480--data EventRawStruct-type EventRaw = Ptr EventRawStruct-eventSize :: Int-eventSize = 104--foreign import ccall unsafe "yaml_parser_initialize"-    c_yaml_parser_initialize :: Parser -> IO CInt--foreign import ccall unsafe "yaml_parser_delete"-    c_yaml_parser_delete :: Parser -> IO ()--foreign import ccall unsafe "yaml_parser_set_input_string"-    c_yaml_parser_set_input_string :: Parser-                                   -> Ptr CUChar-                                   -> CULong-                                   -> IO ()--foreign import ccall unsafe "yaml_parser_set_input_file"-    c_yaml_parser_set_input_file :: Parser-                                 -> File-                                 -> IO ()--data FileStruct-type File = Ptr FileStruct--#ifdef WINDOWS-foreign import ccall unsafe "_fdopen"-#else-foreign import ccall unsafe "fdopen"-#endif-    c_fdopen :: CInt-             -> Ptr CChar-             -> IO File-foreign import ccall unsafe "fclose"-    c_fclose :: File-             -> IO ()--foreign import ccall unsafe "fclose_helper"-    c_fclose_helper :: File -> IO ()--foreign import ccall unsafe "yaml_parser_parse"-    c_yaml_parser_parse :: Parser -> EventRaw -> IO CInt--foreign import ccall unsafe "yaml_event_delete"-    c_yaml_event_delete :: EventRaw -> IO ()--foreign import ccall "get_parser_error_problem"-    c_get_parser_error_problem :: Parser -> IO (Ptr CUChar)--foreign import ccall "get_parser_error_context"-    c_get_parser_error_context :: Parser -> IO (Ptr CUChar)--foreign import ccall unsafe "get_parser_error_index"-    c_get_parser_error_index :: Parser -> IO CULong--foreign import ccall unsafe "get_parser_error_line"-    c_get_parser_error_line :: Parser -> IO CULong--foreign import ccall unsafe "get_parser_error_column"-    c_get_parser_error_column :: Parser -> IO CULong--makeString :: MonadIO m => (a -> m (Ptr CUChar)) -> a -> m String-makeString f a = do-    cchar <- castPtr `liftM` f a-    if cchar == nullPtr-        then return ""-        else liftIO $ peekCString cchar--data EventType = YamlNoEvent-               | YamlStreamStartEvent-               | YamlStreamEndEvent-               | YamlDocumentStartEvent-               | YamlDocumentEndEvent-               | YamlAliasEvent-               | YamlScalarEvent-               | YamlSequenceStartEvent-               | YamlSequenceEndEvent-               | YamlMappingStartEvent-               | YamlMappingEndEvent-               deriving (Enum,Show)--foreign import ccall unsafe "get_event_type"-    c_get_event_type :: EventRaw -> IO CInt--foreign import ccall unsafe "get_scalar_value"-    c_get_scalar_value :: EventRaw -> IO (Ptr CUChar)--foreign import ccall unsafe "get_scalar_length"-    c_get_scalar_length :: EventRaw -> IO CULong--foreign import ccall unsafe "get_scalar_tag"-    c_get_scalar_tag :: EventRaw -> IO (Ptr CUChar)--foreign import ccall unsafe "get_scalar_tag_len"-    c_get_scalar_tag_len :: EventRaw -> IO CULong--foreign import ccall unsafe "get_scalar_style"-    c_get_scalar_style :: EventRaw -> IO CInt--foreign import ccall unsafe "get_scalar_anchor"-    c_get_scalar_anchor :: EventRaw -> IO CString--foreign import ccall unsafe "get_sequence_start_anchor"-    c_get_sequence_start_anchor :: EventRaw -> IO CString--foreign import ccall unsafe "get_mapping_start_anchor"-    c_get_mapping_start_anchor :: EventRaw -> IO CString--foreign import ccall unsafe "get_alias_anchor"-    c_get_alias_anchor :: EventRaw -> IO CString--getEvent :: EventRaw -> IO (Maybe Event)-getEvent er = do-    et <- c_get_event_type er-    case toEnum $ fromEnum et of-        YamlNoEvent -> return Nothing-        YamlStreamStartEvent -> return $ Just EventStreamStart-        YamlStreamEndEvent -> return $ Just EventStreamEnd-        YamlDocumentStartEvent -> return $ Just EventDocumentStart-        YamlDocumentEndEvent -> return $ Just EventDocumentEnd-        YamlAliasEvent -> do-            yanchor <- c_get_alias_anchor er-            anchor <- if yanchor == nullPtr-                          then error "got YamlAliasEvent with empty anchor"-                          else peekCString yanchor-            return $ Just $ EventAlias anchor-        YamlScalarEvent -> do-            yvalue <- c_get_scalar_value er-            ylen <- c_get_scalar_length er-            ytag <- c_get_scalar_tag er-            ytag_len <- c_get_scalar_tag_len er-            ystyle <- c_get_scalar_style er-            let ytag_len' = fromEnum ytag_len-            let yvalue' = castPtr yvalue-            let ytag' = castPtr ytag-            let ylen' = fromEnum ylen-            bs <- packCStringLen (yvalue', ylen')-            tagbs <--                if ytag_len' == 0-                    then return Data.ByteString.empty-                    else packCStringLen (ytag', ytag_len')-            let style = toEnum $ fromEnum ystyle-            yanchor <- c_get_scalar_anchor er-            anchor <- if yanchor == nullPtr-                          then return Nothing-                          else Just <$> peekCString yanchor-            return $ Just $ EventScalar bs (bsToTag tagbs) style anchor-        YamlSequenceStartEvent -> do-            yanchor <- c_get_sequence_start_anchor er-            anchor <- if yanchor == nullPtr-                          then return Nothing-                          else Just <$> peekCString yanchor-            return $ Just $ EventSequenceStart anchor-        YamlSequenceEndEvent -> return $ Just EventSequenceEnd-        YamlMappingStartEvent -> do-            yanchor <- c_get_mapping_start_anchor er-            anchor <- if yanchor == nullPtr-                          then return Nothing-                          else Just <$> peekCString yanchor-            return $ Just $ EventMappingStart anchor-        YamlMappingEndEvent -> return $ Just EventMappingEnd---- Emitter--data EmitterStruct-type Emitter = Ptr EmitterStruct-emitterSize :: Int-emitterSize = 432--foreign import ccall unsafe "yaml_emitter_initialize"-    c_yaml_emitter_initialize :: Emitter -> IO CInt--foreign import ccall unsafe "yaml_emitter_delete"-    c_yaml_emitter_delete :: Emitter -> IO ()--data BufferStruct-type Buffer = Ptr BufferStruct-bufferSize :: Int-bufferSize = 16--foreign import ccall unsafe "buffer_init"-    c_buffer_init :: Buffer -> IO ()--foreign import ccall unsafe "get_buffer_buff"-    c_get_buffer_buff :: Buffer -> IO (Ptr CUChar)--foreign import ccall unsafe "get_buffer_used"-    c_get_buffer_used :: Buffer -> IO CULong--foreign import ccall unsafe "my_emitter_set_output"-    c_my_emitter_set_output :: Emitter -> Buffer -> IO ()--#ifndef __NO_UNICODE__-foreign import ccall unsafe "yaml_emitter_set_unicode"-    c_yaml_emitter_set_unicode :: Emitter -> CInt -> IO ()-#endif--foreign import ccall unsafe "yaml_emitter_set_output_file"-    c_yaml_emitter_set_output_file :: Emitter -> File -> IO ()--foreign import ccall unsafe "yaml_emitter_emit"-    c_yaml_emitter_emit :: Emitter -> EventRaw -> IO CInt--foreign import ccall unsafe "yaml_stream_start_event_initialize"-    c_yaml_stream_start_event_initialize :: EventRaw -> CInt -> IO CInt--foreign import ccall unsafe "yaml_stream_end_event_initialize"-    c_yaml_stream_end_event_initialize :: EventRaw -> IO CInt--foreign import ccall unsafe "yaml_scalar_event_initialize"-    c_yaml_scalar_event_initialize-        :: EventRaw-        -> Ptr CUChar -- anchor-        -> Ptr CUChar -- tag-        -> Ptr CUChar -- value-        -> CInt       -- length-        -> CInt       -- plain_implicit-        -> CInt       -- quoted_implicit-        -> CInt       -- style-        -> IO CInt--foreign import ccall unsafe "simple_document_start"-    c_simple_document_start :: EventRaw -> IO CInt--foreign import ccall unsafe "yaml_document_end_event_initialize"-    c_yaml_document_end_event_initialize :: EventRaw -> CInt -> IO CInt--foreign import ccall unsafe "yaml_sequence_start_event_initialize"-    c_yaml_sequence_start_event_initialize-        :: EventRaw-        -> Ptr CUChar-        -> Ptr CUChar-        -> CInt-        -> CInt-        -> IO CInt--foreign import ccall unsafe "yaml_sequence_end_event_initialize"-    c_yaml_sequence_end_event_initialize :: EventRaw -> IO CInt--foreign import ccall unsafe "yaml_mapping_start_event_initialize"-    c_yaml_mapping_start_event_initialize-        :: EventRaw-        -> Ptr CUChar-        -> Ptr CUChar-        -> CInt-        -> CInt-        -> IO CInt--foreign import ccall unsafe "yaml_mapping_end_event_initialize"-    c_yaml_mapping_end_event_initialize :: EventRaw -> IO CInt--foreign import ccall unsafe "yaml_alias_event_initialize"-    c_yaml_alias_event_initialize-        :: EventRaw-        -> Ptr CUChar-        -> IO CInt--toEventRaw :: Event -> (EventRaw -> IO a) -> IO a-toEventRaw e f = allocaBytes eventSize $ \er -> do-    ret <- case e of-        EventStreamStart ->-            c_yaml_stream_start_event_initialize-                er-                0 -- YAML_ANY_ENCODING-        EventStreamEnd ->-            c_yaml_stream_end_event_initialize er-        EventDocumentStart ->-            c_simple_document_start er-        EventDocumentEnd ->-            c_yaml_document_end_event_initialize er 1-        EventScalar bs thetag style0 anchor -> do-            BU.unsafeUseAsCStringLen bs $ \(value, len) -> do-                let value' = castPtr value :: Ptr CUChar-                    len' = fromIntegral len :: CInt-                let thetag' = tagToString thetag-                withCString thetag' $ \tag' -> do-                    let (pi, style) =-                            case style0 of-                                PlainNoTag -> (1, Plain)-                                x -> (0, x)-                        style' = toEnum $ fromEnum style-                        tagP = castPtr tag'-                        qi = if null thetag' then 1 else 0-                    case anchor of-                        Nothing ->-                            c_yaml_scalar_event_initialize-                                er-                                nullPtr -- anchor-                                tagP    -- tag-                                value'  -- value-                                len'    -- length-                                pi      -- plain_implicit-                                qi      -- quoted_implicit-                                style'  -- style-                        Just anchor' ->-                            withCString anchor' $ \anchorP' -> do-                                let anchorP = castPtr anchorP'-                                c_yaml_scalar_event_initialize-                                    er-                                    anchorP -- anchor-                                    tagP    -- tag-                                    value'  -- value-                                    len'    -- length-                                    0       -- plain_implicit-                                    qi      -- quoted_implicit-                                    style'  -- style-        EventSequenceStart Nothing ->-            c_yaml_sequence_start_event_initialize-                er-                nullPtr-                nullPtr-                1-                0 -- YAML_ANY_SEQUENCE_STYLE-        EventSequenceStart (Just anchor) ->-            withCString anchor $ \anchor' -> do-                let anchorP = castPtr anchor'-                c_yaml_sequence_start_event_initialize-                    er-                    anchorP-                    nullPtr-                    1-                    0 -- YAML_ANY_SEQUENCE_STYLE-        EventSequenceEnd ->-            c_yaml_sequence_end_event_initialize er-        EventMappingStart Nothing ->-            c_yaml_mapping_start_event_initialize-                er-                nullPtr-                nullPtr-                1-                0 -- YAML_ANY_SEQUENCE_STYLE-        EventMappingStart (Just anchor) ->-            withCString anchor $ \anchor' -> do-                let anchorP = castPtr anchor'-                c_yaml_mapping_start_event_initialize-                    er-                    anchorP-                    nullPtr-                    1-                    0 -- YAML_ANY_SEQUENCE_STYLE-        EventMappingEnd ->-            c_yaml_mapping_end_event_initialize er-        EventAlias anchor ->-            withCString anchor $ \anchorP' -> do-                let anchorP = castPtr anchorP'-                c_yaml_alias_event_initialize-                    er-                    anchorP-    unless (ret == 1) $ throwIO $ ToEventRawException ret-    f er--newtype ToEventRawException = ToEventRawException CInt-    deriving (Show, Typeable)-instance Exception ToEventRawException--decode :: MonadResource m => B.ByteString -> ConduitM i Event m ()-decode bs | B8.null bs = return ()-decode bs =-    bracketP alloc cleanup (runParser . fst)-  where-    alloc = mask_ $ do-        ptr <- mallocBytes parserSize-        res <- c_yaml_parser_initialize ptr-        if res == 0-            then do-                c_yaml_parser_delete ptr-                free ptr-                throwIO $ YamlException "Yaml out of memory"-            else do-                let (bsfptr, offset, len) = B.toForeignPtr bs-                let bsptrOrig = unsafeForeignPtrToPtr bsfptr-                let bsptr = castPtr bsptrOrig `plusPtr` offset-                c_yaml_parser_set_input_string ptr bsptr (fromIntegral len)-                return (ptr, bsfptr)-    cleanup (ptr, bsfptr) = do-        touchForeignPtr bsfptr-        c_yaml_parser_delete ptr-        free ptr---- XXX copied from GHC.IO.FD-std_flags, read_flags, output_flags, write_flags :: CInt-std_flags    = Posix.o_NOCTTY-output_flags = std_flags    .|. Posix.o_CREAT .|. Posix.o_TRUNC-read_flags   = std_flags    .|. Posix.o_RDONLY-write_flags  = output_flags .|. Posix.o_WRONLY---- | Open a C FILE* from a file path, using internal GHC API to work correctly--- on all platforms, even on non-ASCII filenames. The opening mode must be--- indicated via both 'rawOpenFlags' and 'openMode'.-openFile :: FilePath -> CInt -> String -> IO File-openFile file rawOpenFlags openMode = do-  fd <- liftIO $ Posix.withFilePath file $ \file' ->-    Posix.c_open file' rawOpenFlags 0o666-  if fd /= (-1)-    then withCString openMode $ \openMode' -> c_fdopen fd openMode'-    else return nullPtr--decodeFile :: MonadResource m => FilePath -> ConduitM i Event m ()-decodeFile file =-    bracketP alloc cleanup (runParser . fst)-  where-    alloc = mask_ $ do-        ptr <- mallocBytes parserSize-        res <- c_yaml_parser_initialize ptr-        if res == 0-            then do-                c_yaml_parser_delete ptr-                free ptr-                throwIO $ YamlException "Yaml out of memory"-            else do-                file' <- openFile file read_flags "r"-                if file' == nullPtr-                    then do-                        c_yaml_parser_delete ptr-                        free ptr-                        throwIO $ YamlException-                                $ "Yaml file not found: " ++ file-                    else do-                        c_yaml_parser_set_input_file ptr file'-                        return (ptr, file')-    cleanup (ptr, file') = do-        c_fclose_helper file'-        c_yaml_parser_delete ptr-        free ptr--runParser :: MonadResource m => Parser -> ConduitM i Event m ()-runParser parser = do-    e <- liftIO $ parserParseOne' parser-    case e of-        Left err -> liftIO $ throwIO err-        Right Nothing -> return ()-        Right (Just ev) -> yield ev >> runParser parser--parserParseOne' :: Parser-                -> IO (Either YamlException (Maybe Event))-parserParseOne' parser = allocaBytes eventSize $ \er -> do-    res <- liftIO $ c_yaml_parser_parse parser er-    flip finally (c_yaml_event_delete er) $-      if res == 0-        then do-          problem <- makeString c_get_parser_error_problem parser-          context <- makeString c_get_parser_error_context parser-          index <- c_get_parser_error_index parser-          line <- c_get_parser_error_line parser-          column <- c_get_parser_error_column parser-          let problemMark = YamlMark (fromIntegral index) (fromIntegral line) (fromIntegral column)-          return $ Left $ YamlParseException problem context problemMark-        else Right <$> getEvent er--encode :: MonadResource m => ConduitM Event o m ByteString-encode =-    runEmitter alloc close-  where-    alloc emitter = do-        fbuf <- mallocForeignPtrBytes bufferSize-        withForeignPtr fbuf c_buffer_init-        withForeignPtr fbuf $ c_my_emitter_set_output emitter-        return fbuf-    close _ fbuf = withForeignPtr fbuf $ \b -> do-        ptr' <- c_get_buffer_buff b-        len <- c_get_buffer_used b-        fptr <- newForeignPtr_ $ castPtr ptr'-        return $ B.fromForeignPtr fptr 0 $ fromIntegral len--encodeFile :: MonadResource m-           => FilePath-           -> ConduitM Event o m ()-encodeFile filePath =-    bracketP getFile c_fclose $ \file -> runEmitter (alloc file) (\u _ -> return u)-  where-    getFile = do-        file <- openFile filePath write_flags "w"-        if file == nullPtr-            then throwIO $ YamlException $ "could not open file for write: " ++ filePath-            else return file--    alloc file emitter = c_yaml_emitter_set_output_file emitter file--runEmitter :: MonadResource m-           => (Emitter -> IO a) -- ^ alloc-           -> (() -> a -> IO b) -- ^ close-           -> ConduitM Event o m b-runEmitter allocI closeI =-    bracketP alloc cleanup go-  where-    alloc = mask_ $ do-        emitter <- mallocBytes emitterSize-        res <- c_yaml_emitter_initialize emitter-        when (res == 0) $ throwIO $ YamlException "c_yaml_emitter_initialize failed"-#ifndef __NO_UNICODE__-        c_yaml_emitter_set_unicode emitter 1-#endif-        a <- allocI emitter-        return (emitter, a)-    cleanup (emitter, _) = do-        c_yaml_emitter_delete emitter-        free emitter--    go (emitter, a) =-        loop-      where-        loop = await >>= maybe (close ()) push--        push e = do-            _ <- liftIO $ toEventRaw e $ c_yaml_emitter_emit emitter-            loop-        close u = liftIO $ closeI u a---- | The pointer position-data YamlMark = YamlMark { yamlIndex :: Int, yamlLine :: Int, yamlColumn :: Int }-    deriving Show--data YamlException = YamlException String-                   -- | problem, context, index, position line, position column-                   | YamlParseException { yamlProblem :: String, yamlContext :: String, yamlProblemMark :: YamlMark }-    deriving (Show, Typeable)-instance Exception YamlException
+ src/Data/Yaml.hs view
@@ -0,0 +1,217 @@+{-# 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+    , encodeFile+      -- * Decoding+    , decodeEither'+    , decodeFileEither+    , 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 (..)+      -- * 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+    )+#if MIN_VERSION_aeson(1,0,0)+import Data.Aeson.Text (encodeToTextBuilder)+#else+import Data.Aeson.Encode (encodeToTextBuilder)+#endif+import Data.Aeson.Types (Pair, parseMaybe, parseEither, Parser)+import Data.ByteString (ByteString)+import Data.Conduit ((.|), runConduitRes)+import qualified Data.Conduit.List as CL+import qualified Data.HashMap.Strict as M+import qualified Data.HashSet as HashSet+import Data.Text.Encoding (encodeUtf8)+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy as TL+import Data.Text.Lazy.Builder (toLazyText)+import qualified Data.Vector as V+import System.IO.Unsafe (unsafePerformIO)++import Data.Yaml.Internal+import Text.Libyaml hiding (encode, decode, encodeFile, decodeFile)+import qualified Text.Libyaml as Y++-- | Encode a value into its YAML representation.+encode :: ToJSON a => a -> ByteString+encode obj = unsafePerformIO $ runConduitRes+    $ CL.sourceList (objToEvents $ toJSON obj)+   .| Y.encode++-- | Encode a value into its YAML representation and save to the given file.+encodeFile :: ToJSON a => FilePath -> a -> IO ()+encodeFile fp obj = runConduitRes+    $ CL.sourceList (objToEvents $ toJSON obj)+   .| Y.encodeFile fp++objToEvents :: Value -> [Y.Event]+objToEvents o = (:) EventStreamStart+              . (:) EventDocumentStart+              $ objToEvents' o+              [ EventDocumentEnd+              , EventStreamEnd+              ]++{- FIXME+scalarToEvent :: YamlScalar -> Event+scalarToEvent (YamlScalar v t s) = EventScalar v t s Nothing+-}++objToEvents' :: Value -> [Y.Event] -> [Y.Event]+--objToEvents' (Scalar s) rest = scalarToEvent s : rest+objToEvents' (Array list) rest =+    EventSequenceStart Nothing+  : foldr objToEvents' (EventSequenceEnd : rest) (V.toList list)+objToEvents' (Object pairs) rest =+    EventMappingStart Nothing+  : foldr pairToEvents (EventMappingEnd : rest) (M.toList pairs)++-- Empty strings need special handling to ensure they get quoted. This avoids:+-- https://github.com/snoyberg/yaml/issues/24+objToEvents' (String "") rest = EventScalar "" NoTag SingleQuoted Nothing : rest++objToEvents' (String s) rest =+    event : rest+  where+    event+        -- Make sure that special strings are encoded as strings properly.+        -- See: https://github.com/snoyberg/yaml/issues/31+        | s `HashSet.member` specialStrings || isNumeric s = EventScalar (encodeUtf8 s) NoTag SingleQuoted Nothing+        | otherwise = EventScalar (encodeUtf8 s) StrTag PlainNoTag Nothing+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+-- Use aeson's implementation which gets rid of annoying decimal points+objToEvents' n@Number{} rest = EventScalar (TE.encodeUtf8 $ TL.toStrict $ toLazyText $ encodeToTextBuilder n) IntTag PlainNoTag Nothing : rest++pairToEvents :: Pair -> [Y.Event] -> [Y.Event]+pairToEvents (k, v) = objToEvents' (String k) . objToEvents' v++decode :: FromJSON a+       => ByteString+       -> Maybe a+decode bs = unsafePerformIO+          $ either (const Nothing) id+          <$> 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 = 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 = decodeHelper_ . Y.decodeFile++decodeEither :: FromJSON a => ByteString -> Either String a+decodeEither bs = unsafePerformIO+                $ either (Left . prettyPrintParseException) id+                <$> 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+              . 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++parseMonad :: Monad m => (a -> Parser b) -> a -> m b+parseMonad p = either fail return . parseEither p
+ src/Data/Yaml/Aeson.hs view
@@ -0,0 +1,7 @@+-- | 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
+ src/Data/Yaml/Builder.hs view
@@ -0,0 +1,116 @@+{-# 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+    , array+    , string+    , bool+    , null+    , scientific+    , number+    , toByteString+    , writeYamlFile+    , (.=)+    ) where++import Prelude hiding (null)++import Control.Arrow (second)+#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 qualified Data.HashSet as HashSet+import Data.Scientific (Scientific)+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8)+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy as TL+import Data.Text.Lazy.Builder (toLazyText)+import 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 [(Text, a)] where+    toYaml = mapping . map (second toYaml)+instance ToYaml a => ToYaml [a] where+    toYaml = array . map toYaml+instance ToYaml Text where+    toYaml = string+instance ToYaml Int where+    toYaml i = YamlBuilder (EventScalar (S8.pack $ show i) IntTag PlainNoTag Nothing:)++mapping :: [(Text, YamlBuilder)] -> YamlBuilder+mapping pairs = YamlBuilder $ \rest ->+    EventMappingStart Nothing : foldr addPair (EventMappingEnd : rest) pairs+  where+    addPair (key, YamlBuilder value) after+        = EventScalar (encodeUtf8 key) StrTag PlainNoTag Nothing+        : value after++array :: [YamlBuilder] -> YamlBuilder+array bs =+    YamlBuilder $ (EventSequenceStart Nothing:) . flip (foldr go) bs . (EventSequenceEnd:)+  where+    go (YamlBuilder b) = b++string :: Text -> YamlBuilder+-- Empty strings need special handling to ensure they get quoted. This avoids:+-- https://github.com/snoyberg/yaml/issues/24+string ""  = YamlBuilder (EventScalar "" NoTag SingleQuoted Nothing :)+string s   =+    YamlBuilder (event :)+  where+    event+        -- Make sure that special strings are encoded as strings properly.+        -- See: https://github.com/snoyberg/yaml/issues/31+        | s `HashSet.member` specialStrings || isNumeric s = EventScalar (encodeUtf8 s) NoTag SingleQuoted Nothing+        | otherwise = EventScalar (encodeUtf8 s) StrTag PlainNoTag Nothing+ +-- Use aeson's implementation which gets rid of annoying decimal points+scientific :: Scientific -> YamlBuilder+scientific n = YamlBuilder (EventScalar (TE.encodeUtf8 $ TL.toStrict $ toLazyText $ encodeToTextBuilder (Number n)) IntTag PlainNoTag Nothing :)++{-# DEPRECATED number "Use scientific" #-}+number :: Scientific -> YamlBuilder+number = scientific++bool :: Bool -> YamlBuilder+bool True   = YamlBuilder (EventScalar "true" BoolTag PlainNoTag Nothing :)+bool False  = YamlBuilder (EventScalar "false" BoolTag PlainNoTag Nothing :)++null :: YamlBuilder+null = YamlBuilder (EventScalar "null" NullTag PlainNoTag Nothing :)++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++toByteString :: ToYaml a => a -> ByteString+toByteString yb = unsafePerformIO $ runConduitRes $ toSource yb .| encode++writeYamlFile :: ToYaml a => FilePath -> a -> IO ()+writeYamlFile fp yb = runConduitRes $ toSource yb .| encodeFile fp
+ src/Data/Yaml/Config.hs view
@@ -0,0 +1,215 @@+{-# 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 -> do+                putStrLn $ "loadYamlSettings: Could not parse file as YAML: " ++ fp+                throwIO 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 fromJSON value of+        Error s -> error $ "Could not convert to expected type: " ++ s+        Success 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
+ src/Data/Yaml/Include.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}+module Data.Yaml.Include (decodeFile, decodeFileEither) 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(..), 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 = 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 = decodeHelper_ . eventsFromFile
+ src/Data/Yaml/Internal.hs view
@@ -0,0 +1,299 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE OverloadedStrings #-}+module Data.Yaml.Internal+    (+      ParseException(..)+    , prettyPrintParseException+    , parse+    , decodeHelper+    , decodeHelper_+    , specialStrings+    , isNumeric+    , textToScientific+    ) where++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>), Applicative(..))+#endif+import Control.Applicative ((<|>))+import Control.Exception+import Control.Monad (liftM, ap, unless)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Class (MonadTrans, lift)+import Control.Monad.Trans.Resource (ResourceT, runResourceT)+import Control.Monad.Trans.State+import Data.Aeson+import Data.Aeson.Types hiding (parse)+import qualified Data.Attoparsec.Text as Atto+import Data.Bits (shiftL, (.|.))+import Data.ByteString (ByteString)+import Data.Char (toUpper, ord)+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 qualified Data.Map as Map+import Data.Scientific (Scientific)+import Data.Text (Text, pack)+import qualified Data.Text as T+import Data.Text.Encoding (decodeUtf8With)+import Data.Text.Encoding.Error (lenientDecode)+import 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+                    | NonStringKeyAlias Y.AnchorName Value+                    | CyclicIncludes+    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+  NonStringKeyAlias anchor value -> unlines+    [ "Non-string key alias:"+    , "  Anchor name: " ++ anchor+    , "  Value: " ++ show value+    ]+  CyclicIncludes -> "Cyclic includes"++newtype PErrorT m a = PErrorT { runPErrorT :: m (Either ParseException a) }+instance Monad m => Functor (PErrorT m) where+    fmap = liftM+instance Monad m => Applicative (PErrorT m) where+    pure  = PErrorT . return . Right+    (<*>) = ap+instance Monad m => Monad (PErrorT m) where+    return = pure+    (PErrorT m) >>= f = PErrorT $ do+        e <- m+        case e of+            Left e' -> return $ Left e'+            Right a -> runPErrorT $ f a+instance MonadTrans PErrorT where+    lift = PErrorT . liftM Right+instance MonadIO m => MonadIO (PErrorT m) where+    liftIO = lift . liftIO++type Parse = StateT (Map.Map String Value) (ResourceT IO)++requireEvent :: Event -> ConduitM Event o Parse ()+requireEvent e = do+    f <- CL.head+    unless (f == Just e) $ liftIO $ throwIO $ UnexpectedEvent f $ Just e++parse :: ConduitM Event o Parse Value+parse = do+    streamStart <- CL.head+    case streamStart of+        Nothing ->+            -- empty string input+            return Null+        Just EventStreamStart -> do+            documentStart <- 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+            -> ConduitM Event o Parse Text+parseScalar v a style tag = do+    let res = decodeUtf8With lenientDecode v+    case a of+        Nothing -> return res+        Just an -> do+            lift $ modify (Map.insert an $ textToValue style tag res)+            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 :: ConduitM Event o Parse Value+parseO = do+    me <- CL.head+    case me of+        Just (EventScalar v tag style a) -> textToValue style tag <$> parseScalar v a style tag+        Just (EventSequenceStart a) -> parseS a id+        Just (EventMappingStart a) -> parseM a M.empty+        Just (EventAlias an) -> do+            m <- lift get+            case Map.lookup an m of+                Nothing -> liftIO $ throwIO $ UnknownAlias an+                Just v -> return v+        _ -> liftIO $ throwIO $ UnexpectedEvent me Nothing++parseS :: Y.Anchor+       -> ([Value] -> [Value])+       -> ConduitM Event o Parse Value+parseS a front = do+    me <- CL.peek+    case me of+        Just EventSequenceEnd -> do+            CL.drop 1+            let res = Array $ V.fromList $ front []+            case a of+                Nothing -> return res+                Just an -> do+                    lift $ modify $ Map.insert an res+                    return res+        _ -> do+            o <- parseO+            parseS a $ front . (:) o++parseM :: Y.Anchor+       -> M.HashMap Text Value+       -> ConduitM Event o Parse Value+parseM a front = do+    me <- CL.peek+    case me of+        Just EventMappingEnd -> do+            CL.drop 1+            let res = Object front+            case a of+                Nothing -> return res+                Just an -> do+                    lift $ modify $ Map.insert an res+                    return res+        _ -> do+            CL.drop 1+            s <- case me of+                    Just (EventScalar v tag style a') -> parseScalar v a' style tag+                    Just (EventAlias an) -> do+                        m <- lift get+                        case Map.lookup an m of+                            Nothing -> liftIO $ throwIO $ UnknownAlias an+                            Just (String t) -> return t+                            Just v -> liftIO $ throwIO $ NonStringKeyAlias an v+                    _ -> liftIO $ throwIO $ UnexpectedEvent me Nothing+            o <- parseO++            let al  = M.insert s o front+                al' = if s == pack "<<"+                         then case o of+                                  Object l  -> M.union front l+                                  Array l -> M.union front $ foldl merge' M.empty $ V.toList l+                                  _          -> al+                         else al+            parseM a al'+    where merge' al (Object om) = M.union al om+          merge' al _           = al++decodeHelper :: FromJSON a+             => ConduitM () Y.Event Parse ()+             -> IO (Either ParseException (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 $ flip evalStateT Map.empty $ runConduit $ src .| parse+    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 -> return $ Right $ parseEither parseJSON y++decodeHelper_ :: FromJSON a+              => ConduitM () Event Parse ()+              -> IO (Either ParseException a)+decodeHelper_ src = do+    x <- try $ runResourceT $ flip evalStateT Map.empty $ runConduit $ src .| parse+    return $ case x of+        Left e+            | Just pe <- fromException e -> Left pe+            | Just ye <- fromException e -> Left $ InvalidYaml $ Just (ye :: YamlException)+            | otherwise -> Left $ OtherParseException e+        Right y -> either+            (Left . AesonException)+            Right+            (parseEither parseJSON y)++-- | Strings which must be escaped so as not to be treated as non-string scalars.+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 ~ *"++isNumeric :: Text -> Bool+isNumeric = either (const False) (const True) . textToScientific
+ src/Data/Yaml/Parser.hs view
@@ -0,0 +1,201 @@+{-# 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+    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 mname) = do+        vals <- goS id+        let val = Sequence vals mname+        tell' mname val+    go (EventMappingStart 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
+ src/Data/Yaml/Pretty.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE CPP #-}+-- | Prettier YAML encoding.+--+-- @since 0.8.13+module Data.Yaml.Pretty+    ( encodePretty+    , Config+    , getConfCompare+    , setConfCompare+    , getConfDropNull+    , setConfDropNull+    , defConfig+    ) 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+  }++-- | 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
+ src/Data/Yaml/TH.hs view
@@ -0,0 +1,80 @@+{-# 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")
+ src/Text/Libyaml.hs view
@@ -0,0 +1,643 @@+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}++-- | Low-level, streaming YAML interface. For a higher-level interface, see+-- "Data.Yaml".+module Text.Libyaml+    ( -- * The event stream+      Event (..)+    , Style (..)+    , Tag (..)+    , AnchorName+    , Anchor+      -- * Encoding and decoding+    , encode+    , decode+    , encodeFile+    , decodeFile+      -- * Error handling+    , YamlException (..)+    , YamlMark (..)+    ) where++import Prelude hiding (pi)++import Data.Bits ((.|.))+import Foreign.C+import Foreign.Ptr+import Foreign.ForeignPtr+#if MIN_VERSION_base(4,7,0)+import Foreign.ForeignPtr.Unsafe+#endif+import Foreign.Marshal.Alloc+import qualified System.Posix.Internals as Posix++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative+#endif+import Control.Exception (mask_, throwIO, Exception, finally)+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Resource+import Data.Conduit hiding (Source, Sink, Conduit)+import Data.Data++import Data.ByteString (ByteString, packCStringLen)+import qualified Data.ByteString+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Internal as B+import qualified Data.ByteString.Unsafe as BU++data Event =+      EventStreamStart+    | EventStreamEnd+    | EventDocumentStart+    | EventDocumentEnd+    | EventAlias !AnchorName+    | EventScalar !ByteString !Tag !Style !Anchor+    | EventSequenceStart !Anchor+    | EventSequenceEnd+    | EventMappingStart !Anchor+    | EventMappingEnd+    deriving (Show, Eq)++data Style = Any+           | Plain+           | SingleQuoted+           | DoubleQuoted+           | Literal+           | Folded+           | PlainNoTag+    deriving (Show, Read, Eq, Enum, Bounded, Ord, Data, Typeable)++data Tag = StrTag+         | FloatTag+         | NullTag+         | BoolTag+         | SetTag+         | IntTag+         | SeqTag+         | MapTag+         | UriTag String+         | NoTag+    deriving (Show, Eq, Read, Data, Typeable)++type AnchorName = String+type Anchor = Maybe AnchorName++tagToString :: Tag -> String+tagToString StrTag = "tag:yaml.org,2002:str"+tagToString FloatTag = "tag:yaml.org,2002:float"+tagToString NullTag = "tag:yaml.org,2002:null"+tagToString BoolTag = "tag:yaml.org,2002:bool"+tagToString SetTag = "tag:yaml.org,2002:set"+tagToString IntTag = "tag:yaml.org,2002:int"+tagToString SeqTag = "tag:yaml.org,2002:seq"+tagToString MapTag = "tag:yaml.org,2002:map"+tagToString (UriTag s) = s+tagToString NoTag = ""++bsToTag :: ByteString -> Tag+bsToTag = stringToTag . B8.unpack++stringToTag :: String -> Tag+stringToTag "tag:yaml.org,2002:str" = StrTag+stringToTag "tag:yaml.org,2002:float" = FloatTag+stringToTag "tag:yaml.org,2002:null" = NullTag+stringToTag "tag:yaml.org,2002:bool" = BoolTag+stringToTag "tag:yaml.org,2002:set" = SetTag+stringToTag "tag:yaml.org,2002:int" = IntTag+stringToTag "tag:yaml.org,2002:seq" = SeqTag+stringToTag "tag:yaml.org,2002:map" = MapTag+stringToTag "" = NoTag+stringToTag s = UriTag s++data ParserStruct+type Parser = Ptr ParserStruct+parserSize :: Int+parserSize = 480++data EventRawStruct+type EventRaw = Ptr EventRawStruct+eventSize :: Int+eventSize = 104++foreign import ccall unsafe "yaml_parser_initialize"+    c_yaml_parser_initialize :: Parser -> IO CInt++foreign import ccall unsafe "yaml_parser_delete"+    c_yaml_parser_delete :: Parser -> IO ()++foreign import ccall unsafe "yaml_parser_set_input_string"+    c_yaml_parser_set_input_string :: Parser+                                   -> Ptr CUChar+                                   -> CULong+                                   -> IO ()++foreign import ccall unsafe "yaml_parser_set_input_file"+    c_yaml_parser_set_input_file :: Parser+                                 -> File+                                 -> IO ()++data FileStruct+type File = Ptr FileStruct++#ifdef WINDOWS+foreign import ccall unsafe "_fdopen"+#else+foreign import ccall unsafe "fdopen"+#endif+    c_fdopen :: CInt+             -> Ptr CChar+             -> IO File+foreign import ccall unsafe "fclose"+    c_fclose :: File+             -> IO ()++foreign import ccall unsafe "fclose_helper"+    c_fclose_helper :: File -> IO ()++foreign import ccall unsafe "yaml_parser_parse"+    c_yaml_parser_parse :: Parser -> EventRaw -> IO CInt++foreign import ccall unsafe "yaml_event_delete"+    c_yaml_event_delete :: EventRaw -> IO ()++foreign import ccall "get_parser_error_problem"+    c_get_parser_error_problem :: Parser -> IO (Ptr CUChar)++foreign import ccall "get_parser_error_context"+    c_get_parser_error_context :: Parser -> IO (Ptr CUChar)++foreign import ccall unsafe "get_parser_error_index"+    c_get_parser_error_index :: Parser -> IO CULong++foreign import ccall unsafe "get_parser_error_line"+    c_get_parser_error_line :: Parser -> IO CULong++foreign import ccall unsafe "get_parser_error_column"+    c_get_parser_error_column :: Parser -> IO CULong++makeString :: MonadIO m => (a -> m (Ptr CUChar)) -> a -> m String+makeString f a = do+    cchar <- castPtr `liftM` f a+    if cchar == nullPtr+        then return ""+        else liftIO $ peekCString cchar++data EventType = YamlNoEvent+               | YamlStreamStartEvent+               | YamlStreamEndEvent+               | YamlDocumentStartEvent+               | YamlDocumentEndEvent+               | YamlAliasEvent+               | YamlScalarEvent+               | YamlSequenceStartEvent+               | YamlSequenceEndEvent+               | YamlMappingStartEvent+               | YamlMappingEndEvent+               deriving (Enum,Show)++foreign import ccall unsafe "get_event_type"+    c_get_event_type :: EventRaw -> IO CInt++foreign import ccall unsafe "get_scalar_value"+    c_get_scalar_value :: EventRaw -> IO (Ptr CUChar)++foreign import ccall unsafe "get_scalar_length"+    c_get_scalar_length :: EventRaw -> IO CULong++foreign import ccall unsafe "get_scalar_tag"+    c_get_scalar_tag :: EventRaw -> IO (Ptr CUChar)++foreign import ccall unsafe "get_scalar_tag_len"+    c_get_scalar_tag_len :: EventRaw -> IO CULong++foreign import ccall unsafe "get_scalar_style"+    c_get_scalar_style :: EventRaw -> IO CInt++foreign import ccall unsafe "get_scalar_anchor"+    c_get_scalar_anchor :: EventRaw -> IO CString++foreign import ccall unsafe "get_sequence_start_anchor"+    c_get_sequence_start_anchor :: EventRaw -> IO CString++foreign import ccall unsafe "get_mapping_start_anchor"+    c_get_mapping_start_anchor :: EventRaw -> IO CString++foreign import ccall unsafe "get_alias_anchor"+    c_get_alias_anchor :: EventRaw -> IO CString++getEvent :: EventRaw -> IO (Maybe Event)+getEvent er = do+    et <- c_get_event_type er+    case toEnum $ fromEnum et of+        YamlNoEvent -> return Nothing+        YamlStreamStartEvent -> return $ Just EventStreamStart+        YamlStreamEndEvent -> return $ Just EventStreamEnd+        YamlDocumentStartEvent -> return $ Just EventDocumentStart+        YamlDocumentEndEvent -> return $ Just EventDocumentEnd+        YamlAliasEvent -> do+            yanchor <- c_get_alias_anchor er+            anchor <- if yanchor == nullPtr+                          then error "got YamlAliasEvent with empty anchor"+                          else peekCString yanchor+            return $ Just $ EventAlias anchor+        YamlScalarEvent -> do+            yvalue <- c_get_scalar_value er+            ylen <- c_get_scalar_length er+            ytag <- c_get_scalar_tag er+            ytag_len <- c_get_scalar_tag_len er+            ystyle <- c_get_scalar_style er+            let ytag_len' = fromEnum ytag_len+            let yvalue' = castPtr yvalue+            let ytag' = castPtr ytag+            let ylen' = fromEnum ylen+            bs <- packCStringLen (yvalue', ylen')+            tagbs <-+                if ytag_len' == 0+                    then return Data.ByteString.empty+                    else packCStringLen (ytag', ytag_len')+            let style = toEnum $ fromEnum ystyle+            yanchor <- c_get_scalar_anchor er+            anchor <- if yanchor == nullPtr+                          then return Nothing+                          else Just <$> peekCString yanchor+            return $ Just $ EventScalar bs (bsToTag tagbs) style anchor+        YamlSequenceStartEvent -> do+            yanchor <- c_get_sequence_start_anchor er+            anchor <- if yanchor == nullPtr+                          then return Nothing+                          else Just <$> peekCString yanchor+            return $ Just $ EventSequenceStart anchor+        YamlSequenceEndEvent -> return $ Just EventSequenceEnd+        YamlMappingStartEvent -> do+            yanchor <- c_get_mapping_start_anchor er+            anchor <- if yanchor == nullPtr+                          then return Nothing+                          else Just <$> peekCString yanchor+            return $ Just $ EventMappingStart anchor+        YamlMappingEndEvent -> return $ Just EventMappingEnd++-- Emitter++data EmitterStruct+type Emitter = Ptr EmitterStruct+emitterSize :: Int+emitterSize = 432++foreign import ccall unsafe "yaml_emitter_initialize"+    c_yaml_emitter_initialize :: Emitter -> IO CInt++foreign import ccall unsafe "yaml_emitter_delete"+    c_yaml_emitter_delete :: Emitter -> IO ()++data BufferStruct+type Buffer = Ptr BufferStruct+bufferSize :: Int+bufferSize = 16++foreign import ccall unsafe "buffer_init"+    c_buffer_init :: Buffer -> IO ()++foreign import ccall unsafe "get_buffer_buff"+    c_get_buffer_buff :: Buffer -> IO (Ptr CUChar)++foreign import ccall unsafe "get_buffer_used"+    c_get_buffer_used :: Buffer -> IO CULong++foreign import ccall unsafe "my_emitter_set_output"+    c_my_emitter_set_output :: Emitter -> Buffer -> IO ()++#ifndef __NO_UNICODE__+foreign import ccall unsafe "yaml_emitter_set_unicode"+    c_yaml_emitter_set_unicode :: Emitter -> CInt -> IO ()+#endif++foreign import ccall unsafe "yaml_emitter_set_output_file"+    c_yaml_emitter_set_output_file :: Emitter -> File -> IO ()++foreign import ccall unsafe "yaml_emitter_emit"+    c_yaml_emitter_emit :: Emitter -> EventRaw -> IO CInt++foreign import ccall unsafe "yaml_stream_start_event_initialize"+    c_yaml_stream_start_event_initialize :: EventRaw -> CInt -> IO CInt++foreign import ccall unsafe "yaml_stream_end_event_initialize"+    c_yaml_stream_end_event_initialize :: EventRaw -> IO CInt++foreign import ccall unsafe "yaml_scalar_event_initialize"+    c_yaml_scalar_event_initialize+        :: EventRaw+        -> Ptr CUChar -- anchor+        -> Ptr CUChar -- tag+        -> Ptr CUChar -- value+        -> CInt       -- length+        -> CInt       -- plain_implicit+        -> CInt       -- quoted_implicit+        -> CInt       -- style+        -> IO CInt++foreign import ccall unsafe "simple_document_start"+    c_simple_document_start :: EventRaw -> IO CInt++foreign import ccall unsafe "yaml_document_end_event_initialize"+    c_yaml_document_end_event_initialize :: EventRaw -> CInt -> IO CInt++foreign import ccall unsafe "yaml_sequence_start_event_initialize"+    c_yaml_sequence_start_event_initialize+        :: EventRaw+        -> Ptr CUChar+        -> Ptr CUChar+        -> CInt+        -> CInt+        -> IO CInt++foreign import ccall unsafe "yaml_sequence_end_event_initialize"+    c_yaml_sequence_end_event_initialize :: EventRaw -> IO CInt++foreign import ccall unsafe "yaml_mapping_start_event_initialize"+    c_yaml_mapping_start_event_initialize+        :: EventRaw+        -> Ptr CUChar+        -> Ptr CUChar+        -> CInt+        -> CInt+        -> IO CInt++foreign import ccall unsafe "yaml_mapping_end_event_initialize"+    c_yaml_mapping_end_event_initialize :: EventRaw -> IO CInt++foreign import ccall unsafe "yaml_alias_event_initialize"+    c_yaml_alias_event_initialize+        :: EventRaw+        -> Ptr CUChar+        -> IO CInt++toEventRaw :: Event -> (EventRaw -> IO a) -> IO a+toEventRaw e f = allocaBytes eventSize $ \er -> do+    ret <- case e of+        EventStreamStart ->+            c_yaml_stream_start_event_initialize+                er+                0 -- YAML_ANY_ENCODING+        EventStreamEnd ->+            c_yaml_stream_end_event_initialize er+        EventDocumentStart ->+            c_simple_document_start er+        EventDocumentEnd ->+            c_yaml_document_end_event_initialize er 1+        EventScalar bs thetag style0 anchor -> do+            BU.unsafeUseAsCStringLen bs $ \(value, len) -> do+                let value' = castPtr value :: Ptr CUChar+                    len' = fromIntegral len :: CInt+                let thetag' = tagToString thetag+                withCString thetag' $ \tag' -> do+                    let (pi, style) =+                            case style0 of+                                PlainNoTag -> (1, Plain)+                                x -> (0, x)+                        style' = toEnum $ fromEnum style+                        tagP = castPtr tag'+                        qi = if null thetag' then 1 else 0+                    case anchor of+                        Nothing ->+                            c_yaml_scalar_event_initialize+                                er+                                nullPtr -- anchor+                                tagP    -- tag+                                value'  -- value+                                len'    -- length+                                pi      -- plain_implicit+                                qi      -- quoted_implicit+                                style'  -- style+                        Just anchor' ->+                            withCString anchor' $ \anchorP' -> do+                                let anchorP = castPtr anchorP'+                                c_yaml_scalar_event_initialize+                                    er+                                    anchorP -- anchor+                                    tagP    -- tag+                                    value'  -- value+                                    len'    -- length+                                    0       -- plain_implicit+                                    qi      -- quoted_implicit+                                    style'  -- style+        EventSequenceStart Nothing ->+            c_yaml_sequence_start_event_initialize+                er+                nullPtr+                nullPtr+                1+                0 -- YAML_ANY_SEQUENCE_STYLE+        EventSequenceStart (Just anchor) ->+            withCString anchor $ \anchor' -> do+                let anchorP = castPtr anchor'+                c_yaml_sequence_start_event_initialize+                    er+                    anchorP+                    nullPtr+                    1+                    0 -- YAML_ANY_SEQUENCE_STYLE+        EventSequenceEnd ->+            c_yaml_sequence_end_event_initialize er+        EventMappingStart Nothing ->+            c_yaml_mapping_start_event_initialize+                er+                nullPtr+                nullPtr+                1+                0 -- YAML_ANY_SEQUENCE_STYLE+        EventMappingStart (Just anchor) ->+            withCString anchor $ \anchor' -> do+                let anchorP = castPtr anchor'+                c_yaml_mapping_start_event_initialize+                    er+                    anchorP+                    nullPtr+                    1+                    0 -- YAML_ANY_SEQUENCE_STYLE+        EventMappingEnd ->+            c_yaml_mapping_end_event_initialize er+        EventAlias anchor ->+            withCString anchor $ \anchorP' -> do+                let anchorP = castPtr anchorP'+                c_yaml_alias_event_initialize+                    er+                    anchorP+    unless (ret == 1) $ throwIO $ ToEventRawException ret+    f er++newtype ToEventRawException = ToEventRawException CInt+    deriving (Show, Typeable)+instance Exception ToEventRawException++decode :: MonadResource m => B.ByteString -> ConduitM i Event m ()+decode bs | B8.null bs = return ()+decode bs =+    bracketP alloc cleanup (runParser . fst)+  where+    alloc = mask_ $ do+        ptr <- mallocBytes parserSize+        res <- c_yaml_parser_initialize ptr+        if res == 0+            then do+                c_yaml_parser_delete ptr+                free ptr+                throwIO $ YamlException "Yaml out of memory"+            else do+                let (bsfptr, offset, len) = B.toForeignPtr bs+                let bsptrOrig = unsafeForeignPtrToPtr bsfptr+                let bsptr = castPtr bsptrOrig `plusPtr` offset+                c_yaml_parser_set_input_string ptr bsptr (fromIntegral len)+                return (ptr, bsfptr)+    cleanup (ptr, bsfptr) = do+        touchForeignPtr bsfptr+        c_yaml_parser_delete ptr+        free ptr++-- XXX copied from GHC.IO.FD+std_flags, read_flags, output_flags, write_flags :: CInt+std_flags    = Posix.o_NOCTTY+output_flags = std_flags    .|. Posix.o_CREAT .|. Posix.o_TRUNC+read_flags   = std_flags    .|. Posix.o_RDONLY+write_flags  = output_flags .|. Posix.o_WRONLY++-- | Open a C FILE* from a file path, using internal GHC API to work correctly+-- on all platforms, even on non-ASCII filenames. The opening mode must be+-- indicated via both 'rawOpenFlags' and 'openMode'.+openFile :: FilePath -> CInt -> String -> IO File+openFile file rawOpenFlags openMode = do+  fd <- liftIO $ Posix.withFilePath file $ \file' ->+    Posix.c_open file' rawOpenFlags 0o666+  if fd /= (-1)+    then withCString openMode $ \openMode' -> c_fdopen fd openMode'+    else return nullPtr++decodeFile :: MonadResource m => FilePath -> ConduitM i Event m ()+decodeFile file =+    bracketP alloc cleanup (runParser . fst)+  where+    alloc = mask_ $ do+        ptr <- mallocBytes parserSize+        res <- c_yaml_parser_initialize ptr+        if res == 0+            then do+                c_yaml_parser_delete ptr+                free ptr+                throwIO $ YamlException "Yaml out of memory"+            else do+                file' <- openFile file read_flags "r"+                if file' == nullPtr+                    then do+                        c_yaml_parser_delete ptr+                        free ptr+                        throwIO $ YamlException+                                $ "Yaml file not found: " ++ file+                    else do+                        c_yaml_parser_set_input_file ptr file'+                        return (ptr, file')+    cleanup (ptr, file') = do+        c_fclose_helper file'+        c_yaml_parser_delete ptr+        free ptr++runParser :: MonadResource m => Parser -> ConduitM i Event m ()+runParser parser = do+    e <- liftIO $ parserParseOne' parser+    case e of+        Left err -> liftIO $ throwIO err+        Right Nothing -> return ()+        Right (Just ev) -> yield ev >> runParser parser++parserParseOne' :: Parser+                -> IO (Either YamlException (Maybe Event))+parserParseOne' parser = allocaBytes eventSize $ \er -> do+    res <- liftIO $ c_yaml_parser_parse parser er+    flip finally (c_yaml_event_delete er) $+      if res == 0+        then do+          problem <- makeString c_get_parser_error_problem parser+          context <- makeString c_get_parser_error_context parser+          index <- c_get_parser_error_index parser+          line <- c_get_parser_error_line parser+          column <- c_get_parser_error_column parser+          let problemMark = YamlMark (fromIntegral index) (fromIntegral line) (fromIntegral column)+          return $ Left $ YamlParseException problem context problemMark+        else Right <$> getEvent er++encode :: MonadResource m => ConduitM Event o m ByteString+encode =+    runEmitter alloc close+  where+    alloc emitter = do+        fbuf <- mallocForeignPtrBytes bufferSize+        withForeignPtr fbuf c_buffer_init+        withForeignPtr fbuf $ c_my_emitter_set_output emitter+        return fbuf+    close _ fbuf = withForeignPtr fbuf $ \b -> do+        ptr' <- c_get_buffer_buff b+        len <- c_get_buffer_used b+        fptr <- newForeignPtr_ $ castPtr ptr'+        return $ B.fromForeignPtr fptr 0 $ fromIntegral len++encodeFile :: MonadResource m+           => FilePath+           -> ConduitM Event o m ()+encodeFile filePath =+    bracketP getFile c_fclose $ \file -> runEmitter (alloc file) (\u _ -> return u)+  where+    getFile = do+        file <- openFile filePath write_flags "w"+        if file == nullPtr+            then throwIO $ YamlException $ "could not open file for write: " ++ filePath+            else return file++    alloc file emitter = c_yaml_emitter_set_output_file emitter file++runEmitter :: MonadResource m+           => (Emitter -> IO a) -- ^ alloc+           -> (() -> a -> IO b) -- ^ close+           -> ConduitM Event o m b+runEmitter allocI closeI =+    bracketP alloc cleanup go+  where+    alloc = mask_ $ do+        emitter <- mallocBytes emitterSize+        res <- c_yaml_emitter_initialize emitter+        when (res == 0) $ throwIO $ YamlException "c_yaml_emitter_initialize failed"+#ifndef __NO_UNICODE__+        c_yaml_emitter_set_unicode emitter 1+#endif+        a <- allocI emitter+        return (emitter, a)+    cleanup (emitter, _) = do+        c_yaml_emitter_delete emitter+        free emitter++    go (emitter, a) =+        loop+      where+        loop = await >>= maybe (close ()) push++        push e = do+            _ <- liftIO $ toEventRaw e $ c_yaml_emitter_emit emitter+            loop+        close u = liftIO $ closeI u a++-- | The pointer position+data YamlMark = YamlMark { yamlIndex :: Int, yamlLine :: Int, yamlColumn :: Int }+    deriving Show++data YamlException = YamlException String+                   -- | problem, context, index, position line, position column+                   | YamlParseException { yamlProblem :: String, yamlContext :: String, yamlProblemMark :: YamlMark }+    deriving (Show, Typeable)+instance Exception YamlException
test/Data/YamlSpec.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}  module Data.YamlSpec (main, spec) where @@ -28,7 +29,9 @@ 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)@@ -166,6 +169,32 @@      it "truncates files" caseTruncatesFiles +    it "quoting keys #137" $ do+      let keys = T.words "true false NO YES 1.2 1e5 null"+          bs = D.encode $ 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 ()++    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 :: Int)+      go "0xDEADBEEF" (3735928559 :: Int)+      go "1.23015e+3" (1230.15 :: Scientific)+      go "12.3015e+02" (1230.15 :: Scientific)+      go "1230.15" (1230.15 :: Scientific)  specialStrings :: [T.Text] specialStrings =
yaml.cabal view
@@ -1,173 +1,245 @@-name:            yaml-version:         0.8.31.1-license:         BSD3-license-file:    LICENSE-author:          Michael Snoyman <michael@snoyman.com>, Anton Ageev <antage@gmail.com>,Kirill Simonov-maintainer:      Michael Snoyman <michael@snoyman.com>-synopsis:        Support for parsing and rendering YAML documents.-description:     README and API documentation are available at <https://www.stackage.org/package/yaml>-category:        Web-stability:       stable-cabal-version:   >= 1.8-build-type:      Simple-homepage:        http://github.com/snoyberg/yaml/-extra-source-files: c/helper.h-                    libyaml/yaml_private.h-                    libyaml/yaml.h-                    libyaml/LICENSE-                    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+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 7a233a8f2ad181b26ff4049e7128d5380951fb67007e81166d2364c7dada6b95 -flag no-exe-  description: don't install the yaml2json or json2yaml executables-  default: True+name:           yaml+version:        0.8.32+synopsis:       Support for parsing and rendering YAML documents.+description:    README and API documentation are available at <https://www.stackage.org/package/yaml>+category:       Data+stability:      stable+homepage:       https://github.com/snoyberg/yaml#readme+bug-reports:    https://github.com/snoyberg/yaml/issues+author:         Michael Snoyman <michael@snoyman.com>, Anton Ageev <antage@gmail.com>,Kirill Simonov+maintainer:     Michael Snoyman <michael@snoyman.com>+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10+extra-source-files:+    c/helper.h+    ChangeLog.md+    libyaml/LICENSE+    libyaml/yaml.h+    libyaml/yaml_private.h+    README.md+    test/json.yaml+    test/largest-string.yaml+    test/resources/accent/foo.yaml+    test/resources/bar.yaml+    test/resources/baz.yaml+    test/resources/empty.yaml+    test/resources/empty2.yaml+    test/resources/foo.yaml+    test/resources/loop/bar.yaml+    test/resources/loop/foo.yaml +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 system-libyaml-  description: Use the system-wide libyaml instead of the bundled copy-  default: False+flag no-exe+  description: don't install the yaml2json or json2yaml executables+  manual: False+  default: True  flag no-unicode   description: Don't enable unicode output. Instead, unicode characters will be escaped.+  manual: False   default: False -library-    other-extensions: LambdaCase-    if impl(ghc < 8.0.2)-      -- Disable building with GHC before 8.0.2.-      -- Due to a cabal bug, do not use buildable: False,-      -- but instead give it an impossible constraint.-      -- See: https://github.com/haskell-infra/hackage-trustees/issues/165-      build-depends: unsupported-ghc-version > 1 && < 1-    build-depends:   base >= 4.9.1 && < 5-                   , transformers >= 0.1-                   , bytestring >= 0.9.1.4-                   , conduit >= 1.2.8 && < 1.4-                   , resourcet >= 0.3 && < 1.3-                   , aeson >= 0.11-                   , containers-                   , unordered-containers-                   , vector-                   , text-                   , attoparsec >= 0.11.3.0-                   , scientific-                   , filepath-                   , directory-                   , semigroups-                   , template-haskell-    exposed-modules: Text.Libyaml-                     Data.Yaml-                     Data.Yaml.Aeson-                     Data.Yaml.Builder-                     Data.Yaml.Config-                     Data.Yaml.Include-                     Data.Yaml.Parser-                     Data.Yaml.Pretty-                     Data.Yaml.TH-    other-modules:-                     Data.Yaml.Internal-    ghc-options:     -Wall-    c-sources:       c/helper.c-    include-dirs:    c-    if flag(no-unicode)-            cpp-options:     -D__NO_UNICODE__-    if flag(system-libyaml)-            pkgconfig-depends: yaml-0.1-    else-            c-sources:       libyaml/api.c,-                             libyaml/dumper.c,-                             libyaml/emitter.c,-                             libyaml/loader.c,-                             libyaml/parser.c,-                             libyaml/reader.c,-                             libyaml/scanner.c,-                             libyaml/writer.c-            include-dirs:    libyaml-    if os(windows)-            cpp-options:     -DWINDOWS+flag system-libyaml+  description: Use the system-wide libyaml instead of the bundled copy+  manual: False+  default: False -executable yaml2json-    if flag(no-exe)-      Buildable: False-    else-      Buildable: 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+      Text.Libyaml+  other-modules:+      Paths_yaml+  hs-source-dirs:+      src+  other-extensions: LambdaCase+  ghc-options: -Wall+  include-dirs:+      c+  c-sources:+      c/helper.c+  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+    , resourcet >=0.3 && <1.3+    , scientific+    , semigroups+    , template-haskell+    , text+    , transformers >=0.1+    , unordered-containers+    , vector+  if flag(no-unicode)+    cpp-options: -D__NO_UNICODE__+  if !(flag(system-libyaml))+    include-dirs:+        libyaml+    c-sources:+        libyaml/api.c+        libyaml/dumper.c+        libyaml/emitter.c+        libyaml/loader.c+        libyaml/parser.c+        libyaml/reader.c+        libyaml/scanner.c+        libyaml/writer.c+  if os(windows)+    cpp-options: -DWINDOWS+  default-language: Haskell2010 -    hs-source-dirs: exe-    main-is: yaml2json.hs-    build-depends: base >= 4 && < 5-                 , yaml-                 , bytestring >= 0.9.1.4-                 , aeson >= 0.7+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+    , resourcet >=0.3 && <1.3+    , scientific+    , semigroups+    , template-haskell+    , text+    , transformers >=0.1+    , unordered-containers+    , vector+  if flag(no-examples)+    buildable: False+  else+    build-depends:+        raw-strings-qq+      , yaml+  default-language: Haskell2010  executable json2yaml-    if flag(no-exe)-      Buildable: False-    else-      Buildable: True--    hs-source-dirs: exe-    main-is: json2yaml.hs-    build-depends: base >= 4 && < 5-                 , yaml-                 , bytestring >= 0.9.1.4-                 , aeson >= 0.7+  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+    , resourcet >=0.3 && <1.3+    , scientific+    , semigroups+    , template-haskell+    , text+    , transformers >=0.1+    , unordered-containers+    , vector+    , yaml+  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+    , resourcet >=0.3 && <1.3+    , scientific+    , semigroups+    , template-haskell+    , text+    , transformers >=0.1+    , unordered-containers+    , vector+    , yaml+  if flag(no-exe)+    buildable: False+  default-language: Haskell2010  test-suite spec-    type: exitcode-stdio-1.0-    hs-source-dirs:  test-    main-is:         Spec.hs-    other-modules:   Data.YamlSpec-                     Data.Yaml.IncludeSpec-                     Data.Yaml.THSpec-    cpp-options:     -DTEST-    build-depends:   hspec >= 1.3-                   , HUnit-                   , base >= 4 && < 5-                   , transformers >= 0.1-                   , bytestring >= 0.9.1.4-                   , conduit-                   , yaml-                   , text-                   , aeson >= 0.7-                   , unordered-containers-                   , directory-                   , vector-                   , resourcet-                   , mockery-                   , base-compat-                   , temporary-    ghc-options:     -Wall--executable examples-   if flag(no-examples)-      Buildable: False-   else-      Buildable: True-      build-depends: base-                   , bytestring-                   , raw-strings-qq-                   , text-                   , yaml-   hs-source-dirs: examples-   main-is: Main.hs-   other-modules: Config-                  Simple-   ghc-options:   -Wall--source-repository head-  type:     git-  location: https://github.com/snoyberg/yaml+  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+  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+    , mockery+    , resourcet >=0.3 && <1.3+    , scientific+    , semigroups+    , template-haskell+    , temporary+    , text+    , transformers >=0.1+    , unordered-containers+    , vector+    , yaml+  default-language: Haskell2010