{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
-- | NOTE: This module is a highly experimental preview release. It may change
-- drastically, or be entirely removed, in a future release.
module Data.Yaml.Builder
    ( YamlBuilder (..)
    , ToYaml (..)
    , mapping
    , namedMapping
    , maybeNamedMapping
    , mappingComplex
    , namedMappingComplex
    , maybeNamedMappingComplex
    , array
    , namedArray
    , maybeNamedArray
    , string
    , namedString
    , maybeNamedString
    , bool
    , namedBool
    , maybeNamedBool
    , null
    , namedNull
    , maybeNamedNull
    , scientific
    , namedScientific
    , maybeNamedScientific
    , alias
    , number
    , toByteString
    , toByteStringWith
    , writeYamlFile
    , writeYamlFileWith
    , (.=)
    , FormatOptions
    , setWidth
    ) where

import Prelude hiding (null)

#if MIN_VERSION_aeson(1,0,0)
import Data.Aeson.Text (encodeToTextBuilder)
#else
import Data.Aeson.Encode (encodeToTextBuilder)
#endif
import Data.Aeson.Types (Value(..))
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as S8
import Data.Conduit
import Data.Scientific (Scientific)
import Data.Text (Text, unpack)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as TL
import Data.Text.Lazy.Builder (toLazyText)
import System.IO.Unsafe (unsafePerformIO)

import Data.Yaml.Internal
import Text.Libyaml

(.=) :: ToYaml a => Text -> a -> (Text, YamlBuilder)
Text
k .= :: forall a. ToYaml a => Text -> a -> (Text, YamlBuilder)
.= a
v = (Text
k, forall a. ToYaml a => a -> YamlBuilder
toYaml a
v)

newtype YamlBuilder = YamlBuilder { YamlBuilder -> [Event] -> [Event]
unYamlBuilder :: [Event] -> [Event] }

class ToYaml a where
    toYaml :: a -> YamlBuilder
instance ToYaml YamlBuilder where
    toYaml :: YamlBuilder -> YamlBuilder
toYaml = forall a. a -> a
id
instance (ToYaml a, ToYaml b) => ToYaml [(a, b)] where
    toYaml :: [(a, b)] -> YamlBuilder
toYaml = [(YamlBuilder, YamlBuilder)] -> YamlBuilder
mappingComplex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(a
k, b
v) -> (forall a. ToYaml a => a -> YamlBuilder
toYaml a
k, forall a. ToYaml a => a -> YamlBuilder
toYaml b
v))
instance ToYaml a => ToYaml [a] where
    toYaml :: [a] -> YamlBuilder
toYaml = [YamlBuilder] -> YamlBuilder
array forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. ToYaml a => a -> YamlBuilder
toYaml
instance ToYaml Text where
    toYaml :: Text -> YamlBuilder
toYaml = Text -> YamlBuilder
string
instance {-# OVERLAPPING #-} ToYaml String where
    toYaml :: String -> YamlBuilder
toYaml = Text -> YamlBuilder
string forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
instance ToYaml Int where
    toYaml :: Int -> YamlBuilder
toYaml Int
i = ([Event] -> [Event]) -> YamlBuilder
YamlBuilder (ByteString -> Tag -> Style -> Anchor -> Event
EventScalar (String -> ByteString
S8.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
i) Tag
NoTag Style
PlainNoTag forall a. Maybe a
Nothingforall a. a -> [a] -> [a]
:)
instance ToYaml Double where
    toYaml :: Double -> YamlBuilder
toYaml Double
i = ([Event] -> [Event]) -> YamlBuilder
YamlBuilder (ByteString -> Tag -> Style -> Anchor -> Event
EventScalar (String -> ByteString
S8.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Double
i) Tag
NoTag Style
PlainNoTag forall a. Maybe a
Nothingforall a. a -> [a] -> [a]
:)
instance ToYaml Scientific where
    toYaml :: Scientific -> YamlBuilder
toYaml = Scientific -> YamlBuilder
scientific
instance ToYaml Bool where
    toYaml :: Bool -> YamlBuilder
toYaml = Bool -> YamlBuilder
bool
instance ToYaml a => ToYaml (Maybe a) where
    toYaml :: Maybe a -> YamlBuilder
toYaml = forall b a. b -> (a -> b) -> Maybe a -> b
maybe YamlBuilder
null forall a. ToYaml a => a -> YamlBuilder
toYaml

-- |
-- @since 0.10.3.0
maybeNamedMapping :: Maybe Text -> [(Text, YamlBuilder)] -> YamlBuilder
maybeNamedMapping :: Maybe Text -> [(Text, YamlBuilder)] -> YamlBuilder
maybeNamedMapping Maybe Text
anchor [(Text, YamlBuilder)]
pairs = Maybe Text -> [(YamlBuilder, YamlBuilder)] -> YamlBuilder
maybeNamedMappingComplex Maybe Text
anchor [(YamlBuilder, YamlBuilder)]
complexPairs
  where
    complexPairs :: [(YamlBuilder, YamlBuilder)]
complexPairs = forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k, YamlBuilder
v) -> (Text -> YamlBuilder
string Text
k, YamlBuilder
v)) [(Text, YamlBuilder)]
pairs

-- |
-- @since 0.8.7
mapping :: [(Text, YamlBuilder)] -> YamlBuilder
mapping :: [(Text, YamlBuilder)] -> YamlBuilder
mapping = Maybe Text -> [(Text, YamlBuilder)] -> YamlBuilder
maybeNamedMapping forall a. Maybe a
Nothing

-- |
-- @since 0.10.3.0
namedMapping :: Text -> [(Text, YamlBuilder)] -> YamlBuilder
namedMapping :: Text -> [(Text, YamlBuilder)] -> YamlBuilder
namedMapping Text
name = Maybe Text -> [(Text, YamlBuilder)] -> YamlBuilder
maybeNamedMapping forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
name

-- |
-- @since 0.11.2.0
maybeNamedMappingComplex :: Maybe Text -> [(YamlBuilder, YamlBuilder)] -> YamlBuilder
maybeNamedMappingComplex :: Maybe Text -> [(YamlBuilder, YamlBuilder)] -> YamlBuilder
maybeNamedMappingComplex Maybe Text
anchor [(YamlBuilder, YamlBuilder)]
pairs = ([Event] -> [Event]) -> YamlBuilder
YamlBuilder forall a b. (a -> b) -> a -> b
$ \[Event]
rest ->
    Tag -> MappingStyle -> Anchor -> Event
EventMappingStart Tag
NoTag MappingStyle
AnyMapping (Text -> String
unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
anchor) forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (YamlBuilder, YamlBuilder) -> [Event] -> [Event]
addPair (Event
EventMappingEnd forall a. a -> [a] -> [a]
: [Event]
rest) [(YamlBuilder, YamlBuilder)]
pairs
  where
    addPair :: (YamlBuilder, YamlBuilder) -> [Event] -> [Event]
addPair (YamlBuilder [Event] -> [Event]
key, YamlBuilder [Event] -> [Event]
value) [Event]
after = [Event] -> [Event]
key forall a b. (a -> b) -> a -> b
$ [Event] -> [Event]
value [Event]
after

-- |
-- @since 0.11.2.0
mappingComplex :: [(YamlBuilder, YamlBuilder)] -> YamlBuilder
mappingComplex :: [(YamlBuilder, YamlBuilder)] -> YamlBuilder
mappingComplex = Maybe Text -> [(YamlBuilder, YamlBuilder)] -> YamlBuilder
maybeNamedMappingComplex forall a. Maybe a
Nothing

-- |
-- @since 0.11.2.0
namedMappingComplex :: Text -> [(YamlBuilder, YamlBuilder)] -> YamlBuilder
namedMappingComplex :: Text -> [(YamlBuilder, YamlBuilder)] -> YamlBuilder
namedMappingComplex Text
name = Maybe Text -> [(YamlBuilder, YamlBuilder)] -> YamlBuilder
maybeNamedMappingComplex forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
name

-- |
-- @since 0.10.3.0
maybeNamedArray :: Maybe Text -> [YamlBuilder] -> YamlBuilder
maybeNamedArray :: Maybe Text -> [YamlBuilder] -> YamlBuilder
maybeNamedArray Maybe Text
anchor [YamlBuilder]
bs =
    ([Event] -> [Event]) -> YamlBuilder
YamlBuilder forall a b. (a -> b) -> a -> b
$ (Tag -> SequenceStyle -> Anchor -> Event
EventSequenceStart Tag
NoTag SequenceStyle
AnySequence (Text -> String
unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
anchor)forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr YamlBuilder -> [Event] -> [Event]
go) [YamlBuilder]
bs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event
EventSequenceEndforall a. a -> [a] -> [a]
:)
  where
    go :: YamlBuilder -> [Event] -> [Event]
go (YamlBuilder [Event] -> [Event]
b) = [Event] -> [Event]
b

-- |
-- @since 0.8.7
array :: [YamlBuilder] -> YamlBuilder
array :: [YamlBuilder] -> YamlBuilder
array = Maybe Text -> [YamlBuilder] -> YamlBuilder
maybeNamedArray forall a. Maybe a
Nothing

-- |
-- @since 0.10.3.0
namedArray :: Text -> [YamlBuilder] -> YamlBuilder
namedArray :: Text -> [YamlBuilder] -> YamlBuilder
namedArray Text
name = Maybe Text -> [YamlBuilder] -> YamlBuilder
maybeNamedArray forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
name

-- |
-- @since 0.10.3.0
maybeNamedString :: Maybe Text -> Text -> YamlBuilder
maybeNamedString :: Maybe Text -> Text -> YamlBuilder
maybeNamedString Maybe Text
anchor Text
s = ([Event] -> [Event]) -> YamlBuilder
YamlBuilder (StringStyle -> Maybe Text -> Text -> Event
stringScalar StringStyle
defaultStringStyle Maybe Text
anchor Text
s forall a. a -> [a] -> [a]
:)

-- |
-- @since 0.8.7
string :: Text -> YamlBuilder
string :: Text -> YamlBuilder
string = Maybe Text -> Text -> YamlBuilder
maybeNamedString forall a. Maybe a
Nothing

-- |
-- @since 0.10.3.0
namedString :: Text -> Text -> YamlBuilder
namedString :: Text -> Text -> YamlBuilder
namedString Text
name = Maybe Text -> Text -> YamlBuilder
maybeNamedString forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
name
 
-- Use aeson's implementation which gets rid of annoying decimal points
-- |
-- @since 0.10.3.0
maybeNamedScientific :: Maybe Text -> Scientific -> YamlBuilder
maybeNamedScientific :: Maybe Text -> Scientific -> YamlBuilder
maybeNamedScientific Maybe Text
anchor Scientific
n = ([Event] -> [Event]) -> YamlBuilder
YamlBuilder (ByteString -> Tag -> Style -> Anchor -> Event
EventScalar (Text -> ByteString
TE.encodeUtf8 forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.toStrict forall a b. (a -> b) -> a -> b
$ Builder -> Text
toLazyText forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Builder
encodeToTextBuilder (Scientific -> Value
Number Scientific
n)) Tag
NoTag Style
PlainNoTag (Text -> String
unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
anchor) forall a. a -> [a] -> [a]
:)

-- |
-- @since 0.8.13
scientific :: Scientific -> YamlBuilder
scientific :: Scientific -> YamlBuilder
scientific = Maybe Text -> Scientific -> YamlBuilder
maybeNamedScientific forall a. Maybe a
Nothing

-- |
-- @since 0.10.3.0
namedScientific :: Text -> Scientific -> YamlBuilder
namedScientific :: Text -> Scientific -> YamlBuilder
namedScientific Text
name = Maybe Text -> Scientific -> YamlBuilder
maybeNamedScientific forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
name

-- |
-- @since 0.8.13
{-# DEPRECATED number "Use scientific" #-}
number :: Scientific -> YamlBuilder
number :: Scientific -> YamlBuilder
number = Scientific -> YamlBuilder
scientific

-- |
-- @since 0.10.3.0
maybeNamedBool :: Maybe Text -> Bool -> YamlBuilder
maybeNamedBool :: Maybe Text -> Bool -> YamlBuilder
maybeNamedBool Maybe Text
anchor Bool
True   = ([Event] -> [Event]) -> YamlBuilder
YamlBuilder (ByteString -> Tag -> Style -> Anchor -> Event
EventScalar ByteString
"true" Tag
NoTag Style
PlainNoTag (Text -> String
unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
anchor) forall a. a -> [a] -> [a]
:)
maybeNamedBool Maybe Text
anchor Bool
False  = ([Event] -> [Event]) -> YamlBuilder
YamlBuilder (ByteString -> Tag -> Style -> Anchor -> Event
EventScalar ByteString
"false" Tag
NoTag Style
PlainNoTag (Text -> String
unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
anchor) forall a. a -> [a] -> [a]
:)

-- |
-- @since 0.8.13
bool :: Bool -> YamlBuilder
bool :: Bool -> YamlBuilder
bool = Maybe Text -> Bool -> YamlBuilder
maybeNamedBool forall a. Maybe a
Nothing

-- |
-- @since 0.10.3.0
namedBool :: Text -> Bool -> YamlBuilder
namedBool :: Text -> Bool -> YamlBuilder
namedBool Text
name = Maybe Text -> Bool -> YamlBuilder
maybeNamedBool forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
name

-- |
-- @since 0.10.3.0
maybeNamedNull :: Maybe Text -> YamlBuilder
maybeNamedNull :: Maybe Text -> YamlBuilder
maybeNamedNull Maybe Text
anchor = ([Event] -> [Event]) -> YamlBuilder
YamlBuilder (ByteString -> Tag -> Style -> Anchor -> Event
EventScalar ByteString
"null" Tag
NoTag Style
PlainNoTag (Text -> String
unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
anchor) forall a. a -> [a] -> [a]
:)

-- |
-- @since 0.8.13
null :: YamlBuilder
null :: YamlBuilder
null = Maybe Text -> YamlBuilder
maybeNamedNull forall a. Maybe a
Nothing

-- |
-- @since 0.10.3.0
namedNull :: Text -> YamlBuilder
namedNull :: Text -> YamlBuilder
namedNull Text
name = Maybe Text -> YamlBuilder
maybeNamedNull forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
name

-- |
-- @since 0.10.3.0
alias :: Text -> YamlBuilder
alias :: Text -> YamlBuilder
alias Text
anchor = ([Event] -> [Event]) -> YamlBuilder
YamlBuilder (String -> Event
EventAlias (Text -> String
unpack Text
anchor) forall a. a -> [a] -> [a]
:)

toEvents :: YamlBuilder -> [Event]
toEvents :: YamlBuilder -> [Event]
toEvents (YamlBuilder [Event] -> [Event]
front) =
    Event
EventStreamStart forall a. a -> [a] -> [a]
: Event
EventDocumentStart forall a. a -> [a] -> [a]
: [Event] -> [Event]
front [Event
EventDocumentEnd, Event
EventStreamEnd]

toSource :: (Monad m, ToYaml a) => a -> ConduitM i Event m ()
toSource :: forall (m :: * -> *) a i.
(Monad m, ToYaml a) =>
a -> ConduitM i Event m ()
toSource = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield forall b c a. (b -> c) -> (a -> b) -> a -> c
. YamlBuilder -> [Event]
toEvents forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToYaml a => a -> YamlBuilder
toYaml

-- |
-- @since 0.8.7
toByteString :: ToYaml a => a -> ByteString
toByteString :: forall a. ToYaml a => a -> ByteString
toByteString = forall a. ToYaml a => FormatOptions -> a -> ByteString
toByteStringWith FormatOptions
defaultFormatOptions

-- |
-- @since 0.10.2.0
toByteStringWith :: ToYaml a => FormatOptions -> a -> ByteString
toByteStringWith :: forall a. ToYaml a => FormatOptions -> a -> ByteString
toByteStringWith FormatOptions
opts a
yb = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a i.
(Monad m, ToYaml a) =>
a -> ConduitM i Event m ()
toSource a
yb forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) o.
MonadResource m =>
FormatOptions -> ConduitM Event o m ByteString
encodeWith FormatOptions
opts

writeYamlFile :: ToYaml a => FilePath -> a -> IO ()
writeYamlFile :: forall a. ToYaml a => String -> a -> IO ()
writeYamlFile = forall a. ToYaml a => FormatOptions -> String -> a -> IO ()
writeYamlFileWith FormatOptions
defaultFormatOptions

-- |
-- @since 0.10.2.0
writeYamlFileWith :: ToYaml a => FormatOptions -> FilePath -> a -> IO ()
writeYamlFileWith :: forall a. ToYaml a => FormatOptions -> String -> a -> IO ()
writeYamlFileWith FormatOptions
opts String
fp a
yb = forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a i.
(Monad m, ToYaml a) =>
a -> ConduitM i Event m ()
toSource a
yb forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) o.
MonadResource m =>
FormatOptions -> String -> ConduitM Event o m ()
encodeFileWith FormatOptions
opts String
fp