69 lines
2.1 KiB
Haskell
69 lines
2.1 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
{-| Convert Dhall to YAML
|
|
|
|
-}
|
|
module Dhall.Yaml
|
|
( Options(..)
|
|
, Dhall.JSON.Yaml.defaultOptions
|
|
, dhallToYaml
|
|
) where
|
|
|
|
import Data.ByteString (ByteString)
|
|
import Data.Text (Text)
|
|
import Dhall.JSON (SpecialDoubleMode(..), codeToValue)
|
|
import Dhall.JSON.Yaml (Options(..))
|
|
import Data.ByteString.Lazy (toStrict)
|
|
|
|
import qualified Data.Aeson
|
|
import qualified Data.ByteString
|
|
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{..} mFilePath code = do
|
|
|
|
let explaining = if explain then Dhall.detailed else id
|
|
|
|
json <- omission <$> explaining (codeToValue conversion UseYAMLEncoding mFilePath code)
|
|
|
|
return $ jsonToYaml json documents quoted
|
|
|
|
-- | Transform json representation into yaml
|
|
jsonToYaml
|
|
:: Data.Aeson.Value
|
|
-> Bool
|
|
-> Bool
|
|
-> ByteString
|
|
jsonToYaml json documents quoted =
|
|
case (documents, json) of
|
|
(True, Data.Aeson.Array elems)
|
|
-> Data.ByteString.intercalate "\n---\n"
|
|
$ fmap (Data.ByteString.Lazy.toStrict. (Data.YAML.Aeson.encodeValue' schemaEncoder YT.UTF8). (:[]))
|
|
$ Data.Vector.toList elems
|
|
_ -> Data.ByteString.Lazy.toStrict (Data.YAML.Aeson.encodeValue' schemaEncoder YT.UTF8 [json])
|
|
where
|
|
style (Y.SStr s)
|
|
| "\n" `Text.isInfixOf` s =
|
|
Right (YE.untagged, YE.Literal YE.Clip YE.IndentAuto, s)
|
|
| quoted =
|
|
Right (YE.untagged, YE.SingleQuoted, s)
|
|
style s =
|
|
YS.schemaEncoderScalar Y.coreSchemaEncoder s
|
|
|
|
schemaEncoder = YS.setScalarStyle style Y.coreSchemaEncoder
|