{-# 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.Monoid ((<>))
import Data.Text (Text)
import Dhall.JSON (parsePreservationAndOmission, parseConversion)
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 =
            Options -> Maybe Options
forall a. a -> Maybe a
Just
        (Options -> Maybe Options)
-> Parser Options -> Parser (Maybe Options)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (   Bool
-> (Value -> Value)
-> Bool
-> Bool
-> Conversion
-> Maybe FilePath
-> Maybe FilePath
-> Options
Options
            (Bool
 -> (Value -> Value)
 -> Bool
 -> Bool
 -> Conversion
 -> Maybe FilePath
 -> Maybe FilePath
 -> Options)
-> Parser Bool
-> Parser
     ((Value -> Value)
      -> Bool
      -> Bool
      -> Conversion
      -> Maybe FilePath
      -> Maybe FilePath
      -> Options)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
parseExplain
            Parser
  ((Value -> Value)
   -> Bool
   -> Bool
   -> Conversion
   -> Maybe FilePath
   -> Maybe FilePath
   -> Options)
-> Parser (Value -> Value)
-> Parser
     (Bool
      -> Bool
      -> Conversion
      -> Maybe FilePath
      -> Maybe FilePath
      -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Value -> Value)
Dhall.JSON.parsePreservationAndOmission
            Parser
  (Bool
   -> Bool
   -> Conversion
   -> Maybe FilePath
   -> Maybe FilePath
   -> Options)
-> Parser Bool
-> Parser
     (Bool -> Conversion -> Maybe FilePath -> Maybe FilePath -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
parseDocuments
            Parser
  (Bool -> Conversion -> Maybe FilePath -> Maybe FilePath -> Options)
-> Parser Bool
-> Parser
     (Conversion -> Maybe FilePath -> Maybe FilePath -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
parseQuoted
            Parser (Conversion -> Maybe FilePath -> Maybe FilePath -> Options)
-> Parser Conversion
-> Parser (Maybe FilePath -> Maybe FilePath -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Conversion
Dhall.JSON.parseConversion
            Parser (Maybe FilePath -> Maybe FilePath -> Options)
-> Parser (Maybe FilePath) -> Parser (Maybe FilePath -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser FilePath
parseFile
            Parser (Maybe FilePath -> Options)
-> Parser (Maybe FilePath) -> Parser Options
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser FilePath
parseOutput
            )
    Parser (Maybe Options)
-> Parser (Maybe Options) -> Parser (Maybe Options)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Maybe Options)
forall a. Parser (Maybe a)
parseVersion
  where
    parseExplain :: Parser Bool
parseExplain =
        Mod FlagFields Bool -> Parser Bool
Options.switch
            (   FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.long "explain"
            Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>  FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
Options.help "Explain error messages in detail"
            )

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

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

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

parserInfo :: ParserInfo (Maybe Options)
parserInfo :: ParserInfo (Maybe Options)
parserInfo =
    Parser (Maybe Options)
-> InfoMod (Maybe Options) -> ParserInfo (Maybe Options)
forall a. Parser a -> InfoMod a -> ParserInfo a
Options.info
        (Parser (Maybe Options -> Maybe Options)
forall a. Parser (a -> a)
Options.helper Parser (Maybe Options -> Maybe Options)
-> Parser (Maybe Options) -> Parser (Maybe Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Options)
parseOptions)
        (   InfoMod (Maybe Options)
forall a. InfoMod a
Options.fullDesc
        InfoMod (Maybe Options)
-> InfoMod (Maybe Options) -> InfoMod (Maybe Options)
forall a. Semigroup a => a -> a -> a
<>  FilePath -> InfoMod (Maybe Options)
forall a. FilePath -> InfoMod a
Options.progDesc "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
version dhallToYaml :: Options -> Maybe FilePath -> Text -> IO ByteString
dhallToYaml = do
    TextEncoding -> IO ()
GHC.IO.Encoding.setLocaleEncoding TextEncoding
GHC.IO.Encoding.utf8

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

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

        Just options :: Options
options@(Options {..}) -> do
            IO () -> IO ()
forall a. IO a -> IO a
handle (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                Text
contents <- case Maybe FilePath
file of
                    Nothing   -> IO Text
Text.IO.getContents
                    Just path :: FilePath
path -> FilePath -> IO Text
Text.IO.readFile FilePath
path

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

                ByteString -> IO ()
write (ByteString -> IO ()) -> IO ByteString -> IO ()
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 :: IO a -> IO a
handle = (SomeException -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
Control.Exception.handle SomeException -> IO a
forall a. SomeException -> IO a
handler
  where
    handler :: SomeException -> IO a
    handler :: SomeException -> IO a
handler e :: SomeException
e = do
        Handle -> FilePath -> IO ()
System.IO.hPutStrLn Handle
System.IO.stderr ""
        Handle -> SomeException -> IO ()
forall a. Show a => Handle -> a -> IO ()
System.IO.hPrint    Handle
System.IO.stderr SomeException
e
        IO a
forall a. IO a
System.Exit.exitFailure