Skip to content

Commit

Permalink
Pretty-print output of {json,yaml}-to-dhall (#1150)
Browse files Browse the repository at this point in the history 
This enables syntax highlighting and formatted output for these two
programs
  • Loading branch information
@Gabriella439 @mergify
Gabriella439 authored and mergify[bot] committed Jul 24, 2019
1 parent 4faf25b commit 354346b
Show file tree
Hide file tree
Showing 4 changed files with 148 additions and 64 deletions.
38 changes: 22 additions & 16 deletions dhall-json/dhall-json.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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:
Expand All @@ -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:
Expand Down
88 changes: 63 additions & 25 deletions dhall-json/json-to-dhall/Main.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -55,6 +60,8 @@ parseOptions = Options <$> parseVersion
<*> parseSchema
<*> parseConversion
<*> optional parseFile
<*> parseASCII
<*> parsePlain
where
parseSchema =
Options.strArgument
Expand All @@ -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
-- ----------
Expand All @@ -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 changes: 5 additions & 4 deletions dhall-json/src/Dhall/YamlToDhall.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 )
Expand Down Expand Up @@ -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)
Expand All @@ -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)
Expand Down
77 changes: 58 additions & 19 deletions dhall-json/yaml-to-dhall/Main.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -37,6 +41,8 @@ data CommandOptions = CommandOptions
, schema :: Text
, conversion :: Conversion
, file :: Maybe FilePath
, ascii :: Bool
, plain :: Bool
} deriving Show

-- | Command info and description
Expand All @@ -55,6 +61,8 @@ parseOptions = CommandOptions <$> parseVersion
<*> parseSchema
<*> parseConversion
<*> optional parseFile
<*> parseASCII
<*> parsePlain
where
parseSchema =
Options.strArgument
Expand All @@ -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
-- ----------
Expand All @@ -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
Expand All @@ -95,14 +119,29 @@ 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
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

0 comments on commit 354346b

Please sign in to comment.