Add --check
flag to dhall format
(#810)
Fixes #809 This allows the user to check if the input is formatted instead of formatting the input
This commit is contained in:
parent
2f26dac1ff
commit
2cdaf91636
|
@ -1,63 +1,113 @@
|
|||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
-- | This module contains the implementation of the @dhall format@ subcommand
|
||||
|
||||
module Dhall.Format
|
||||
( -- * Format
|
||||
format
|
||||
Format(..)
|
||||
, FormatMode(..)
|
||||
, format
|
||||
) where
|
||||
|
||||
import Control.Exception (Exception)
|
||||
import Control.Monad.IO.Class (MonadIO(..))
|
||||
import Dhall.Parser (exprAndHeaderFromText)
|
||||
import Dhall.Pretty (CharacterSet(..), annToAnsiStyle, layoutOpts)
|
||||
|
||||
import Data.Monoid ((<>))
|
||||
|
||||
import qualified Data.Text.Prettyprint.Doc as Pretty
|
||||
import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty
|
||||
import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty.Terminal
|
||||
import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty.Text
|
||||
import qualified Control.Exception
|
||||
import qualified Data.Text.IO
|
||||
import qualified Dhall.Pretty
|
||||
import qualified System.Console.ANSI
|
||||
import qualified System.IO
|
||||
|
||||
data NotFormatted = NotFormatted
|
||||
deriving (Exception)
|
||||
|
||||
instance Show NotFormatted where
|
||||
show _ = ""
|
||||
|
||||
-- | Arguments to the `format` subcommand
|
||||
data Format = Format
|
||||
{ characterSet :: CharacterSet
|
||||
, formatMode :: FormatMode
|
||||
}
|
||||
|
||||
{-| The `format` subcommand can either `Modify` its input or simply `Check`
|
||||
that the input is already formatted
|
||||
-}
|
||||
data FormatMode
|
||||
= Modify
|
||||
{ inplace :: Maybe FilePath
|
||||
-- ^ Modify file in-place if present, otherwise read from @stdin@ and
|
||||
-- write to @stdout@
|
||||
}
|
||||
| Check
|
||||
{ path :: Maybe FilePath
|
||||
-- ^ Read from the given file if present, otherwise read from @stdin@
|
||||
}
|
||||
|
||||
-- | Implementation of the @dhall format@ subcommand
|
||||
format
|
||||
:: CharacterSet
|
||||
-> Maybe FilePath
|
||||
-- ^ Modify file in-place if present, otherwise read from @stdin@ and write
|
||||
-- to @stdout@
|
||||
:: Format
|
||||
-> IO ()
|
||||
format characterSet inplace = do
|
||||
case inplace of
|
||||
Just file -> do
|
||||
text <- Data.Text.IO.readFile file
|
||||
(header, expr) <- case exprAndHeaderFromText "(stdin)" text of
|
||||
Left err -> Control.Exception.throwIO err
|
||||
Right x -> return x
|
||||
format (Format {..}) =
|
||||
case formatMode of
|
||||
Modify {..} ->
|
||||
case inplace of
|
||||
Just file -> do
|
||||
text <- Data.Text.IO.readFile file
|
||||
|
||||
let doc = Pretty.pretty header
|
||||
<> Pretty.unAnnotate (Dhall.Pretty.prettyCharacterSet characterSet expr)
|
||||
System.IO.withFile file System.IO.WriteMode (\handle -> do
|
||||
Pretty.renderIO handle (Pretty.layoutSmart layoutOpts doc)
|
||||
Data.Text.IO.hPutStrLn handle "" )
|
||||
Nothing -> do
|
||||
inText <- Data.Text.IO.getContents
|
||||
(header, expr) <- throws (exprAndHeaderFromText "(stdin)" text)
|
||||
|
||||
(header, expr) <- case exprAndHeaderFromText "(stdin)" inText of
|
||||
Left err -> Control.Exception.throwIO err
|
||||
Right x -> return x
|
||||
let doc = Pretty.pretty header
|
||||
<> Pretty.unAnnotate (Dhall.Pretty.prettyCharacterSet characterSet expr)
|
||||
System.IO.withFile file System.IO.WriteMode (\handle -> do
|
||||
Pretty.Terminal.renderIO handle (Pretty.layoutSmart layoutOpts doc)
|
||||
Data.Text.IO.hPutStrLn handle "" )
|
||||
Nothing -> do
|
||||
inText <- Data.Text.IO.getContents
|
||||
|
||||
let doc = Pretty.pretty header
|
||||
<> Dhall.Pretty.prettyCharacterSet characterSet expr
|
||||
(header, expr) <- throws (exprAndHeaderFromText "(stdin)" inText)
|
||||
|
||||
supportsANSI <- System.Console.ANSI.hSupportsANSI System.IO.stdout
|
||||
let doc = Pretty.pretty header
|
||||
<> Dhall.Pretty.prettyCharacterSet characterSet expr
|
||||
|
||||
if supportsANSI
|
||||
then
|
||||
Pretty.renderIO
|
||||
System.IO.stdout
|
||||
(fmap annToAnsiStyle (Pretty.layoutSmart layoutOpts doc))
|
||||
else
|
||||
Pretty.renderIO
|
||||
System.IO.stdout
|
||||
(Pretty.layoutSmart layoutOpts (Pretty.unAnnotate doc))
|
||||
supportsANSI <- System.Console.ANSI.hSupportsANSI System.IO.stdout
|
||||
|
||||
if supportsANSI
|
||||
then
|
||||
Pretty.Terminal.renderIO
|
||||
System.IO.stdout
|
||||
(fmap annToAnsiStyle (Pretty.layoutSmart layoutOpts doc))
|
||||
else
|
||||
Pretty.Terminal.renderIO
|
||||
System.IO.stdout
|
||||
(Pretty.layoutSmart layoutOpts (Pretty.unAnnotate doc))
|
||||
Check {..} -> do
|
||||
originalText <- case path of
|
||||
Just file -> Data.Text.IO.readFile file
|
||||
Nothing -> Data.Text.IO.getContents
|
||||
|
||||
(header, expr) <- throws (exprAndHeaderFromText "(stdin)" originalText)
|
||||
|
||||
let doc = Pretty.pretty header
|
||||
<> Pretty.unAnnotate (Dhall.Pretty.prettyCharacterSet characterSet expr)
|
||||
<> "\n"
|
||||
|
||||
let formattedText =
|
||||
Pretty.Text.renderStrict (Pretty.layoutSmart layoutOpts doc)
|
||||
|
||||
if originalText == formattedText
|
||||
then return ()
|
||||
else Control.Exception.throwIO NotFormatted
|
||||
|
||||
throws :: (Exception e, MonadIO io) => Either e a -> io a
|
||||
throws (Left e) = liftIO (Control.Exception.throwIO e)
|
||||
throws (Right a) = return a
|
||||
|
|
|
@ -89,7 +89,7 @@ data Mode
|
|||
| Type
|
||||
| Normalize
|
||||
| Repl
|
||||
| Format { inplace :: Maybe FilePath }
|
||||
| Format { formatMode :: Dhall.Format.FormatMode }
|
||||
| Freeze { inplace :: Maybe FilePath, all_ :: Bool }
|
||||
| Hash
|
||||
| Diff { expr1 :: Text, expr2 :: Text }
|
||||
|
@ -169,7 +169,7 @@ parseMode =
|
|||
<|> subcommand
|
||||
"format"
|
||||
"Formatter for the Dhall language"
|
||||
(Format <$> optional parseInplace)
|
||||
(Format <$> parseFormatMode)
|
||||
<|> subcommand
|
||||
"freeze"
|
||||
"Add integrity checks to remote import statements of an expression"
|
||||
|
@ -232,6 +232,17 @@ parseMode =
|
|||
<> Options.Applicative.help "Add integrity checks to all imports (not just remote imports)"
|
||||
)
|
||||
|
||||
parseCheck =
|
||||
Options.Applicative.switch
|
||||
( Options.Applicative.long "check"
|
||||
<> Options.Applicative.help "Only check if the input is formatted"
|
||||
)
|
||||
|
||||
parseFormatMode = adapt <$> parseCheck <*> optional parseInplace
|
||||
where
|
||||
adapt True path = Dhall.Format.Check {..}
|
||||
adapt False inplace = Dhall.Format.Modify {..}
|
||||
|
||||
throws :: Exception e => Either e a -> IO a
|
||||
throws (Left e) = Control.Exception.throwIO e
|
||||
throws (Right a) = return a
|
||||
|
@ -288,8 +299,12 @@ command (Options {..}) = do
|
|||
Control.Exception.throwIO (Imported ps e)
|
||||
|
||||
handler2 e = do
|
||||
let _ = e :: SomeException
|
||||
System.IO.hPrint System.IO.stderr e
|
||||
let string = show (e :: SomeException)
|
||||
|
||||
if not (null string)
|
||||
then System.IO.hPutStrLn System.IO.stderr string
|
||||
else return ()
|
||||
|
||||
System.Exit.exitFailure
|
||||
|
||||
let renderDoc :: Handle -> Doc Ann -> IO ()
|
||||
|
@ -406,7 +421,7 @@ command (Options {..}) = do
|
|||
renderDoc System.IO.stdout diff
|
||||
|
||||
Format {..} -> do
|
||||
Dhall.Format.format characterSet inplace
|
||||
Dhall.Format.format (Dhall.Format.Format {..})
|
||||
|
||||
Freeze {..} -> do
|
||||
Dhall.Freeze.freeze inplace all_ standardVersion
|
||||
|
|
Loading…
Reference in New Issue
Block a user