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

{- Shared code for the @dhall-to-yaml@ and @dhall-to-yaml-ng@ executables
-}
module Dhall.DhallToYaml.Main (main) where

import Control.Applicative (optional, (<|>))
import Control.Exception   (SomeException)
import Data.ByteString     (ByteString)
import Data.Text           (Text)
import Dhall.JSON          (parseConversion, parsePreservationAndOmission)
import Dhall.JSON.Yaml     (Options (..), parseDocuments, parseQuoted)
import Options.Applicative (Parser, ParserInfo)

import qualified Control.Exception
import qualified Data.ByteString
import qualified Data.Text.IO        as Text.IO
import qualified Data.Version
import qualified GHC.IO.Encoding
import qualified Options.Applicative as Options
import qualified System.Exit
import qualified System.IO

parseOptions :: Parser (Maybe Options)
parseOptions :: Parser (Maybe Options)
parseOptions =
            forall a. a -> Maybe a
Just
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (   Bool
-> (Value -> Value)
-> Bool
-> Bool
-> Conversion
-> Maybe FilePath
-> Maybe FilePath
-> Bool
-> Bool
-> Options
Options
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
parseExplain
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Value -> Value)
Dhall.JSON.parsePreservationAndOmission
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
parseDocuments
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
parseQuoted
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Conversion
Dhall.JSON.parseConversion
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser FilePath
parseFile
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser FilePath
parseOutput
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
parseNoEdit
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
parsePreserveHeader
            )
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a}. Parser (Maybe a)
parseVersion
  where
    parseExplain :: Parser Bool
parseExplain =
        Mod FlagFields Bool -> Parser Bool
Options.switch
            (   forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.long FilePath
"explain"
            forall a. Semigroup a => a -> a -> a
<>  forall (f :: * -> *) a. FilePath -> Mod f a
Options.help FilePath
"Explain error messages in detail"
            )

    parseFile :: Parser FilePath
parseFile =
        forall s. IsString s => Mod OptionFields s -> Parser s
Options.strOption
            (   forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.long FilePath
"file"
            forall a. Semigroup a => a -> a -> a
<>  forall (f :: * -> *) a. FilePath -> Mod f a
Options.help FilePath
"Read expression from a file instead of standard input"
            forall a. Semigroup a => a -> a -> a
<>  forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Options.metavar FilePath
"FILE"
            forall a. Semigroup a => a -> a -> a
<>  forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
Options.action FilePath
"file"
            )

    parseVersion :: Parser (Maybe a)
parseVersion =
        forall a. a -> Mod FlagFields a -> Parser a
Options.flag'
            forall a. Maybe a
Nothing
            (   forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.long FilePath
"version"
            forall a. Semigroup a => a -> a -> a
<>  forall (f :: * -> *) a. FilePath -> Mod f a
Options.help FilePath
"Display version"
            )

    parseOutput :: Parser FilePath
parseOutput =
        forall s. IsString s => Mod OptionFields s -> Parser s
Options.strOption
            (   forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.long FilePath
"output"
            forall a. Semigroup a => a -> a -> a
<>  forall (f :: * -> *) a. FilePath -> Mod f a
Options.help FilePath
"Write YAML to a file instead of standard output"
            forall a. Semigroup a => a -> a -> a
<>  forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Options.metavar FilePath
"FILE"
            forall a. Semigroup a => a -> a -> a
<>  forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
Options.action FilePath
"file"
            )

    parseNoEdit :: Parser Bool
parseNoEdit =
        Mod FlagFields Bool -> Parser Bool
Options.switch
           (   forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.long FilePath
"generated-comment"
           forall a. Semigroup a => a -> a -> a
<>  forall (f :: * -> *) a. FilePath -> Mod f a
Options.help FilePath
"Include a comment header warning not to edit the generated file"
           )

    parsePreserveHeader :: Parser Bool
parsePreserveHeader =
        Mod FlagFields Bool -> Parser Bool
Options.switch
           (   forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.long FilePath
"preserve-header"
           forall a. Semigroup a => a -> a -> a
<>  forall (f :: * -> *) a. FilePath -> Mod f a
Options.help FilePath
"Translate any Dhall comment header to a YAML comment header"
           )

parserInfo :: ParserInfo (Maybe Options)
parserInfo :: ParserInfo (Maybe Options)
parserInfo =
    forall a. Parser a -> InfoMod a -> ParserInfo a
Options.info
        (forall a. Parser (a -> a)
Options.helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Options)
parseOptions)
        (   forall a. InfoMod a
Options.fullDesc
        forall a. Semigroup a => a -> a -> a
<>  forall a. FilePath -> InfoMod a
Options.progDesc FilePath
"Compile Dhall to YAML"
        )

main
    :: Data.Version.Version
    -> (Options -> Maybe FilePath -> Text -> IO ByteString)
    -> IO ()
main :: Version
-> (Options -> Maybe FilePath -> Text -> IO ByteString) -> IO ()
main Version
version Options -> Maybe FilePath -> Text -> IO ByteString
dhallToYaml = do
    TextEncoding -> IO ()
GHC.IO.Encoding.setLocaleEncoding TextEncoding
GHC.IO.Encoding.utf8

    Maybe Options
maybeOptions <- forall a. ParserInfo a -> IO a
Options.execParser ParserInfo (Maybe Options)
parserInfo

    case Maybe Options
maybeOptions of
        Maybe Options
Nothing ->
            FilePath -> IO ()
putStrLn (Version -> FilePath
Data.Version.showVersion Version
version)

        Just options :: Options
options@Options{Bool
Maybe FilePath
Conversion
Value -> Value
preserveHeader :: Options -> Bool
noEdit :: Options -> Bool
output :: Options -> Maybe FilePath
file :: Options -> Maybe FilePath
conversion :: Options -> Conversion
quoted :: Options -> Bool
documents :: Options -> Bool
omission :: Options -> Value -> Value
explain :: Options -> Bool
preserveHeader :: Bool
noEdit :: Bool
output :: Maybe FilePath
file :: Maybe FilePath
conversion :: Conversion
quoted :: Bool
documents :: Bool
omission :: Value -> Value
explain :: Bool
..} ->
            forall a. IO a -> IO a
handle forall a b. (a -> b) -> a -> b
$ do
                Text
contents <- case Maybe FilePath
file of
                    Maybe FilePath
Nothing   -> IO Text
Text.IO.getContents
                    Just FilePath
path -> FilePath -> IO Text
Text.IO.readFile FilePath
path

                let write :: ByteString -> IO ()
write =
                        case Maybe FilePath
output of
                            Maybe FilePath
Nothing    -> ByteString -> IO ()
Data.ByteString.putStr
                            Just FilePath
file_ -> FilePath -> ByteString -> IO ()
Data.ByteString.writeFile FilePath
file_

                ByteString -> IO ()
write forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Options -> Maybe FilePath -> Text -> IO ByteString
dhallToYaml Options
options Maybe FilePath
file Text
contents

handle :: IO a -> IO a
handle :: forall a. IO a -> IO a
handle = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
Control.Exception.handle forall a. SomeException -> IO a
handler
  where
    handler :: SomeException -> IO a
    handler :: forall a. SomeException -> IO a
handler SomeException
e = do
        Handle -> FilePath -> IO ()
System.IO.hPutStrLn Handle
System.IO.stderr FilePath
""
        forall a. Show a => Handle -> a -> IO ()
System.IO.hPrint    Handle
System.IO.stderr SomeException
e
        forall a. IO a
System.Exit.exitFailure