{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Dhall.Format
(
Format(..)
, format
) where
import Data.Monoid ((<>))
import Dhall.Pretty (CharacterSet(..), annToAnsiStyle)
import Dhall.Util
( Censor
, CheckFailed(..)
, Header(..)
, Input(..)
, OutputMode(..)
)
import qualified Data.Text.Prettyprint.Doc 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 Dhall.Util
import qualified System.AtomicWrite.Writer.LazyText as AtomicWrite.LazyText
import qualified System.Console.ANSI
import qualified System.IO
data Format = Format
{ Format -> CharacterSet
characterSet :: CharacterSet
, Format -> Censor
censor :: Censor
, Format -> Input
input :: Input
, Format -> OutputMode
outputMode :: OutputMode
}
format :: Format -> IO ()
format :: Format -> IO ()
format (Format {CharacterSet
OutputMode
Input
Censor
outputMode :: OutputMode
input :: Input
censor :: Censor
characterSet :: CharacterSet
outputMode :: Format -> OutputMode
input :: Format -> Input
censor :: Format -> Censor
characterSet :: Format -> CharacterSet
..}) = do
let layoutHeaderAndExpr :: (Header, Expr Src a) -> SimpleDocStream Ann
layoutHeaderAndExpr (Header Text
header, Expr Src a
expr) =
Doc Ann -> SimpleDocStream Ann
forall ann. Doc ann -> SimpleDocStream ann
Dhall.Pretty.layout
( Text -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty Text
header
Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> CharacterSet -> Expr Src a -> Doc Ann
forall a. Pretty a => CharacterSet -> Expr Src a -> Doc Ann
Dhall.Pretty.prettyCharacterSet CharacterSet
characterSet Expr Src a
expr
Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n")
Text
originalText <- case Input
input of
InputFile FilePath
file -> FilePath -> IO Text
Data.Text.IO.readFile FilePath
file
Input
StandardInput -> IO Text
Data.Text.IO.getContents
(Header, Expr Src Import)
headerAndExpr <- Censor -> Text -> IO (Header, Expr Src Import)
Dhall.Util.getExpressionAndHeaderFromStdinText Censor
censor Text
originalText
let docStream :: SimpleDocStream Ann
docStream = (Header, Expr Src Import) -> SimpleDocStream Ann
forall a. Pretty a => (Header, Expr Src a) -> SimpleDocStream Ann
layoutHeaderAndExpr (Header, Expr Src Import)
headerAndExpr
let formattedText :: Text
formattedText = SimpleDocStream Ann -> Text
forall ann. SimpleDocStream ann -> Text
Pretty.Text.renderStrict SimpleDocStream Ann
docStream
case OutputMode
outputMode of
OutputMode
Write -> do
case Input
input of
InputFile FilePath
file -> do
if Text
originalText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
formattedText
then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else FilePath -> Text -> IO ()
AtomicWrite.LazyText.atomicWriteFile
FilePath
file
(SimpleDocStream Ann -> Text
forall ann. SimpleDocStream ann -> Text
Pretty.Text.renderLazy SimpleDocStream Ann
docStream)
Input
StandardInput -> do
Bool
supportsANSI <- Handle -> IO Bool
System.Console.ANSI.hSupportsANSI Handle
System.IO.stdout
Handle -> SimpleDocStream AnsiStyle -> IO ()
Pretty.Terminal.renderIO
Handle
System.IO.stdout
(if Bool
supportsANSI
then ((Ann -> AnsiStyle)
-> SimpleDocStream Ann -> SimpleDocStream AnsiStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ann -> AnsiStyle
annToAnsiStyle SimpleDocStream Ann
docStream)
else (SimpleDocStream Ann -> SimpleDocStream AnsiStyle
forall ann xxx. SimpleDocStream ann -> SimpleDocStream xxx
Pretty.unAnnotateS SimpleDocStream Ann
docStream))
OutputMode
Check -> do
if Text
originalText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
formattedText
then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
let command :: Text
command = Text
"format"
let modified :: Text
modified = Text
"formatted"
CheckFailed -> IO ()
forall e a. Exception e => e -> IO a
Control.Exception.throwIO CheckFailed :: Text -> Text -> CheckFailed
CheckFailed{Text
modified :: Text
command :: Text
modified :: Text
command :: Text
..}