Yaml.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

{-| Convert Dhall to YAML via JSON

    Since JSON is only a subset of YAML, the functionality offered here is more
    limited than what the @dhall-yaml@ package can offer.
-}
module Dhall.JSON.Yaml
  ( Options(..)
  , parseDocuments
  , parseQuoted
  , defaultOptions
  , dhallToYaml
  , jsonToYaml
  , generatedCodeNotice
  ) where

import Data.ByteString     (ByteString)
import Data.Text           (Text)
import Dhall.JSON          (Conversion (..), SpecialDoubleMode (..))
import Dhall.Parser        (Header(..))
import Options.Applicative (Parser)

import qualified Data.Aeson
import qualified Data.Aeson.Yaml
import qualified Data.ByteString.Lazy
import qualified Data.Text.Encoding
import qualified Data.Vector
import qualified Dhall
import qualified Dhall.JSON
import qualified Options.Applicative

data Options = Options
    { explain        :: Bool
    , omission       :: Data.Aeson.Value -> Data.Aeson.Value
    , documents      :: Bool
    , quoted         :: Bool
    , conversion     :: Conversion
    , file           :: Maybe FilePath
    , output         :: Maybe FilePath
    , noEdit         :: Bool
    , preserveHeader :: Bool
    }

defaultOptions :: Options
defaultOptions =
  Options { explain = False
          , omission = id
          , documents = False
          , quoted = False
          , conversion = Dhall.JSON.defaultConversion
          , file = Nothing
          , output = Nothing
          , noEdit = False
          , preserveHeader = False
          }

parseDocuments :: Parser Bool
parseDocuments =
  Options.Applicative.switch
            (   Options.Applicative.long "documents"
            <>  Options.Applicative.help "If given a Dhall list, output a document for every element.  Each document, including the first one, will be preceded by \"---\", even if there is only one document.  If not given a list, output a single document (as if it were a list of one element)"
            )

parseQuoted :: Parser Bool
parseQuoted =
  Options.Applicative.switch
            (   Options.Applicative.long "quoted"
            <>  Options.Applicative.help "Prevent from generating not quoted scalars"
            )

{-| The notice added to the top of a generated file when enabling the
    @--generated-comment@
-}
generatedCodeNotice :: ByteString
generatedCodeNotice = "# Code generated by dhall-to-yaml.  DO NOT EDIT.\n"

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

  let adapt (header, value) = (header, omission value)

  (Header comment, json) <- adapt <$> explaining (Dhall.JSON.codeToHeaderAndValue conversion UseYAMLEncoding mFilePath code)

  let suffix
        | preserveHeader = Data.Text.Encoding.encodeUtf8 comment
        | otherwise      = mempty

  let header =
          if noEdit
          then generatedCodeNotice <> suffix
          else suffix

  return $ header <> jsonToYaml json documents quoted

-- | Transform json representation into yaml
jsonToYaml
    :: Data.Aeson.Value
    -> Bool
    -> Bool
    -> ByteString
jsonToYaml json documents quoted =
  Data.ByteString.Lazy.toStrict $ case (documents, json) of
    (True, Data.Aeson.Array elems)
      -> (if quoted
            then Data.Aeson.Yaml.encodeQuotedDocuments
            else Data.Aeson.Yaml.encodeDocuments
         ) (Data.Vector.toList elems)
    (True, value)
      -> (if quoted
            then Data.Aeson.Yaml.encodeQuotedDocuments
            else Data.Aeson.Yaml.encodeDocuments
         ) [ value ]
    _ -> (if quoted
            then Data.Aeson.Yaml.encodeQuoted
            else Data.Aeson.Yaml.encode
         ) json