{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

-- | This module contains the implementation of the @dhall format@ subcommand

module Dhall.Format
    ( -- * 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

-- | Arguments to the `format` subcommand
data Format = Format
    { Format -> CharacterSet
characterSet :: CharacterSet
    , Format -> Censor
censor       :: Censor
    , Format -> Input
input        :: Input
    , Format -> OutputMode
outputMode   :: OutputMode
    }

-- | Implementation of the @dhall format@ subcommand
format :: Format -> IO ()
format :: Format -> IO ()
format (Format {..}) = do
    let layoutHeaderAndExpr :: (Header, Expr Src a) -> SimpleDocStream Ann
layoutHeaderAndExpr (Header header :: Text
header, expr :: 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
<>  "\n")

    let layoutInput :: IO (SimpleDocStream Ann)
layoutInput = do
            (Header, Expr Src Import)
headerAndExpr <- Censor -> Input -> IO (Header, Expr Src Import)
Dhall.Util.getExpressionAndHeader Censor
censor Input
input

            SimpleDocStream Ann -> IO (SimpleDocStream Ann)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Header, Expr Src Import) -> SimpleDocStream Ann
forall a. Pretty a => (Header, Expr Src a) -> SimpleDocStream Ann
layoutHeaderAndExpr (Header, Expr Src Import)
headerAndExpr)

    case OutputMode
outputMode of
        Write -> do
            SimpleDocStream Ann
docStream <- IO (SimpleDocStream Ann)
layoutInput

            case Input
input of
                InputFile file :: FilePath
file -> do
                    FilePath -> Text -> IO ()
AtomicWrite.LazyText.atomicWriteFile
                        FilePath
file
                        (SimpleDocStream Ann -> Text
forall ann. SimpleDocStream ann -> Text
Pretty.Text.renderLazy SimpleDocStream Ann
docStream)

                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))

        Check -> do
            Text
originalText <- case Input
input of
                InputFile file :: FilePath
file -> FilePath -> IO Text
Data.Text.IO.readFile FilePath
file
                StandardInput  -> IO Text
Data.Text.IO.getContents

            SimpleDocStream Ann
docStream <- case Input
input of
                InputFile _    -> IO (SimpleDocStream Ann)
layoutInput
                StandardInput  -> do
                    (Header, Expr Src Import)
headerAndExpr <- Censor -> Text -> IO (Header, Expr Src Import)
Dhall.Util.getExpressionAndHeaderFromStdinText Censor
censor Text
originalText
                    SimpleDocStream Ann -> IO (SimpleDocStream Ann)
forall (m :: * -> *) a. Monad m => a -> m a
return ((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

            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 = "format"

                    let modified :: Text
modified = "formatted"

                    CheckFailed -> IO ()
forall e a. Exception e => e -> IO a
Control.Exception.throwIO CheckFailed :: Text -> Text -> CheckFailed
CheckFailed{..}