1{-# LANGUAGE LambdaCase        #-}
2{-# LANGUAGE NamedFieldPuns    #-}
3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE RecordWildCards   #-}
5
6-- | This module contains the implementation of the @dhall format@ subcommand
7
8module Dhall.Format
9    ( -- * Format
10      Format(..)
11    , format
12    ) where
13
14import Data.Foldable (for_)
15import Data.Maybe    (fromMaybe)
16import Dhall.Pretty  (CharacterSet, annToAnsiStyle, detectCharacterSet)
17import Dhall.Util
18    ( Censor
19    , CheckFailed (..)
20    , Header (..)
21    , OutputMode (..)
22    , PossiblyTransitiveInput (..)
23    , Transitivity (..)
24    )
25
26import qualified Control.Exception
27import qualified Data.Text.IO
28import qualified Data.Text.Prettyprint.Doc                 as Pretty
29import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty.Terminal
30import qualified Data.Text.Prettyprint.Doc.Render.Text     as Pretty.Text
31import qualified Dhall.Import
32import qualified Dhall.Pretty
33import qualified Dhall.Util
34import qualified System.AtomicWrite.Writer.LazyText        as AtomicWrite.LazyText
35import qualified System.Console.ANSI
36import qualified System.FilePath
37import qualified System.IO
38
39-- | Arguments to the `format` subcommand
40data Format = Format
41    { chosenCharacterSet :: Maybe CharacterSet
42    , censor             :: Censor
43    , input              :: PossiblyTransitiveInput
44    , outputMode         :: OutputMode
45    }
46
47-- | Implementation of the @dhall format@ subcommand
48format :: Format -> IO ()
49format (Format { input = input0, ..}) = go input0
50  where
51    go input = do
52        let directory = case input of
53                NonTransitiveStandardInput ->
54                    "."
55                PossiblyTransitiveInputFile file _ ->
56                    System.FilePath.takeDirectory file
57
58        let status = Dhall.Import.emptyStatus directory
59
60        let layoutHeaderAndExpr (Header header, expr) =
61                let characterSet = fromMaybe (detectCharacterSet expr) chosenCharacterSet
62                in
63                Dhall.Pretty.layout
64                    (   Pretty.pretty header
65                    <>  Dhall.Pretty.prettyCharacterSet characterSet expr
66                    <>  "\n")
67
68        (originalText, transitivity) <- case input of
69            PossiblyTransitiveInputFile file transitivity -> do
70                text <- Data.Text.IO.readFile file
71
72                return (text, transitivity)
73
74            NonTransitiveStandardInput -> do
75                text <- Data.Text.IO.getContents
76
77                return (text, NonTransitive)
78
79        headerAndExpr@(_, parsedExpression) <- Dhall.Util.getExpressionAndHeaderFromStdinText censor originalText
80
81        case transitivity of
82            Transitive ->
83                for_ parsedExpression $ \import_ -> do
84                    maybeFilepath <- Dhall.Import.dependencyToFile status import_
85
86                    for_ maybeFilepath $ \filepath ->
87                        go (PossiblyTransitiveInputFile filepath Transitive)
88
89            NonTransitive ->
90                return ()
91
92        let docStream = layoutHeaderAndExpr headerAndExpr
93
94        let formattedText = Pretty.Text.renderStrict docStream
95
96        case outputMode of
97            Write ->
98                case input of
99                    PossiblyTransitiveInputFile file _ ->
100                        if originalText == formattedText
101                            then return ()
102                            else AtomicWrite.LazyText.atomicWriteFile
103                                    file
104                                    (Pretty.Text.renderLazy docStream)
105
106                    NonTransitiveStandardInput -> do
107                        supportsANSI <- System.Console.ANSI.hSupportsANSI System.IO.stdout
108
109                        Pretty.Terminal.renderIO
110                            System.IO.stdout
111                            (if supportsANSI
112                                then (fmap annToAnsiStyle docStream)
113                                else (Pretty.unAnnotateS docStream))
114
115            Check ->
116                if originalText == formattedText
117                    then return ()
118                    else do
119                        let command = "format"
120
121                        let modified = "formatted"
122
123                        Control.Exception.throwIO CheckFailed{..}
124