{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

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

module Dhall.Format
    ( -- * Format
      Format(..)
    , format
    ) where

import Data.Foldable (for_)
import Data.Maybe    (fromMaybe)
import Dhall.Pretty  (CharacterSet, annToAnsiStyle, detectCharacterSet)
import Dhall.Util
    ( Censor
    , CheckFailed (..)
    , Header (..)
    , OutputMode (..)
    , PossiblyTransitiveInput (..)
    , Transitivity (..)
    )

import qualified Control.Exception
import qualified Data.Text.IO
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 Dhall.Import
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.FilePath
import qualified System.IO

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

-- | Implementation of the @dhall format@ subcommand
format :: Format -> IO ()
format :: Format -> IO ()
format (Format { input :: Format -> PossiblyTransitiveInput
input = PossiblyTransitiveInput
input0, Maybe CharacterSet
OutputMode
Censor
outputMode :: OutputMode
censor :: Censor
chosenCharacterSet :: Maybe CharacterSet
outputMode :: Format -> OutputMode
censor :: Format -> Censor
chosenCharacterSet :: Format -> Maybe CharacterSet
..}) = PossiblyTransitiveInput -> IO ()
go PossiblyTransitiveInput
input0
  where
    go :: PossiblyTransitiveInput -> IO ()
go PossiblyTransitiveInput
input = do
        let directory :: FilePath
directory = case PossiblyTransitiveInput
input of
                PossiblyTransitiveInput
NonTransitiveStandardInput ->
                    FilePath
"."
                PossiblyTransitiveInputFile file _ ->
                    FilePath -> FilePath
System.FilePath.takeDirectory FilePath
file

        let status :: Status
status = FilePath -> Status
Dhall.Import.emptyStatus FilePath
directory

        let layoutHeaderAndExpr :: (Header, Expr Src a) -> SimpleDocStream Ann
layoutHeaderAndExpr (Header Text
header, Expr Src a
expr) =
                let characterSet :: CharacterSet
characterSet = CharacterSet -> Maybe CharacterSet -> CharacterSet
forall a. a -> Maybe a -> a
fromMaybe (Expr Src a -> CharacterSet
forall a. Expr Src a -> CharacterSet
detectCharacterSet Expr Src a
expr) Maybe CharacterSet
chosenCharacterSet
                in
                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, Transitivity
transitivity) <- case PossiblyTransitiveInput
input of
            PossiblyTransitiveInputFile FilePath
file Transitivity
transitivity -> do
                Text
text <- FilePath -> IO Text
Data.Text.IO.readFile FilePath
file

                (Text, Transitivity) -> IO (Text, Transitivity)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
text, Transitivity
transitivity)

            PossiblyTransitiveInput
NonTransitiveStandardInput -> do
                Text
text <- IO Text
Data.Text.IO.getContents

                (Text, Transitivity) -> IO (Text, Transitivity)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
text, Transitivity
NonTransitive)

        headerAndExpr :: (Header, Expr Src Import)
headerAndExpr@(Header
_, Expr Src Import
parsedExpression) <- Censor -> Text -> IO (Header, Expr Src Import)
Dhall.Util.getExpressionAndHeaderFromStdinText Censor
censor Text
originalText

        case Transitivity
transitivity of
            Transitivity
Transitive ->
                Expr Src Import -> (Import -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Expr Src Import
parsedExpression ((Import -> IO ()) -> IO ()) -> (Import -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Import
import_ -> do
                    Maybe FilePath
maybeFilepath <- Status -> Import -> IO (Maybe FilePath)
Dhall.Import.dependencyToFile Status
status Import
import_

                    Maybe FilePath -> (FilePath -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe FilePath
maybeFilepath ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
filepath ->
                        PossiblyTransitiveInput -> IO ()
go (FilePath -> Transitivity -> PossiblyTransitiveInput
PossiblyTransitiveInputFile FilePath
filepath Transitivity
Transitive)

            Transitivity
NonTransitive ->
                () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        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 ->
                case PossiblyTransitiveInput
input of
                    PossiblyTransitiveInputFile FilePath
file Transitivity
_ ->
                        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)

                    PossiblyTransitiveInput
NonTransitiveStandardInput -> 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 ->
                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
..}