ehmry/dhall-haskell
ehmry
/
dhall-haskell
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Pretty-print output of `{json,yaml}-to-dhall` (#1150) 

This enables syntax highlighting and formatted output for these two
programs
This commit is contained in:
Gabriel Gonzalez 2019-07-24 06:33:41 -07:00 committed by mergify[bot]
parent 4faf25bbbe
commit 354346be91
4 changed files with 148 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
dhall-json/dhall-json.cabal
View File

@ -115,14 +115,17 @@ Executable json-to-dhall
Hs-Source-Dirs: json-to-dhall
Main-Is: Main.hs
Build-Depends:
base ,
aeson ,
bytestring < 0.11 ,
dhall ,
dhall-json ,
exceptions >= 0.8.3 && < 0.11 ,
optparse-applicative ,
text < 1.3
base ,
aeson ,
ansi-terminal >= 0.6.3.1 && < 0.10,
bytestring < 0.11,
dhall ,
dhall-json ,
exceptions >= 0.8.3 && < 0.11,
optparse-applicative ,
prettyprinter >= 1.2.0.1 && < 1.3 ,
prettyprinter-ansi-terminal >= 1.1.1 && < 1.2 ,
text < 1.3
if !impl(ghc >= 8.0) && !impl(eta >= 0.8.4)
Build-Depends: semigroups == 0.18.*
Other-Modules:
@ -133,14 +136,17 @@ Executable yaml-to-dhall
Hs-Source-Dirs: yaml-to-dhall
Main-Is: Main.hs
Build-Depends:
base ,
aeson ,
bytestring < 0.11 ,
dhall ,
dhall-json ,
exceptions >= 0.8.3 && < 0.11 ,
optparse-applicative ,
text < 1.3
base ,
aeson ,
ansi-terminal >= 0.6.3.1 && < 0.10,
bytestring < 0.11 ,
dhall ,
dhall-json ,
exceptions >= 0.8.3 && < 0.11 ,
optparse-applicative ,
prettyprinter >= 1.2.0.1 && < 1.3 ,
prettyprinter-ansi-terminal >= 1.1.1 && < 1.2 ,
text < 1.3
if !impl(ghc >= 8.0) && !impl(eta >= 0.8.4)
Build-Depends: semigroups == 0.18.*
Other-Modules:

88
dhall-json/json-to-dhall/Main.hs
View File

@ -8,26 +8,29 @@
module Main where
import Control.Applicative (optional)
import Control.Applicative (optional)
import Control.Exception (SomeException, throwIO)
import Control.Monad (when)
import Data.Monoid ((<>))
import Data.Text (Text)
import Data.Version (showVersion)
import Dhall.JSONToDhall
import Dhall.Pretty (CharacterSet(..))
import Options.Applicative (Parser, ParserInfo)
import qualified Control.Exception
import Control.Exception (SomeException, throwIO)
import Control.Monad (when)
import qualified Data.Aeson as A
import qualified Data.ByteString.Lazy.Char8 as BSL8
import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text.IO as Text
import Data.Version (showVersion)
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Lazy.Char8 as ByteString
import qualified Data.Text.IO as Text.IO
import qualified Data.Text.Prettyprint.Doc as Pretty
import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty.Terminal
import qualified GHC.IO.Encoding
import qualified Options.Applicative as Options
import Options.Applicative (Parser, ParserInfo)
import qualified Options.Applicative as Options
import qualified System.Console.ANSI as ANSI
import qualified System.Exit
import qualified System.IO
import qualified Dhall.Core as D
import Dhall.JSONToDhall
import qualified Paths_dhall_json as Meta
import qualified System.IO as IO
import qualified Dhall.Pretty
import qualified Paths_dhall_json as Meta
-- ---------------
-- Command options
@ -47,6 +50,8 @@ data Options = Options
, schema :: Text
, conversion :: Conversion
, file :: Maybe FilePath
, ascii :: Bool
, plain :: Bool
} deriving Show
-- | Parser for all the command arguments and options
@ -55,6 +60,8 @@ parseOptions = Options <$> parseVersion
<*> parseSchema
<*> parseConversion
<*> optional parseFile
<*> parseASCII
<*> parsePlain
where
parseSchema =
Options.strArgument
@ -76,6 +83,18 @@ parseOptions = Options <$> parseVersion
<> Options.metavar "FILE"
)
parseASCII =
Options.switch
( Options.long "ascii"
<> Options.help "Format code using only ASCII syntax"
)
parsePlain =
Options.switch
( Options.long "plain"
<> Options.help "Disable syntax highlighting"
)
-- ----------
-- Main
-- ----------
@ -86,30 +105,49 @@ main = do
Options {..} <- Options.execParser parserInfo
let characterSet = case ascii of
True -> ASCII
False -> Unicode
when version $ do
putStrLn (showVersion Meta.version)
System.Exit.exitSuccess
handle $ do
bytes <- case file of
Nothing -> BSL8.getContents
Just path -> BSL8.readFile path
Nothing -> ByteString.getContents
Just path -> ByteString.readFile path
value :: A.Value <- case A.eitherDecode bytes of
value :: Aeson.Value <- case Aeson.eitherDecode bytes of
Left err -> throwIO (userError err)
Right v -> pure v
expr <- typeCheckSchemaExpr id =<< resolveSchemaExpr schema
case dhallFromJSON conversion expr value of
Left err -> throwIO err
Right res -> Text.putStr (D.pretty res)
result <- case dhallFromJSON conversion expr value of
Left err -> throwIO err
Right result -> return result
let document = Dhall.Pretty.prettyCharacterSet characterSet result
let stream = Pretty.layoutSmart Dhall.Pretty.layoutOpts document
supportsANSI <- ANSI.hSupportsANSI IO.stdout
let ansiStream =
if supportsANSI && not plain
then fmap Dhall.Pretty.annToAnsiStyle stream
else Pretty.unAnnotateS stream
Pretty.Terminal.renderIO IO.stdout ansiStream
Text.IO.putStrLn ""
handle :: IO a -> IO a
handle = Control.Exception.handle handler
where
handler :: SomeException -> IO a
handler e = do
System.IO.hPutStrLn System.IO.stderr ""
System.IO.hPrint System.IO.stderr e
IO.hPutStrLn IO.stderr ""
IO.hPrint IO.stderr e
System.Exit.exitFailure

9
dhall-json/src/Dhall/YamlToDhall.hs
View File

@ -22,8 +22,9 @@ import Dhall.JSONToDhall
import Control.Exception (Exception, throwIO)
import Data.Text (Text)
import qualified Dhall.Core as Dhall
import Dhall.Core (Expr)
import Dhall.Src (Src)
import Dhall.TypeCheck(X)
#if defined(ETA_VERSION)
import Dhall.Yaml.Eta ( yamlToJson, showYaml )
@ -54,7 +55,7 @@ instance Exception YAMLCompileError
-- | Transform yaml representation into dhall
dhallFromYaml :: Options -> ByteString -> IO Text
dhallFromYaml :: Options -> ByteString -> IO (Expr Src X)
dhallFromYaml Options{..} yaml = do
value <- either (throwIO . userError) pure (yamlToJson yaml)
@ -63,7 +64,7 @@ dhallFromYaml Options{..} yaml = do
let dhall = dhallFromJSON conversion expr value
either (throwIO . YAMLCompileError) (pure . Dhall.pretty) dhall
either (throwIO . YAMLCompileError) pure dhall
#if !defined(ETA_VERSION)

77
dhall-json/yaml-to-dhall/Main.hs
View File

@ -8,25 +8,29 @@
module Main where
import Control.Applicative (optional)
import Control.Applicative (optional)
import Control.Exception (SomeException)
import Control.Monad (when)
import Data.Monoid ((<>))
import Data.Text (Text)
import Data.Version (showVersion)
import Dhall.JSONToDhall (Conversion, parseConversion)
import Dhall.Pretty (CharacterSet(..))
import Dhall.YamlToDhall (Options(..), dhallFromYaml)
import Options.Applicative (Parser, ParserInfo)
import qualified Control.Exception
import Control.Exception (SomeException)
import Control.Monad (when)
import qualified Data.ByteString.Char8 as BSL8
import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text.IO as Text
import Data.Version (showVersion)
import qualified Data.ByteString.Char8 as BSL8
import qualified Data.Text.IO as Text.IO
import qualified Data.Text.Prettyprint.Doc as Pretty
import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty.Terminal
import qualified Dhall.Pretty
import qualified GHC.IO.Encoding
import qualified Options.Applicative as Options
import Options.Applicative (Parser, ParserInfo)
import qualified Options.Applicative as Options
import qualified System.Console.ANSI as ANSI
import qualified System.Exit
import qualified System.IO
import Dhall.JSONToDhall (Conversion, parseConversion)
import Dhall.YamlToDhall (Options(..), dhallFromYaml)
import qualified Paths_dhall_json as Meta
import qualified System.IO as IO
import qualified Paths_dhall_json as Meta
-- ---------------
-- Command options
@ -37,6 +41,8 @@ data CommandOptions = CommandOptions
, schema :: Text
, conversion :: Conversion
, file :: Maybe FilePath
, ascii :: Bool
, plain :: Bool
} deriving Show
-- | Command info and description
@ -55,6 +61,8 @@ parseOptions = CommandOptions <$> parseVersion
<*> parseSchema
<*> parseConversion
<*> optional parseFile
<*> parseASCII
<*> parsePlain
where
parseSchema =
Options.strArgument
@ -76,6 +84,18 @@ parseOptions = CommandOptions <$> parseVersion
<> Options.metavar "FILE"
)
parseASCII =
Options.switch
( Options.long "ascii"
<> Options.help "Format code using only ASCII syntax"
)
parsePlain =
Options.switch
( Options.long "plain"
<> Options.help "Disable syntax highlighting"
)
-- ----------
-- Main
-- ----------
@ -86,6 +106,10 @@ main = do
CommandOptions{..} <- Options.execParser parserInfo
let characterSet = case ascii of
True -> ASCII
False -> Unicode
when version $ do
putStrLn (showVersion Meta.version)
System.Exit.exitSuccess
@ -95,7 +119,22 @@ main = do
Nothing -> BSL8.getContents
Just path -> BSL8.readFile path
Text.putStr =<< dhallFromYaml (Options schema conversion) bytes
result <- dhallFromYaml (Options schema conversion) bytes
let document = Dhall.Pretty.prettyCharacterSet characterSet result
let stream = Pretty.layoutSmart Dhall.Pretty.layoutOpts document
supportsANSI <- ANSI.hSupportsANSI IO.stdout
let ansiStream =
if supportsANSI && not plain
then fmap Dhall.Pretty.annToAnsiStyle stream
else Pretty.unAnnotateS stream
Pretty.Terminal.renderIO IO.stdout ansiStream
Text.IO.putStrLn ""
handle :: IO a -> IO a
@ -103,6 +142,6 @@ handle = Control.Exception.handle handler
where
handler :: SomeException -> IO a
handler e = do
System.IO.hPutStrLn System.IO.stderr ""
System.IO.hPrint System.IO.stderr e
IO.hPutStrLn IO.stderr ""
IO.hPrint IO.stderr e
System.Exit.exitFailure