From a4035b065ce3890beecdeed0fc0cad695672551f Mon Sep 17 00:00:00 2001 From: Gabriel Gonzalez Date: Sat, 13 Jul 2019 13:39:29 -0700 Subject: [PATCH 1/4] Add `--file` option to `dhall-json` executables Fixes https://github.com/dhall-lang/dhall-haskell/issues/1096 --- dhall-json/dhall-to-json/Main.hs | 68 ++++++++++++++++++++------------ dhall-json/dhall-to-yaml/Main.hs | 39 ++++++++++++------ dhall-json/json-to-dhall/Main.hs | 50 +++++++++++++++-------- dhall-json/src/Dhall/Yaml.hs | 2 + dhall-json/yaml-to-dhall/Main.hs | 49 +++++++++++++++-------- 5 files changed, 136 insertions(+), 72 deletions(-) diff --git a/dhall-json/dhall-to-json/Main.hs b/dhall-json/dhall-to-json/Main.hs index 07d556f30..7b88170c4 100644 --- a/dhall-json/dhall-to-json/Main.hs +++ b/dhall-json/dhall-to-json/Main.hs @@ -3,7 +3,7 @@ module Main where -import Control.Applicative ((<|>)) +import Control.Applicative ((<|>), optional) import Control.Exception (SomeException) import Control.Monad (when) import Data.Aeson (Value) @@ -17,12 +17,13 @@ import qualified Data.Aeson import qualified Data.Aeson.Encode.Pretty import qualified Data.ByteString.Char8 import qualified Data.ByteString.Lazy -import qualified Data.Text.IO +import qualified Data.Text as Text +import qualified Data.Text.IO as Text.IO import qualified Dhall import qualified Dhall.JSON import qualified GHC.IO.Encoding -import qualified Options.Applicative -import qualified Paths_dhall_json as Meta +import qualified Options.Applicative as Options +import qualified Paths_dhall_json as Meta import qualified System.Exit import qualified System.IO @@ -33,6 +34,7 @@ data Options = Options , version :: Bool , conversion :: Conversion , approximateSpecialDoubles :: Bool + , file :: Maybe FilePath } parseOptions :: Parser Options @@ -44,58 +46,66 @@ parseOptions = <*> parseVersion <*> Dhall.JSON.parseConversion <*> parseApproximateSpecialDoubles + <*> optional parseFile where parseExplain = - Options.Applicative.switch - ( Options.Applicative.long "explain" - <> Options.Applicative.help "Explain error messages in detail" + Options.switch + ( Options.long "explain" + <> Options.help "Explain error messages in detail" ) parsePretty = prettyFlag <|> compactFlag <|> defaultBehavior where prettyFlag = - Options.Applicative.flag' + Options.flag' True - ( Options.Applicative.long "pretty" - <> Options.Applicative.help "Pretty print generated JSON" + ( Options.long "pretty" + <> Options.help "Pretty print generated JSON" ) compactFlag = - Options.Applicative.flag' + Options.flag' False - ( Options.Applicative.long "compact" - <> Options.Applicative.help "Render JSON on one line" + ( Options.long "compact" + <> Options.help "Render JSON on one line" ) defaultBehavior = pure False parseVersion = - Options.Applicative.switch - ( Options.Applicative.long "version" - <> Options.Applicative.help "Display version" + Options.switch + ( Options.long "version" + <> Options.help "Display version" ) parseApproximateSpecialDoubles = - Options.Applicative.switch - ( Options.Applicative.long "approximate-special-doubles" - <> Options.Applicative.help "Use approximate representation for NaN/±Infinity" + Options.switch + ( Options.long "approximate-special-doubles" + <> Options.help "Use approximate representation for NaN/±Infinity" + ) + + parseFile = + Options.strOption + ( Options.long "file" + <> Options.help "Read expression from a file instead of standard input" + <> Options.metavar "FILE" ) parserInfo :: ParserInfo Options parserInfo = - Options.Applicative.info - (Options.Applicative.helper <*> parseOptions) - ( Options.Applicative.fullDesc - <> Options.Applicative.progDesc "Compile Dhall to JSON" + Options.info + (Options.helper <*> parseOptions) + ( Options.fullDesc + <> Options.progDesc "Compile Dhall to JSON" ) main :: IO () main = do GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8 - Options {..} <- Options.Applicative.execParser parserInfo + Options {..} <- Options.execParser parserInfo when version $ do putStrLn (showVersion Meta.version) @@ -119,9 +129,15 @@ main = do then ApproximateWithinJSON else ForbidWithinJSON - stdin <- Data.Text.IO.getContents + text <- case file of + Nothing -> Text.IO.getContents + Just path -> Text.IO.readFile path + + let path = case file of + Nothing -> "(stdin)" + Just p -> Text.pack p - json <- omission <$> explaining (Dhall.JSON.codeToValue conversion specialDoubleMode "(stdin)" stdin) + json <- omission <$> explaining (Dhall.JSON.codeToValue conversion specialDoubleMode path text) Data.ByteString.Char8.putStrLn $ Data.ByteString.Lazy.toStrict $ encode json diff --git a/dhall-json/dhall-to-yaml/Main.hs b/dhall-json/dhall-to-yaml/Main.hs index 3b3857572..bddb5a67c 100644 --- a/dhall-json/dhall-to-yaml/Main.hs +++ b/dhall-json/dhall-to-yaml/Main.hs @@ -2,6 +2,7 @@ {-# LANGUAGE RecordWildCards #-} module Main where +import Control.Applicative (optional) import Control.Exception (SomeException) import Data.Monoid ((<>)) import Dhall.JSON (parseOmission, parseConversion) @@ -10,9 +11,10 @@ import Options.Applicative (Parser, ParserInfo) import qualified Control.Exception import qualified Data.ByteString -import qualified Data.Text.IO +import qualified Data.Text as Text +import qualified Data.Text.IO as Text.IO import qualified GHC.IO.Encoding -import qualified Options.Applicative +import qualified Options.Applicative as Options import qualified System.Exit import qualified System.IO @@ -24,32 +26,45 @@ parseOptions = <*> parseDocuments <*> parseQuoted <*> Dhall.JSON.parseConversion + <*> optional parseFile where parseExplain = - Options.Applicative.switch - ( Options.Applicative.long "explain" - <> Options.Applicative.help "Explain error messages in detail" + Options.switch + ( Options.long "explain" + <> Options.help "Explain error messages in detail" + ) + + parseFile = + Options.strOption + ( Options.long "file" + <> Options.help "Read expression from a file instead of standard input" + <> Options.metavar "FILE" ) parserInfo :: ParserInfo Options parserInfo = - Options.Applicative.info - (Options.Applicative.helper <*> parseOptions) - ( Options.Applicative.fullDesc - <> Options.Applicative.progDesc "Compile Dhall to YAML" + Options.info + (Options.helper <*> parseOptions) + ( Options.fullDesc + <> Options.progDesc "Compile Dhall to YAML" ) main :: IO () main = do GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8 - options <- Options.Applicative.execParser parserInfo + options@Options {..} <- Options.execParser parserInfo handle $ do + contents <- case file of + Nothing -> Text.IO.getContents + Just path -> Text.IO.readFile path - stdin <- Data.Text.IO.getContents + let path = case file of + Nothing -> "(stdin)" + Just p -> Text.pack p - Data.ByteString.putStr =<< dhallToYaml options "(stdin)" stdin + Data.ByteString.putStr =<< dhallToYaml options path contents handle :: IO a -> IO a handle = Control.Exception.handle handler diff --git a/dhall-json/json-to-dhall/Main.hs b/dhall-json/json-to-dhall/Main.hs index 5634bcbd5..97b5eb217 100644 --- a/dhall-json/json-to-dhall/Main.hs +++ b/dhall-json/json-to-dhall/Main.hs @@ -8,6 +8,7 @@ module Main where +import Control.Applicative (optional) import qualified Control.Exception import Control.Exception (SomeException, throwIO) import Control.Monad (when) @@ -18,7 +19,7 @@ import Data.Text (Text) import qualified Data.Text.IO as Text import Data.Version (showVersion) import qualified GHC.IO.Encoding -import qualified Options.Applicative as O +import qualified Options.Applicative as Options import Options.Applicative (Parser, ParserInfo) import qualified System.Exit import qualified System.IO @@ -34,10 +35,10 @@ import qualified Paths_dhall_json as Meta -- | Command info and description parserInfo :: ParserInfo Options -parserInfo = O.info - ( O.helper <*> parseOptions) - ( O.fullDesc - <> O.progDesc "Populate Dhall value given its Dhall type (schema) from a JSON expression" +parserInfo = Options.info + ( Options.helper <*> parseOptions) + ( Options.fullDesc + <> Options.progDesc "Populate Dhall value given its Dhall type (schema) from a JSON expression" ) -- | All the command arguments and options @@ -45,6 +46,7 @@ data Options = Options { version :: Bool , schema :: Text , conversion :: Conversion + , file :: Maybe FilePath } deriving Show -- | Parser for all the command arguments and options @@ -52,16 +54,27 @@ parseOptions :: Parser Options parseOptions = Options <$> parseVersion <*> parseSchema <*> parseConversion + <*> optional parseFile where - parseSchema = O.strArgument - ( O.metavar "SCHEMA" - <> O.help "Dhall type expression (schema)" - ) - parseVersion = O.switch - ( O.long "version" - <> O.short 'V' - <> O.help "Display version" - ) + parseSchema = + Options.strArgument + ( Options.metavar "SCHEMA" + <> Options.help "Dhall type expression (schema)" + ) + + parseVersion = + Options.switch + ( Options.long "version" + <> Options.short 'V' + <> Options.help "Display version" + ) + + parseFile = + Options.strOption + ( Options.long "file" + <> Options.help "Read expression from a file instead of standard input" + <> Options.metavar "FILE" + ) -- ---------- -- Main @@ -71,15 +84,18 @@ main :: IO () main = do GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8 - Options {..} <- O.execParser parserInfo + Options {..} <- Options.execParser parserInfo when version $ do putStrLn (showVersion Meta.version) System.Exit.exitSuccess handle $ do - stdin <- BSL8.getContents - value :: A.Value <- case A.eitherDecode stdin of + bytes <- case file of + Nothing -> BSL8.getContents + Just path -> BSL8.readFile path + + value :: A.Value <- case A.eitherDecode bytes of Left err -> throwIO (userError err) Right v -> pure v diff --git a/dhall-json/src/Dhall/Yaml.hs b/dhall-json/src/Dhall/Yaml.hs index 63fa6d346..50abf6d23 100644 --- a/dhall-json/src/Dhall/Yaml.hs +++ b/dhall-json/src/Dhall/Yaml.hs @@ -37,6 +37,7 @@ data Options = Options , documents :: Bool , quoted :: Bool , conversion :: Conversion + , file :: Maybe FilePath } defaultOptions :: Options @@ -46,6 +47,7 @@ defaultOptions = , documents = False , quoted = False , conversion = NoConversion + , file = Nothing } parseDocuments :: Parser Bool diff --git a/dhall-json/yaml-to-dhall/Main.hs b/dhall-json/yaml-to-dhall/Main.hs index 1355fb43f..8f06d269a 100644 --- a/dhall-json/yaml-to-dhall/Main.hs +++ b/dhall-json/yaml-to-dhall/Main.hs @@ -8,6 +8,7 @@ module Main where +import Control.Applicative (optional) import qualified Control.Exception import Control.Exception (SomeException) import Control.Monad (when) @@ -17,7 +18,7 @@ import Data.Text (Text) import qualified Data.Text.IO as Text import Data.Version (showVersion) import qualified GHC.IO.Encoding -import qualified Options.Applicative as O +import qualified Options.Applicative as Options import Options.Applicative (Parser, ParserInfo) import qualified System.Exit import qualified System.IO @@ -35,14 +36,15 @@ data CommandOptions = CommandOptions { version :: Bool , schema :: Text , conversion :: Conversion + , file :: Maybe FilePath } deriving Show -- | Command info and description parserInfo :: ParserInfo CommandOptions -parserInfo = O.info - ( O.helper <*> parseOptions) - ( O.fullDesc - <> O.progDesc "Populate Dhall value given its Dhall type (schema) from a YAML expression" +parserInfo = Options.info + ( Options.helper <*> parseOptions) + ( Options.fullDesc + <> Options.progDesc "Populate Dhall value given its Dhall type (schema) from a YAML expression" ) @@ -52,16 +54,27 @@ parseOptions :: Parser CommandOptions parseOptions = CommandOptions <$> parseVersion <*> parseSchema <*> parseConversion + <*> optional parseFile where - parseSchema = O.strArgument - ( O.metavar "SCHEMA" - <> O.help "Dhall type expression (schema)" - ) - parseVersion = O.switch - ( O.long "version" - <> O.short 'V' - <> O.help "Display version" - ) + parseSchema = + Options.strArgument + ( Options.metavar "SCHEMA" + <> Options.help "Dhall type expression (schema)" + ) + + parseVersion = + Options.switch + ( Options.long "version" + <> Options.short 'V' + <> Options.help "Display version" + ) + + parseFile = + Options.strOption + ( Options.long "file" + <> Options.help "Read expression from a file instead of standard input" + <> Options.metavar "FILE" + ) -- ---------- -- Main @@ -71,16 +84,18 @@ main :: IO () main = do GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8 - CommandOptions{..} <- O.execParser parserInfo + CommandOptions{..} <- Options.execParser parserInfo when version $ do putStrLn (showVersion Meta.version) System.Exit.exitSuccess handle $ do - stdin <- BSL8.getContents + bytes <- case file of + Nothing -> BSL8.getContents + Just path -> BSL8.readFile path - Text.putStr =<< dhallFromYaml (Options schema conversion) stdin + Text.putStr =<< dhallFromYaml (Options schema conversion) bytes handle :: IO a -> IO a From 80b91455d82738d47077a4862255450b3ee2ae59 Mon Sep 17 00:00:00 2001 From: Gabriel Gonzalez Date: Sat, 13 Jul 2019 18:17:07 -0700 Subject: [PATCH 2/4] s/JSON/expression/ ... as caught by @sjakobi Co-Authored-By: Simon Jakobi --- dhall-json/json-to-dhall/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dhall-json/json-to-dhall/Main.hs b/dhall-json/json-to-dhall/Main.hs index 97b5eb217..3c7b60e4f 100644 --- a/dhall-json/json-to-dhall/Main.hs +++ b/dhall-json/json-to-dhall/Main.hs @@ -72,7 +72,7 @@ parseOptions = Options <$> parseVersion parseFile = Options.strOption ( Options.long "file" - <> Options.help "Read expression from a file instead of standard input" + <> Options.help "Read JSON from a file instead of standard input" <> Options.metavar "FILE" ) From 6b3cc641b74db93a7cbaef284564af08915f0902 Mon Sep 17 00:00:00 2001 From: Gabriel Gonzalez Date: Sat, 13 Jul 2019 18:17:38 -0700 Subject: [PATCH 3/4] s/expression/YAML expression/ ... as caught by @sjakobi Co-Authored-By: Simon Jakobi --- dhall-json/yaml-to-dhall/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dhall-json/yaml-to-dhall/Main.hs b/dhall-json/yaml-to-dhall/Main.hs index 8f06d269a..46db2cffc 100644 --- a/dhall-json/yaml-to-dhall/Main.hs +++ b/dhall-json/yaml-to-dhall/Main.hs @@ -72,7 +72,7 @@ parseOptions = CommandOptions <$> parseVersion parseFile = Options.strOption ( Options.long "file" - <> Options.help "Read expression from a file instead of standard input" + <> Options.help "Read YAML expression from a file instead of standard input" <> Options.metavar "FILE" ) From 46e3f8455dae75476c97887475ffe0bd600d495f Mon Sep 17 00:00:00 2001 From: Gabriel Gonzalez Date: Sat, 13 Jul 2019 18:20:58 -0700 Subject: [PATCH 4/4] Change the program descriptions for `{json,yaml}-to-dhall` ... as suggested by @sjakobi --- dhall-json/json-to-dhall/Main.hs | 2 +- dhall-json/yaml-to-dhall/Main.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/dhall-json/json-to-dhall/Main.hs b/dhall-json/json-to-dhall/Main.hs index 3c7b60e4f..8d40bd952 100644 --- a/dhall-json/json-to-dhall/Main.hs +++ b/dhall-json/json-to-dhall/Main.hs @@ -38,7 +38,7 @@ parserInfo :: ParserInfo Options parserInfo = Options.info ( Options.helper <*> parseOptions) ( Options.fullDesc - <> Options.progDesc "Populate Dhall value given its Dhall type (schema) from a JSON expression" + <> Options.progDesc "Convert a JSON expression to a Dhall expression, given the expected Dhall type" ) -- | All the command arguments and options diff --git a/dhall-json/yaml-to-dhall/Main.hs b/dhall-json/yaml-to-dhall/Main.hs index 46db2cffc..0d738a14b 100644 --- a/dhall-json/yaml-to-dhall/Main.hs +++ b/dhall-json/yaml-to-dhall/Main.hs @@ -44,7 +44,7 @@ parserInfo :: ParserInfo CommandOptions parserInfo = Options.info ( Options.helper <*> parseOptions) ( Options.fullDesc - <> Options.progDesc "Populate Dhall value given its Dhall type (schema) from a YAML expression" + <> Options.progDesc "Convert a YAML expression to a Dhall expression, given the expected Dhall type" )