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

Add --pretty option to dhall executable (#177)

Browse Source 
This option causes the executable to format the output, for ease of
reading
This commit is contained in:
Gabriel Gonzalez 2017-11-07 11:44:22 -08:00 committed by GitHub
parent a03e708498
commit c7dbb71ed4
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 34 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
dhall.cabal
View File

@ -131,6 +131,7 @@ Executable dhall
base >= 4 && < 5 ,
dhall ,
optparse-generic >= 1.1.1 && < 1.3,
prettyprinter ,
trifecta >= 1.6 && < 1.8,
text >= 0.11.1.0 && < 1.3
GHC-Options: -Wall

48
dhall/Main.hs
View File

@ -8,14 +8,13 @@ module Main where
import Control.Exception (SomeException)
import Control.Monad (when)
import Data.Monoid (mempty)
import Data.Monoid (mempty, (<>))
import Data.Version (showVersion)
import Dhall.Core (pretty, normalize)
import Dhall.Core (normalize)
import Dhall.Import (Imported(..), load)
import Dhall.Parser (Src, exprFromText)
import Dhall.Parser (Src, exprAndHeaderFromText)
import Dhall.TypeCheck (DetailedTypeError(..), TypeError)
import Options.Generic (Generic, ParseRecord, type (<?>)(..))
import System.IO (stderr)
import System.Exit (exitFailure, exitSuccess)
import Text.Trifecta.Delta (Delta(..))
@ -23,6 +22,9 @@ import qualified Paths_dhall as Meta
import qualified Control.Exception
import qualified Data.Text.Lazy.IO
import qualified Data.Text.Prettyprint.Doc as Pretty
import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty
import qualified Dhall.Core
import qualified Dhall.TypeCheck
import qualified Options.Generic
import qualified System.IO
@ -30,16 +32,23 @@ import qualified System.IO
data Options = Options
{ explain :: Bool <?> "Explain error messages in more detail"
, version :: Bool <?> "Display version and exit"
, pretty :: Bool <?> "Format output"
} deriving (Generic)
instance ParseRecord Options
opts :: Pretty.LayoutOptions
opts =
Pretty.defaultLayoutOptions
{ Pretty.layoutPageWidth = Pretty.AvailablePerLine 80 1.0 }
main :: IO ()
main = do
options <- Options.Generic.getRecord "Compiler for the Dhall language"
when (unHelpful (version options)) $ do
putStrLn (showVersion Meta.version)
exitSuccess
let handle =
Control.Exception.handle handler2
. Control.Exception.handle handler1
@ -47,39 +56,48 @@ main = do
where
handler0 e = do
let _ = e :: TypeError Src
System.IO.hPutStrLn stderr ""
System.IO.hPutStrLn System.IO.stderr ""
if unHelpful (explain options)
then Control.Exception.throwIO (DetailedTypeError e)
else do
Data.Text.Lazy.IO.hPutStrLn stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m"
Data.Text.Lazy.IO.hPutStrLn System.IO.stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m"
Control.Exception.throwIO e
handler1 (Imported ps e) = do
let _ = e :: TypeError Src
System.IO.hPutStrLn stderr ""
System.IO.hPutStrLn System.IO.stderr ""
if unHelpful (explain options)
then Control.Exception.throwIO (Imported ps (DetailedTypeError e))
else do
Data.Text.Lazy.IO.hPutStrLn stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m"
Data.Text.Lazy.IO.hPutStrLn System.IO.stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m"
Control.Exception.throwIO (Imported ps e)
handler2 e = do
let _ = e :: SomeException
System.IO.hPrint stderr e
System.IO.hPrint System.IO.stderr e
System.Exit.exitFailure
handle (do
inText <- Data.Text.Lazy.IO.getContents
expr <- case exprFromText (Directed "(stdin)" 0 0 0 0) inText of
Left err -> Control.Exception.throwIO err
Right expr -> return expr
(header, expr) <- case exprAndHeaderFromText (Directed "(stdin)" 0 0 0 0) inText of
Left err -> Control.Exception.throwIO err
Right x -> return x
let render h e =
if unHelpful (pretty options)
then do
let doc = Pretty.pretty header <> Pretty.pretty e
Pretty.renderIO h (Pretty.layoutSmart opts doc)
Data.Text.Lazy.IO.hPutStrLn h ""
else do
Data.Text.Lazy.IO.hPutStrLn h (Dhall.Core.pretty e)
expr' <- load expr
typeExpr <- case Dhall.TypeCheck.typeOf expr' of
Left err -> Control.Exception.throwIO err
Right typeExpr -> return typeExpr
Data.Text.Lazy.IO.hPutStrLn stderr (pretty (normalize typeExpr))
Data.Text.Lazy.IO.hPutStrLn stderr mempty
Data.Text.Lazy.IO.putStrLn (pretty (normalize expr')) )
render System.IO.stderr (normalize typeExpr)
Data.Text.Lazy.IO.hPutStrLn System.IO.stderr mempty
render System.IO.stdout (normalize expr') )