{-# 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.List.NonEmpty (NonEmpty)
import Data.Maybe         (fromMaybe)
import Dhall.Pretty       (CharacterSet, annToAnsiStyle, detectCharacterSet)
import Dhall.Util
    ( Censor
    , CheckFailed (..)
    , Header (..)
    , Input (..)
    , OutputMode (..)
    , Transitivity (..)
    , handleMultipleChecksFailed
    )

import qualified Data.Text.IO
import qualified Dhall.Import
import qualified Dhall.Pretty
import qualified Dhall.Util
import qualified Prettyprinter                      as Pretty
import qualified Prettyprinter.Render.Terminal      as Pretty.Terminal
import qualified Prettyprinter.Render.Text          as Pretty.Text
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 -> Transitivity
transitivity       :: Transitivity
    , Format -> NonEmpty Input
inputs             :: NonEmpty Input
    , Format -> OutputMode
outputMode         :: OutputMode
    }

-- | Implementation of the @dhall format@ subcommand
format :: Format -> IO ()
format :: Format -> IO ()
format (Format { inputs :: Format -> NonEmpty Input
inputs = NonEmpty Input
inputs0, transitivity :: Format -> Transitivity
transitivity = Transitivity
transitivity0, Maybe CharacterSet
OutputMode
Censor
chosenCharacterSet :: Format -> Maybe CharacterSet
censor :: Format -> Censor
outputMode :: Format -> OutputMode
chosenCharacterSet :: Maybe CharacterSet
censor :: Censor
outputMode :: OutputMode
..}) =
    Text
-> Text
-> (Input -> IO (Either CheckFailed ()))
-> NonEmpty Input
-> IO ()
forall (t :: * -> *) a.
(Foldable t, Traversable t) =>
Text -> Text -> (a -> IO (Either CheckFailed ())) -> t a -> IO ()
handleMultipleChecksFailed Text
"format" Text
"formatted" Input -> IO (Either CheckFailed ())
go NonEmpty Input
inputs0
  where
    go :: Input -> IO (Either CheckFailed ())
go Input
input = do
        let directory :: String
directory = case Input
input of
                Input
StandardInput ->
                    String
"."
                InputFile String
file ->
                    String -> String
System.FilePath.takeDirectory String
file

        let status :: Status
status = String -> Status
Dhall.Import.emptyStatus String
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 ann. 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")

        (inputName, originalText, transitivity) <- case Input
input of
            InputFile String
file -> do
                text <- String -> IO Text
Data.Text.IO.readFile String
file

                return (file, text, transitivity0)
            Input
StandardInput -> do
                text <- IO Text
Data.Text.IO.getContents

                return ("(input)", text, NonTransitive)


        headerAndExpr@(_, parsedExpression) <- Dhall.Util.getExpressionAndHeaderFromStdinText censor inputName originalText

        case 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
                    maybeFilepath <- Status -> Import -> IO (Maybe String)
Dhall.Import.dependencyToFile Status
status Import
import_

                    for_ maybeFilepath $ \String
filepath ->
                        Input -> IO (Either CheckFailed ())
go (String -> Input
InputFile String
filepath)

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

        let 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 = SimpleDocStream Ann -> Text
forall ann. SimpleDocStream ann -> Text
Pretty.Text.renderStrict SimpleDocStream Ann
docStream

        case outputMode of
            OutputMode
Write -> do
                case Input
input of
                    InputFile String
file ->
                        if Text
originalText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
formattedText
                            then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                            else String -> Text -> IO ()
AtomicWrite.LazyText.atomicWriteFile
                                    String
file
                                    (SimpleDocStream Ann -> Text
forall ann. SimpleDocStream ann -> Text
Pretty.Text.renderLazy SimpleDocStream Ann
docStream)

                    Input
StandardInput -> do
                        supportsANSI <- Handle -> IO Bool
System.Console.ANSI.hSupportsANSI Handle
System.IO.stdout

                        Pretty.Terminal.renderIO
                            System.IO.stdout
                            (if supportsANSI
                                then (fmap annToAnsiStyle docStream)
                                else (Pretty.unAnnotateS docStream))

                Either CheckFailed () -> IO (Either CheckFailed ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Either CheckFailed ()
forall a b. b -> Either a b
Right ())

            OutputMode
Check ->
                Either CheckFailed () -> IO (Either CheckFailed ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CheckFailed () -> IO (Either CheckFailed ()))
-> Either CheckFailed () -> IO (Either CheckFailed ())
forall a b. (a -> b) -> a -> b
$
                    if Text
originalText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
formattedText
                        then () -> Either CheckFailed ()
forall a b. b -> Either a b
Right ()
                        else CheckFailed -> Either CheckFailed ()
forall a b. a -> Either a b
Left CheckFailed{Input
input :: Input
input :: Input
..}