{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
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 =
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
-> Bool
-> Options
Options
(Bool
-> (Value -> Value)
-> Bool
-> Bool
-> Conversion
-> Maybe FilePath
-> Maybe FilePath
-> Bool
-> Options)
-> Parser Bool
-> Parser
((Value -> Value)
-> Bool
-> Bool
-> Conversion
-> Maybe FilePath
-> Maybe FilePath
-> Bool
-> 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
-> Bool
-> Options)
-> Parser (Value -> Value)
-> Parser
(Bool
-> Bool
-> Conversion
-> Maybe FilePath
-> Maybe FilePath
-> Bool
-> 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
-> Bool
-> Options)
-> Parser Bool
-> Parser
(Bool
-> Conversion
-> Maybe FilePath
-> Maybe FilePath
-> Bool
-> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
parseDocuments
Parser
(Bool
-> Conversion
-> Maybe FilePath
-> Maybe FilePath
-> Bool
-> Options)
-> Parser Bool
-> Parser
(Conversion -> Maybe FilePath -> Maybe FilePath -> Bool -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
parseQuoted
Parser
(Conversion -> Maybe FilePath -> Maybe FilePath -> Bool -> Options)
-> Parser Conversion
-> Parser (Maybe FilePath -> Maybe FilePath -> Bool -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Conversion
Dhall.JSON.parseConversion
Parser (Maybe FilePath -> Maybe FilePath -> Bool -> Options)
-> Parser (Maybe FilePath)
-> Parser (Maybe FilePath -> Bool -> 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 -> Bool -> Options)
-> Parser (Maybe FilePath) -> Parser (Bool -> 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 (Bool -> Options) -> Parser Bool -> Parser Options
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
parseNoEdit
)
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 FilePath
"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 FilePath
"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 FilePath
"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 FilePath
"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 FilePath
"FILE"
Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
Options.action FilePath
"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 FilePath
"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 FilePath
"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 FilePath
"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 FilePath
"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 FilePath
"FILE"
Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
Options.action FilePath
"file"
)
parseNoEdit :: Parser Bool
parseNoEdit =
Mod FlagFields Bool -> Parser Bool
Options.switch
( FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.long FilePath
"generated-comment"
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 FilePath
"Include a comment header warning not to edit the generated 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 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 <- ParserInfo (Maybe Options) -> IO (Maybe Options)
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
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
noEdit :: Bool
output :: Maybe FilePath
file :: Maybe FilePath
conversion :: Conversion
quoted :: Bool
documents :: Bool
omission :: Value -> Value
explain :: Bool
..} ->
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
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 (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 SomeException
e = do
Handle -> FilePath -> IO ()
System.IO.hPutStrLn Handle
System.IO.stderr FilePath
""
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