1{-# LANGUAGE CPP #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE OverloadedStrings #-}
4
5-- | Provides a high-level interface for processing YAML files.
6--
7-- This module reuses most of the infrastructure from the @aeson@ package.
8-- This means that you can use all of the existing tools for JSON
9-- processing for processing YAML files. As a result, much of the
10-- documentation below mentions JSON; do not let that confuse you, it's
11-- intentional.
12--
13-- For the most part, YAML content translates directly into JSON, and
14-- therefore there is very little data loss. If you need to deal with YAML
15-- more directly (e.g., directly deal with aliases), you should use the
16-- "Text.Libyaml" module instead.
17--
18-- For documentation on the @aeson@ types, functions, classes, and
19-- operators, please see the @Data.Aeson@ module of the @aeson@ package.
20--
21-- Look in the examples directory of the source repository for some initial
22-- pointers on how to use this library.
23
24#if (defined (ghcjs_HOST_OS))
25module Data.Yaml {-# WARNING "GHCJS is not supported yet (will break at runtime once called)." #-}
26#else
27module Data.Yaml
28#endif
29    ( -- * Encoding
30      encode
31    , encodeWith
32    , encodeFile
33    , encodeFileWith
34      -- * Decoding
35    , decodeEither'
36    , decodeFileEither
37    , decodeFileWithWarnings
38    , decodeThrow
39    , decodeFileThrow
40      -- ** Decoding multiple documents
41      --
42      -- | For situations where we need to be able to parse multiple documents
43      -- separated by `---` in a YAML stream, these functions decode a list of
44      -- values rather than a single value.
45    , decodeAllEither'
46    , decodeAllFileEither
47    , decodeAllFileWithWarnings
48    , decodeAllThrow
49    , decodeAllFileThrow
50      -- ** More control over decoding
51    , decodeHelper
52      -- * Types
53    , Value (..)
54    , Parser
55    , Object
56    , Array
57    , ParseException(..)
58    , prettyPrintParseException
59    , YamlException (..)
60    , YamlMark (..)
61      -- * Constructors and accessors
62    , object
63    , array
64    , (.=)
65    , (.:)
66    , (.:?)
67    , (.!=)
68      -- ** With helpers (since 0.8.23)
69    , withObject
70    , withText
71    , withArray
72    , withScientific
73    , withBool
74      -- * Parsing
75    , parseMonad
76    , parseEither
77    , parseMaybe
78      -- * Classes
79    , ToJSON (..)
80    , FromJSON (..)
81      -- * Custom encoding
82    , isSpecialString
83    , EncodeOptions
84    , defaultEncodeOptions
85    , defaultStringStyle
86    , setStringStyle
87    , setFormat
88    , FormatOptions
89    , defaultFormatOptions
90    , setWidth
91      -- * Deprecated
92    , decode
93    , decodeFile
94    , decodeEither
95    ) where
96#if !MIN_VERSION_base(4,8,0)
97import Control.Applicative((<$>))
98#endif
99import Control.Exception
100import Control.Monad.IO.Class (MonadIO, liftIO)
101import Control.Monad.Trans.Resource (MonadThrow, throwM)
102import Data.Aeson
103    ( Value (..), ToJSON (..), FromJSON (..), object
104    , (.=) , (.:) , (.:?) , (.!=)
105    , Object, Array
106    , withObject, withText, withArray, withScientific, withBool
107    )
108import Data.Aeson.Types (parseMaybe, parseEither, Parser)
109import Data.ByteString (ByteString)
110import Data.Conduit ((.|), runConduitRes)
111import qualified Data.Conduit.List as CL
112import qualified Data.Vector as V
113import System.IO.Unsafe (unsafePerformIO)
114import Data.Text (Text)
115
116import Data.Yaml.Internal
117import Text.Libyaml hiding (encode, decode, encodeFile, decodeFile, encodeWith, encodeFileWith)
118import qualified Text.Libyaml as Y
119
120-- | Set the string style in the encoded YAML. This is a function that decides
121-- for each string the type of YAML string to output.
122--
123-- __WARNING__: You must ensure that special strings (like @"yes"@\/@"no"@\/@"null"@\/@"1234"@) are not encoded with the 'Plain' style, because
124-- then they will be decoded as boolean, null or numeric values. You can use 'isSpecialString' to detect them.
125--
126-- By default, strings are encoded as follows:
127--
128-- * Any string containing a newline character uses the 'Literal' style
129--
130-- * Otherwise, any special string (see 'isSpecialString') uses 'SingleQuoted'
131--
132-- * Otherwise, use 'Plain'
133--
134-- @since 0.10.2.0
135setStringStyle :: (Text -> ( Tag, Style )) -> EncodeOptions -> EncodeOptions
136setStringStyle s opts = opts { encodeOptionsStringStyle = s }
137
138-- | Set the encoding formatting for the encoded YAML. By default, this is `defaultFormatOptions`.
139--
140-- @since 0.10.2.0
141setFormat :: FormatOptions -> EncodeOptions -> EncodeOptions
142setFormat f opts = opts { encodeOptionsFormat = f }
143
144-- |
145-- @since 0.10.2.0
146data EncodeOptions = EncodeOptions
147  { encodeOptionsStringStyle :: Text -> ( Tag, Style )
148  , encodeOptionsFormat :: FormatOptions
149  }
150
151-- |
152-- @since 0.10.2.0
153defaultEncodeOptions :: EncodeOptions
154defaultEncodeOptions = EncodeOptions
155  { encodeOptionsStringStyle = defaultStringStyle
156  , encodeOptionsFormat = defaultFormatOptions
157  }
158
159-- | Encode a value into its YAML representation.
160encode :: ToJSON a => a -> ByteString
161encode = encodeWith defaultEncodeOptions
162
163-- | Encode a value into its YAML representation with custom styling.
164--
165-- @since 0.10.2.0
166encodeWith :: ToJSON a => EncodeOptions -> a -> ByteString
167encodeWith opts obj = unsafePerformIO $ runConduitRes
168    $ CL.sourceList (objToStream (encodeOptionsStringStyle opts) $ toJSON obj)
169   .| Y.encodeWith (encodeOptionsFormat opts)
170
171-- | Encode a value into its YAML representation and save to the given file.
172encodeFile :: ToJSON a => FilePath -> a -> IO ()
173encodeFile = encodeFileWith defaultEncodeOptions
174
175-- | Encode a value into its YAML representation with custom styling and save to the given file.
176--
177-- @since 0.10.2.0
178encodeFileWith :: ToJSON a => EncodeOptions -> FilePath -> a -> IO ()
179encodeFileWith opts fp obj = runConduitRes
180    $ CL.sourceList (objToStream (encodeOptionsStringStyle opts) $ toJSON obj)
181   .| Y.encodeFileWith (encodeOptionsFormat opts) fp
182
183decode :: FromJSON a
184       => ByteString
185       -> Maybe a
186decode bs = unsafePerformIO
187          $ either (const Nothing) snd
188          <$> decodeHelper_ (Y.decode bs)
189{-# DEPRECATED decode "Please use decodeEither or decodeThrow, which provide information on how the decode failed" #-}
190
191decodeFile :: FromJSON a
192           => FilePath
193           -> IO (Maybe a)
194decodeFile fp = (fmap snd <$> decodeHelper (Y.decodeFile fp)) >>= either throwIO (return . either (const Nothing) id)
195{-# DEPRECATED decodeFile "Please use decodeFileEither, which does not confused type-directed and runtime exceptions." #-}
196
197-- | A version of 'decodeFile' which should not throw runtime exceptions.
198--
199-- @since 0.8.4
200decodeFileEither
201    :: FromJSON a
202    => FilePath
203    -> IO (Either ParseException a)
204decodeFileEither = fmap (fmap snd) . decodeFileWithWarnings
205
206-- | Like `decodeFileEither`, but decode multiple documents.
207--
208-- @since 0.11.5.0
209decodeAllFileEither
210    :: FromJSON a
211    => FilePath
212    -> IO (Either ParseException [a])
213decodeAllFileEither = fmap (fmap snd) . decodeAllFileWithWarnings
214
215-- | A version of `decodeFileEither` that returns warnings along with the parse
216-- result.
217--
218-- @since 0.10.0
219decodeFileWithWarnings
220    :: FromJSON a
221    => FilePath
222    -> IO (Either ParseException ([Warning], a))
223decodeFileWithWarnings = decodeHelper_ . Y.decodeFile
224
225-- | Like `decodeFileWithWarnings`, but decode multiple documents.
226--
227-- @since 0.11.5.0
228decodeAllFileWithWarnings
229    :: FromJSON a
230    => FilePath
231    -> IO (Either ParseException ([Warning], [a]))
232decodeAllFileWithWarnings = decodeAllHelper_ . Y.decodeFile
233
234decodeEither :: FromJSON a => ByteString -> Either String a
235decodeEither bs = unsafePerformIO
236                $ either (Left . prettyPrintParseException) id
237                <$> (fmap snd <$> decodeHelper (Y.decode bs))
238{-# DEPRECATED decodeEither "Please use decodeEither' or decodeThrow, which provide more useful failures" #-}
239
240-- | More helpful version of 'decodeEither' which returns the 'YamlException'.
241--
242-- @since 0.8.3
243decodeEither' :: FromJSON a => ByteString -> Either ParseException a
244decodeEither' = either Left (either (Left . AesonException) Right)
245              . unsafePerformIO
246              . fmap (fmap snd) . decodeHelper
247              . Y.decode
248
249-- | Like 'decodeEither'', but decode multiple documents.
250--
251-- @since 0.11.5.0
252decodeAllEither' :: FromJSON a => ByteString -> Either ParseException [a]
253decodeAllEither' = either Left (either (Left . AesonException) Right)
254                 . unsafePerformIO
255                 . fmap (fmap snd) . decodeAllHelper
256                 . Y.decode
257
258-- | A version of 'decodeEither'' lifted to MonadThrow
259--
260-- @since 0.8.31
261decodeThrow :: (MonadThrow m, FromJSON a) => ByteString -> m a
262decodeThrow = either throwM return . decodeEither'
263
264-- | Like `decodeThrow`, but decode multiple documents.
265--
266-- @since 0.11.5.0
267decodeAllThrow :: (MonadThrow m, FromJSON a) => ByteString -> m [a]
268decodeAllThrow = either throwM return . decodeAllEither'
269
270-- | A version of 'decodeFileEither' lifted to MonadIO
271--
272-- @since 0.8.31
273decodeFileThrow :: (MonadIO m, FromJSON a) => FilePath -> m a
274decodeFileThrow f = liftIO $ decodeFileEither f >>= either throwIO return
275
276-- | Like `decodeFileThrow`, but decode multiple documents.
277--
278-- @since 0.11.5.0
279decodeAllFileThrow :: (MonadIO m, FromJSON a) => FilePath -> m [a]
280decodeAllFileThrow f = liftIO $ decodeAllFileEither f >>= either throwIO return
281
282-- | Construct a new 'Value' from a list of 'Value's.
283array :: [Value] -> Value
284array = Array . V.fromList
285
286#if MIN_VERSION_base(4, 13, 0)
287parseMonad :: MonadFail m => (a -> Parser b) -> a -> m b
288#else
289parseMonad :: Monad m => (a -> Parser b) -> a -> m b
290#endif
291parseMonad p = either fail return . parseEither p
292{-# DEPRECATED parseMonad "With the MonadFail split, this function is going to be removed in the future. Please migrate to parseEither." #-}
293