{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Dhall.Yaml
( Options(..)
, Dhall.JSON.Yaml.defaultOptions
, dhallToYaml
) where
import Data.ByteString (ByteString)
import Data.ByteString.Lazy (toStrict)
import Data.Text (Text)
import Dhall.JSON (SpecialDoubleMode (..), codeToValue)
import Dhall.JSON.Yaml (Options (..))
import qualified Data.Aeson
import qualified Data.ByteString
import qualified Data.Char as Char
import qualified Data.Text as Text
import qualified Data.Vector
import qualified Data.YAML as Y
import qualified Data.YAML.Aeson
import qualified Data.YAML.Event as YE
import qualified Data.YAML.Schema as YS
import qualified Data.YAML.Token as YT
import qualified Dhall
import qualified Dhall.JSON.Yaml
dhallToYaml
:: Options
-> Maybe FilePath
-> Text
-> IO ByteString
dhallToYaml :: Options -> Maybe FilePath -> Text -> IO ByteString
dhallToYaml Options{Bool
Maybe FilePath
Conversion
Value -> Value
explain :: Options -> Bool
omission :: Options -> Value -> Value
documents :: Options -> Bool
quoted :: Options -> Bool
conversion :: Options -> Conversion
file :: Options -> Maybe FilePath
output :: Options -> Maybe FilePath
noEdit :: Options -> Bool
noEdit :: Bool
output :: Maybe FilePath
file :: Maybe FilePath
conversion :: Conversion
quoted :: Bool
documents :: Bool
omission :: Value -> Value
explain :: Bool
..} Maybe FilePath
mFilePath Text
code = do
let explaining :: IO a -> IO a
explaining = if Bool
explain then IO a -> IO a
forall a. IO a -> IO a
Dhall.detailed else IO a -> IO a
forall a. a -> a
id
Value
json <- Value -> Value
omission (Value -> Value) -> IO Value -> IO Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Value -> IO Value
forall a. IO a -> IO a
explaining (Conversion
-> SpecialDoubleMode -> Maybe FilePath -> Text -> IO Value
codeToValue Conversion
conversion SpecialDoubleMode
UseYAMLEncoding Maybe FilePath
mFilePath Text
code)
let header :: ByteString
header =
if Bool
noEdit
then ByteString
Dhall.JSON.Yaml.generatedCodeNotice
else ByteString
forall a. Monoid a => a
mempty
ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
header ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Value -> Bool -> Bool -> ByteString
jsonToYaml Value
json Bool
documents Bool
quoted
jsonToYaml
:: Data.Aeson.Value
-> Bool
-> Bool
-> ByteString
jsonToYaml :: Value -> Bool -> Bool -> ByteString
jsonToYaml Value
json Bool
documents Bool
quoted =
case (Bool
documents, Value
json) of
(Bool
True, Data.Aeson.Array Array
elems) -> Array -> ByteString
document Array
elems
(Bool
True, Value
value) -> Array -> ByteString
document (Value -> Array
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
value)
(Bool, Value)
_ -> ByteString -> ByteString
Data.ByteString.Lazy.toStrict ([Value] -> ByteString
encoder [Value
json])
where
document :: Array -> ByteString
document Array
elems =
ByteString -> [ByteString] -> ByteString
Data.ByteString.intercalate ByteString
"\n"
([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ((ByteString
"---\n" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString)
-> (Value -> ByteString) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Data.ByteString.Lazy.toStrict (ByteString -> ByteString)
-> (Value -> ByteString) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> ByteString
encoder ([Value] -> ByteString)
-> (Value -> [Value]) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
:[])) (Value -> ByteString) -> [Value] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array -> [Value]
forall a. Vector a -> [a]
Data.Vector.toList Array
elems
style :: Scalar -> Either FilePath (Tag, ScalarStyle, Text)
style (Y.SStr Text
s)
| Text
"\n" Text -> Text -> Bool
`Text.isInfixOf` Text
s =
(Tag, ScalarStyle, Text)
-> Either FilePath (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
YE.untagged, Chomp -> IndentOfs -> ScalarStyle
YE.Literal Chomp
YE.Clip IndentOfs
YE.IndentAuto, Text
s)
| Bool
quoted Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
isNumberOrDateRelated Text
s Bool -> Bool -> Bool
|| Bool
isBoolString =
(Tag, ScalarStyle, Text)
-> Either FilePath (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
YE.untagged, ScalarStyle
YE.SingleQuoted, Text
s)
where
isBoolString :: Bool
isBoolString = Text -> Int
Text.length Text
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
5 Bool -> Bool -> Bool
&&
Text -> Text
Text.toLower Text
s Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"y", Text
"yes", Text
"n", Text
"no", Text
"true", Text
"false", Text
"on", Text
"off"]
isNumberOrDateRelated :: Char -> Bool
isNumberOrDateRelated Char
c = Char -> Bool
Char.isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'e' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'
style Scalar
s =
SchemaEncoder -> Scalar -> Either FilePath (Tag, ScalarStyle, Text)
YS.schemaEncoderScalar SchemaEncoder
Y.coreSchemaEncoder Scalar
s
schemaEncoder :: SchemaEncoder
schemaEncoder = (Scalar -> Either FilePath (Tag, ScalarStyle, Text))
-> SchemaEncoder -> SchemaEncoder
YS.setScalarStyle Scalar -> Either FilePath (Tag, ScalarStyle, Text)
style SchemaEncoder
Y.coreSchemaEncoder
encoder :: [Value] -> ByteString
encoder = SchemaEncoder -> Encoding -> [Value] -> ByteString
Data.YAML.Aeson.encodeValue' SchemaEncoder
schemaEncoder Encoding
YT.UTF8