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)

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

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

@ -8,26 +8,29 @@
module Main where 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 qualified Control.Exception
import Control.Exception (SomeException, throwIO) import qualified Data.Aeson as Aeson
import Control.Monad (when) import qualified Data.ByteString.Lazy.Char8 as ByteString
import qualified Data.Aeson as A import qualified Data.Text.IO as Text.IO
import qualified Data.ByteString.Lazy.Char8 as BSL8 import qualified Data.Text.Prettyprint.Doc as Pretty
import Data.Monoid ((<>)) import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty.Terminal
import Data.Text (Text)
import qualified Data.Text.IO as Text
import Data.Version (showVersion)
import qualified GHC.IO.Encoding import qualified GHC.IO.Encoding
import qualified Options.Applicative as Options import qualified Options.Applicative as Options
import Options.Applicative (Parser, ParserInfo) import qualified System.Console.ANSI as ANSI
import qualified System.Exit import qualified System.Exit
import qualified System.IO import qualified System.IO as IO
import qualified Dhall.Pretty
import qualified Dhall.Core as D import qualified Paths_dhall_json as Meta
import Dhall.JSONToDhall
import qualified Paths_dhall_json as Meta
-- --------------- -- ---------------
-- Command options -- Command options
@ -47,6 +50,8 @@ data Options = Options
, schema :: Text , schema :: Text
, conversion :: Conversion , conversion :: Conversion
, file :: Maybe FilePath , file :: Maybe FilePath
, ascii :: Bool
, plain :: Bool
} deriving Show } deriving Show
-- | Parser for all the command arguments and options -- | Parser for all the command arguments and options
@ -55,6 +60,8 @@ parseOptions = Options <$> parseVersion
<*> parseSchema <*> parseSchema
<*> parseConversion <*> parseConversion
<*> optional parseFile <*> optional parseFile
<*> parseASCII
<*> parsePlain
where where
parseSchema = parseSchema =
Options.strArgument Options.strArgument
@ -76,6 +83,18 @@ parseOptions = Options <$> parseVersion
<> Options.metavar "FILE" <> 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 -- Main
-- ---------- -- ----------
@ -86,30 +105,49 @@ main = do
Options {..} <- Options.execParser parserInfo Options {..} <- Options.execParser parserInfo
let characterSet = case ascii of
True -> ASCII
False -> Unicode
when version $ do when version $ do
putStrLn (showVersion Meta.version) putStrLn (showVersion Meta.version)
System.Exit.exitSuccess System.Exit.exitSuccess
handle $ do handle $ do
bytes <- case file of bytes <- case file of
Nothing -> BSL8.getContents Nothing -> ByteString.getContents
Just path -> BSL8.readFile path 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) Left err -> throwIO (userError err)
Right v -> pure v Right v -> pure v
expr <- typeCheckSchemaExpr id =<< resolveSchemaExpr schema expr <- typeCheckSchemaExpr id =<< resolveSchemaExpr schema
case dhallFromJSON conversion expr value of result <- case dhallFromJSON conversion expr value of
Left err -> throwIO err Left err -> throwIO err
Right res -> Text.putStr (D.pretty res) 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 :: IO a -> IO a
handle = Control.Exception.handle handler handle = Control.Exception.handle handler
where where
handler :: SomeException -> IO a handler :: SomeException -> IO a
handler e = do handler e = do
System.IO.hPutStrLn System.IO.stderr "" IO.hPutStrLn IO.stderr ""
System.IO.hPrint System.IO.stderr e IO.hPrint IO.stderr e
System.Exit.exitFailure 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 Control.Exception (Exception, throwIO)
import Data.Text (Text) import Data.Text (Text)
import Dhall.Core (Expr)
import qualified Dhall.Core as Dhall import Dhall.Src (Src)
import Dhall.TypeCheck(X)
#if defined(ETA_VERSION) #if defined(ETA_VERSION)
import Dhall.Yaml.Eta ( yamlToJson, showYaml ) import Dhall.Yaml.Eta ( yamlToJson, showYaml )
@ -54,7 +55,7 @@ instance Exception YAMLCompileError
-- | Transform yaml representation into dhall -- | Transform yaml representation into dhall
dhallFromYaml :: Options -> ByteString -> IO Text dhallFromYaml :: Options -> ByteString -> IO (Expr Src X)
dhallFromYaml Options{..} yaml = do dhallFromYaml Options{..} yaml = do
value <- either (throwIO . userError) pure (yamlToJson yaml) value <- either (throwIO . userError) pure (yamlToJson yaml)
@ -63,7 +64,7 @@ dhallFromYaml Options{..} yaml = do
let dhall = dhallFromJSON conversion expr value let dhall = dhallFromJSON conversion expr value
either (throwIO . YAMLCompileError) (pure . Dhall.pretty) dhall either (throwIO . YAMLCompileError) pure dhall
#if !defined(ETA_VERSION) #if !defined(ETA_VERSION)

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

@ -8,25 +8,29 @@
module Main where 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 qualified Control.Exception
import Control.Exception (SomeException) import qualified Data.ByteString.Char8 as BSL8
import Control.Monad (when) import qualified Data.Text.IO as Text.IO
import qualified Data.ByteString.Char8 as BSL8 import qualified Data.Text.Prettyprint.Doc as Pretty
import Data.Monoid ((<>)) import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty.Terminal
import Data.Text (Text) import qualified Dhall.Pretty
import qualified Data.Text.IO as Text
import Data.Version (showVersion)
import qualified GHC.IO.Encoding import qualified GHC.IO.Encoding
import qualified Options.Applicative as Options import qualified Options.Applicative as Options
import Options.Applicative (Parser, ParserInfo) import qualified System.Console.ANSI as ANSI
import qualified System.Exit import qualified System.Exit
import qualified System.IO import qualified System.IO as IO
import qualified Paths_dhall_json as Meta
import Dhall.JSONToDhall (Conversion, parseConversion)
import Dhall.YamlToDhall (Options(..), dhallFromYaml)
import qualified Paths_dhall_json as Meta
-- --------------- -- ---------------
-- Command options -- Command options
@ -37,6 +41,8 @@ data CommandOptions = CommandOptions
, schema :: Text , schema :: Text
, conversion :: Conversion , conversion :: Conversion
, file :: Maybe FilePath , file :: Maybe FilePath
, ascii :: Bool
, plain :: Bool
} deriving Show } deriving Show
-- | Command info and description -- | Command info and description
@ -55,6 +61,8 @@ parseOptions = CommandOptions <$> parseVersion
<*> parseSchema <*> parseSchema
<*> parseConversion <*> parseConversion
<*> optional parseFile <*> optional parseFile
<*> parseASCII
<*> parsePlain
where where
parseSchema = parseSchema =
Options.strArgument Options.strArgument
@ -76,6 +84,18 @@ parseOptions = CommandOptions <$> parseVersion
<> Options.metavar "FILE" <> 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 -- Main
-- ---------- -- ----------
@ -86,6 +106,10 @@ main = do
CommandOptions{..} <- Options.execParser parserInfo CommandOptions{..} <- Options.execParser parserInfo
let characterSet = case ascii of
True -> ASCII
False -> Unicode
when version $ do when version $ do
putStrLn (showVersion Meta.version) putStrLn (showVersion Meta.version)
System.Exit.exitSuccess System.Exit.exitSuccess
@ -95,7 +119,22 @@ main = do
Nothing -> BSL8.getContents Nothing -> BSL8.getContents
Just path -> BSL8.readFile path 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 handle :: IO a -> IO a
@ -103,6 +142,6 @@ handle = Control.Exception.handle handler
where where
handler :: SomeException -> IO a handler :: SomeException -> IO a
handler e = do handler e = do
System.IO.hPutStrLn System.IO.stderr "" IO.hPutStrLn IO.stderr ""
System.IO.hPrint System.IO.stderr e IO.hPrint IO.stderr e
System.Exit.exitFailure System.Exit.exitFailure