{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-| Convert Dhall to YAML

-}
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

{-| Convert a piece of 'Text' carrying a Dhall inscription to an equivalent @YAML@ 'ByteString'
-}
dhallToYaml
  :: Options
  -> Maybe FilePath  -- ^ The source file path. If no path is given, imports
                     -- are resolved relative to the current directory.
  -> Text  -- ^ Input 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

-- | Transform json representation into yaml
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
        -- For backwards compatibility with YAML 1.1, we need to add the following to the set of boolean values:
        -- https://yaml.org/type/bool.html
        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