1{-| This module contains the top-level entrypoint and options parsing for the
2    @dhall@ executable
3-}
4
5{-# LANGUAGE ApplicativeDo     #-}
6{-# LANGUAGE LambdaCase        #-}
7{-# LANGUAGE NamedFieldPuns    #-}
8{-# LANGUAGE OverloadedStrings #-}
9{-# LANGUAGE RecordWildCards   #-}
10
11module Dhall.Main
12    ( -- * Options
13      Options(..)
14    , Mode(..)
15    , ResolveMode(..)
16    , parseOptions
17    , parserInfoOptions
18
19      -- * Execution
20    , Dhall.Main.command
21    , main
22    ) where
23
24import Control.Applicative       (optional, (<|>))
25import Control.Exception         (Handler (..), SomeException)
26import Data.Foldable             (for_)
27import Data.Maybe                (fromMaybe)
28import Data.List.NonEmpty        (NonEmpty (..))
29import Data.Text                 (Text)
30import Data.Text.Prettyprint.Doc (Doc, Pretty)
31import Data.Void                 (Void)
32import Dhall.Freeze              (Intent (..), Scope (..))
33import Dhall.Import
34    ( Depends (..)
35    , Imported (..)
36    , SemanticCacheMode (..)
37    , _semanticCacheMode
38    )
39import Dhall.Parser              (Src)
40import Dhall.Pretty              (Ann, CharacterSet (..), annToAnsiStyle, detectCharacterSet)
41import Dhall.Schemas             (Schemas (..))
42import Dhall.TypeCheck
43    ( Censored (..)
44    , DetailedTypeError (..)
45    , TypeError
46    )
47import Dhall.Version             (dhallVersionString)
48import Options.Applicative       (Parser, ParserInfo)
49import System.Exit               (ExitCode, exitFailure)
50import System.IO                 (Handle)
51import Text.Dot                  ((.->.))
52
53import Dhall.Core
54    ( Expr (Annot)
55    , Import (..)
56    , ImportHashed (..)
57    , ImportType (..)
58    , URL (..)
59    , pretty
60    )
61import Dhall.Util
62    ( Censor (..)
63    , CheckFailed (..)
64    , Header (..)
65    , Input (..)
66    , Output (..)
67    , OutputMode (..)
68    , PossiblyTransitiveInput (..)
69    , Transitivity (..)
70    )
71
72import qualified Codec.CBOR.JSON
73import qualified Codec.CBOR.Read
74import qualified Codec.CBOR.Write
75import qualified Control.Exception
76import qualified Control.Monad.Trans.State.Strict          as State
77import qualified Data.Aeson
78import qualified Data.Aeson.Encode.Pretty
79import qualified Data.ByteString.Lazy
80import qualified Data.ByteString.Lazy.Char8
81import qualified Data.Map
82import qualified Data.Text
83import qualified Data.Text.IO
84import qualified Data.Text.Prettyprint.Doc                 as Pretty
85import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty
86import qualified Data.Text.Prettyprint.Doc.Render.Text     as Pretty.Text
87import qualified Dhall
88import qualified Dhall.Binary
89import qualified Dhall.Core
90import qualified Dhall.Diff
91import qualified Dhall.DirectoryTree                       as DirectoryTree
92import qualified Dhall.Format
93import qualified Dhall.Freeze
94import qualified Dhall.Import
95import qualified Dhall.Import.Types
96import qualified Dhall.Lint
97import qualified Dhall.Map
98import qualified Dhall.Pretty
99import qualified Dhall.Repl
100import qualified Dhall.Schemas
101import qualified Dhall.Tags
102import qualified Dhall.TypeCheck
103import qualified Dhall.Util
104import qualified GHC.IO.Encoding
105import qualified Options.Applicative
106import qualified System.AtomicWrite.Writer.LazyText        as AtomicWrite.LazyText
107import qualified System.Console.ANSI
108import qualified System.Exit                               as Exit
109import qualified System.FilePath
110import qualified System.IO
111import qualified Text.Dot
112import qualified Text.Pretty.Simple
113
114-- | Top-level program options
115data Options = Options
116    { mode               :: Mode
117    , explain            :: Bool
118    , plain              :: Bool
119    , chosenCharacterSet :: Maybe CharacterSet
120    , censor             :: Censor
121    }
122
123-- | The subcommands for the @dhall@ executable
124data Mode
125    = Default
126          { file :: Input
127          , output :: Output
128          , annotate :: Bool
129          , alpha :: Bool
130          , semanticCacheMode :: SemanticCacheMode
131          , version :: Bool
132          }
133    | Version
134    | Resolve
135          { file :: Input
136          , resolveMode :: Maybe ResolveMode
137          , semanticCacheMode :: SemanticCacheMode
138          }
139    | Type
140          { file :: Input
141          , quiet :: Bool
142          , semanticCacheMode :: SemanticCacheMode
143          }
144    | Normalize { file :: Input , alpha :: Bool }
145    | Repl
146    | Format { possiblyTransitiveInput :: PossiblyTransitiveInput, outputMode :: OutputMode }
147    | Freeze { possiblyTransitiveInput :: PossiblyTransitiveInput, all_ :: Bool, cache :: Bool, outputMode :: OutputMode }
148    | Hash { file :: Input, cache :: Bool }
149    | Diff { expr1 :: Text, expr2 :: Text }
150    | Lint { possiblyTransitiveInput :: PossiblyTransitiveInput, outputMode :: OutputMode }
151    | Tags
152          { input :: Input
153          , output :: Output
154          , suffixes :: Maybe [Text]
155          , followSymlinks :: Bool
156          }
157    | Encode { file :: Input, json :: Bool }
158    | Decode { file :: Input, json :: Bool, quiet :: Bool }
159    | Text { file :: Input, output :: Output }
160    | DirectoryTree { file :: Input, path :: FilePath }
161    | Schemas { file :: Input, outputMode :: OutputMode, schemas :: Text }
162    | SyntaxTree { file :: Input, noted :: Bool }
163
164-- | This specifies how to resolve transitive dependencies
165data ResolveMode
166    = Dot
167    -- ^ Generate a DOT file for @graphviz@
168    | ListTransitiveDependencies
169    -- ^ List all transitive dependencies as text, one per line
170    | ListImmediateDependencies
171    -- ^ List immediate dependencies as text, one per line
172
173-- | Groups of subcommands
174data Group
175    = Manipulate
176    | Generate
177    | Interpret
178    | Convert
179    | Miscellaneous
180    | Debugging
181
182groupDescription :: Group -> String
183groupDescription group = case group of
184    Manipulate -> "Manipulate Dhall code"
185    Generate -> "Generate other formats from Dhall"
186    Interpret -> "Interpret Dhall"
187    Convert -> "Convert Dhall to and from its binary representation"
188    Miscellaneous -> "Miscellaneous"
189    Debugging -> "Debugging this interpreter"
190
191-- | `Parser` for the `Options` type
192parseOptions :: Parser Options
193parseOptions =
194        Options
195    <$> parseMode
196    <*> switch "explain" "Explain error messages in more detail"
197    <*> switch "plain" "Disable syntax highlighting"
198    <*> parseCharacterSet
199    <*> parseCensor
200  where
201    switch name description =
202        Options.Applicative.switch
203            (   Options.Applicative.long name
204            <>  Options.Applicative.help description
205            )
206
207    parseCensor = fmap f (switch "censor" "Hide source code in error messages")
208      where
209        f True  = Censor
210        f False = NoCensor
211
212    parseCharacterSet =
213            Options.Applicative.flag'
214                (Just Unicode)
215                (   Options.Applicative.long "unicode"
216                <>  Options.Applicative.help "Format code using only Unicode syntax"
217                )
218        <|> Options.Applicative.flag'
219                (Just ASCII)
220                (   Options.Applicative.long "ascii"
221                <>  Options.Applicative.help "Format code using only ASCII syntax"
222                )
223        <|> pure Nothing
224
225subcommand :: Group -> String -> String -> Parser a -> Parser a
226subcommand group name description parser =
227    Options.Applicative.hsubparser
228        (   Options.Applicative.command name parserInfo
229        <>  Options.Applicative.metavar name
230        <>  Options.Applicative.commandGroup (groupDescription group)
231        )
232  where
233    parserInfo =
234        Options.Applicative.info parser
235            (   Options.Applicative.fullDesc
236            <>  Options.Applicative.progDesc description
237            )
238
239parseMode :: Parser Mode
240parseMode =
241        subcommand
242            Manipulate
243            "format"
244            "Standard code formatter for the Dhall language"
245            (Format <$> parseInplaceTransitive <*> parseCheck "formatted")
246    <|> subcommand
247            Manipulate
248            "freeze"
249            "Add integrity checks to remote import statements of an expression"
250            (Freeze <$> parseInplaceTransitive <*> parseAllFlag <*> parseCacheFlag <*> parseCheck "frozen")
251    <|> subcommand
252            Manipulate
253            "lint"
254            "Improve Dhall code by using newer language features and removing dead code"
255            (Lint <$> parseInplaceTransitive <*> parseCheck "linted")
256    <|> subcommand
257            Manipulate
258            "rewrite-with-schemas"
259            "Simplify Dhall code using a schemas record"
260            (Dhall.Main.Schemas <$> parseInplaceNonTransitive <*> parseCheck "rewritten" <*> parseSchemasRecord)
261    <|> subcommand
262            Generate
263            "text"
264            "Render a Dhall expression that evaluates to a Text literal"
265            (Text <$> parseFile <*> parseOutput)
266    <|> subcommand
267            Generate
268            "to-directory-tree"
269            "Convert nested records of Text literals into a directory tree"
270            (DirectoryTree <$> parseFile <*> parseDirectoryTreeOutput)
271    <|> subcommand
272            Interpret
273            "resolve"
274            "Resolve an expression's imports"
275            (Resolve <$> parseFile <*> parseResolveMode <*> parseSemanticCacheMode)
276    <|> subcommand
277            Interpret
278            "type"
279            "Infer an expression's type"
280            (Type <$> parseFile <*> parseQuiet <*> parseSemanticCacheMode)
281    <|> subcommand
282            Interpret
283            "normalize"
284            "Normalize an expression"
285            (Normalize <$> parseFile <*> parseAlpha)
286    <|> subcommand
287            Convert
288            "encode"
289            "Encode a Dhall expression to binary"
290            (Encode <$> parseFile <*> parseJSONFlag)
291    <|> subcommand
292            Convert
293            "decode"
294            "Decode a Dhall expression from binary"
295            (Decode <$> parseFile <*> parseJSONFlag <*> parseQuiet)
296    <|> subcommand
297            Miscellaneous
298            "repl"
299            "Interpret expressions in a REPL"
300            (pure Repl)
301    <|> subcommand
302            Miscellaneous
303            "diff"
304            "Render the difference between the normal form of two expressions"
305            (Diff <$> argument "expr1" <*> argument "expr2")
306    <|> subcommand
307            Miscellaneous
308            "hash"
309            "Compute semantic hashes for Dhall expressions"
310            (Hash <$> parseFile <*> parseCache)
311    <|> subcommand
312            Miscellaneous
313            "tags"
314            "Generate etags file"
315            (Tags <$> parseInput <*> parseTagsOutput <*> parseSuffixes <*> parseFollowSymlinks)
316    <|> subcommand
317            Miscellaneous
318            "version"
319            "Display version"
320            (pure Version)
321    <|> subcommand
322            Debugging
323            "haskell-syntax-tree"
324            "Output the parsed syntax tree (for debugging)"
325            (SyntaxTree <$> parseFile <*> parseNoted)
326    <|> (   Default
327        <$> parseFile
328        <*> parseOutput
329        <*> parseAnnotate
330        <*> parseAlpha
331        <*> parseSemanticCacheMode
332        <*> parseVersion
333        )
334  where
335    argument =
336            fmap Data.Text.pack
337        .   Options.Applicative.strArgument
338        .   Options.Applicative.metavar
339
340    parseFile = fmap f (optional p)
341      where
342        f  Nothing    = StandardInput
343        f (Just file) = InputFile file
344
345        p = Options.Applicative.strOption
346                (   Options.Applicative.long "file"
347                <>  Options.Applicative.help "Read expression from a file instead of standard input"
348                <>  Options.Applicative.metavar "FILE"
349                <>  Options.Applicative.action "file"
350                )
351
352    parseOutput = fmap f (optional p)
353      where
354        f Nothing = StandardOutput
355        f (Just file) = OutputFile file
356
357        p = Options.Applicative.strOption
358                (   Options.Applicative.long "output"
359                <>  Options.Applicative.help "Write result to a file instead of standard output"
360                <>  Options.Applicative.metavar "FILE"
361                <>  Options.Applicative.action "file"
362                )
363
364    parseAlpha =
365        Options.Applicative.switch
366            (   Options.Applicative.long "alpha"
367            <>  Options.Applicative.help "α-normalize expression"
368            )
369
370    parseAnnotate =
371        Options.Applicative.switch
372            (   Options.Applicative.long "annotate"
373            <>  Options.Applicative.help "Add a type annotation to the output"
374            )
375
376    parseSemanticCacheMode =
377        Options.Applicative.flag
378            UseSemanticCache
379            IgnoreSemanticCache
380            (   Options.Applicative.long "no-cache"
381            <>  Options.Applicative.help
382                  "Handle protected imports as if the cache was empty"
383            )
384
385    parseVersion =
386        Options.Applicative.switch
387            (   Options.Applicative.long "version"
388            <>  Options.Applicative.help "Display version"
389            )
390
391    parseResolveMode =
392          Options.Applicative.flag' (Just Dot)
393              (   Options.Applicative.long "dot"
394              <>  Options.Applicative.help
395                    "Output import dependency graph in dot format"
396              )
397        <|>
398          Options.Applicative.flag' (Just ListImmediateDependencies)
399              (   Options.Applicative.long "immediate-dependencies"
400              <>  Options.Applicative.help
401                    "List immediate import dependencies"
402              )
403        <|>
404          Options.Applicative.flag' (Just ListTransitiveDependencies)
405              (   Options.Applicative.long "transitive-dependencies"
406              <>  Options.Applicative.help
407                    "List transitive import dependencies in post-order"
408              )
409        <|> pure Nothing
410
411    parseQuiet =
412        Options.Applicative.switch
413            (   Options.Applicative.long "quiet"
414            <>  Options.Applicative.help "Don't print the result"
415            )
416
417    parseInplace =
418        Options.Applicative.strOption
419            (   Options.Applicative.long "inplace"
420            <>  Options.Applicative.help "Modify the specified file in-place"
421            <>  Options.Applicative.metavar "FILE"
422            <>  Options.Applicative.action "file"
423            )
424
425    parseInplaceNonTransitive =
426            fmap InputFile parseInplace
427        <|> pure StandardInput
428
429    parseInplaceTransitive =
430            fmap (\f -> PossiblyTransitiveInputFile f NonTransitive) parseInplace
431        <|> fmap (\f -> PossiblyTransitiveInputFile f    Transitive) parseTransitive
432        <|> pure NonTransitiveStandardInput
433      where
434        parseTransitive = Options.Applicative.strOption
435            (   Options.Applicative.long "transitive"
436            <>  Options.Applicative.help "Modify the specified file and its transitive relative imports in-place"
437            <>  Options.Applicative.metavar "FILE"
438            <>  Options.Applicative.action "file"
439            )
440
441    parseInput = fmap f (optional p)
442      where
443        f  Nothing    = StandardInput
444        f (Just path) = InputFile path
445
446        p = Options.Applicative.strOption
447            (   Options.Applicative.long "path"
448            <>  Options.Applicative.help "Index all files in path recursively. Will get list of files from STDIN if omitted."
449            <>  Options.Applicative.metavar "PATH"
450            <>  Options.Applicative.action "file"
451            <>  Options.Applicative.action "directory"
452            )
453
454    parseTagsOutput = fmap f (optional p)
455      where
456        f  Nothing    = OutputFile "tags"
457        f (Just file) = OutputFile file
458
459        p = Options.Applicative.strOption
460            (   Options.Applicative.long "output"
461            <>  Options.Applicative.help "The name of the file that the tags are written to. Defaults to \"tags\""
462            <>  Options.Applicative.metavar "FILENAME"
463            <>  Options.Applicative.action "file"
464            )
465
466    parseSuffixes = fmap f (optional p)
467      where
468        f  Nothing    = Just [".dhall"]
469        f (Just "")   = Nothing
470        f (Just line) = Just (Data.Text.splitOn " " line)
471
472        p = Options.Applicative.strOption
473            (   Options.Applicative.long "suffixes"
474            <>  Options.Applicative.help "Index only files with suffixes. \"\" to index all files."
475            <>  Options.Applicative.metavar "SUFFIXES"
476            )
477
478    parseFollowSymlinks =
479        Options.Applicative.switch
480        (   Options.Applicative.long "follow-symlinks"
481        <>  Options.Applicative.help "Follow symlinks when recursing directories"
482        )
483
484    parseJSONFlag =
485        Options.Applicative.switch
486        (   Options.Applicative.long "json"
487        <>  Options.Applicative.help "Use JSON representation of CBOR"
488        )
489
490    parseAllFlag =
491        Options.Applicative.switch
492        (   Options.Applicative.long "all"
493        <>  Options.Applicative.help "Add integrity checks to all imports (not just remote imports)"
494        )
495
496    parseCacheFlag =
497        Options.Applicative.switch
498        (   Options.Applicative.long "cache"
499        <>  Options.Applicative.help "Add fallback unprotected imports when using integrity checks purely for caching purposes"
500        )
501
502    parseCheck processed = fmap adapt switch
503      where
504        adapt True  = Check
505        adapt False = Write
506
507        switch =
508            Options.Applicative.switch
509            (   Options.Applicative.long "check"
510            <>  Options.Applicative.help ("Only check if the input is " <> processed)
511            )
512
513    parseSchemasRecord =
514        Options.Applicative.strOption
515            (   Options.Applicative.long "schemas"
516            <>  Options.Applicative.help "A record of schemas"
517            <>  Options.Applicative.metavar "EXPR"
518            )
519
520    parseDirectoryTreeOutput =
521        Options.Applicative.strOption
522            (   Options.Applicative.long "output"
523            <>  Options.Applicative.help "The destination path to create"
524            <>  Options.Applicative.metavar "PATH"
525            <>  Options.Applicative.action "directory"
526            )
527
528    parseNoted =
529        Options.Applicative.switch
530            (   Options.Applicative.long "noted"
531            <>  Options.Applicative.help "Print `Note` constructors"
532            )
533
534    parseCache =
535        Options.Applicative.switch
536            (   Options.Applicative.long "cache"
537            <>  Options.Applicative.help "Cache the hashed expression"
538            )
539
540-- | `ParserInfo` for the `Options` type
541parserInfoOptions :: ParserInfo Options
542parserInfoOptions =
543    Options.Applicative.info
544        (Options.Applicative.helper <*> parseOptions)
545        (   Options.Applicative.progDesc "Interpreter for the Dhall language"
546        <>  Options.Applicative.fullDesc
547        )
548
549noHeaders :: Import -> Import
550noHeaders
551    (Import { importHashed = ImportHashed { importType = Remote URL{ .. }, ..}, .. }) =
552    Import { importHashed = ImportHashed { importType = Remote URL{ headers = Nothing, .. }, .. }, .. }
553noHeaders i =
554    i
555
556-- | Run the command specified by the `Options` type
557command :: Options -> IO ()
558command (Options {..}) = do
559    GHC.IO.Encoding.setLocaleEncoding System.IO.utf8
560
561    let rootDirectory = \case
562            InputFile f   -> System.FilePath.takeDirectory f
563            StandardInput -> "."
564
565    let toStatus = Dhall.Import.emptyStatus . rootDirectory
566
567    let getExpression = Dhall.Util.getExpression censor
568
569    -- The characterSet detection used here only works on the source
570    -- expression, before any transformation is applied. This helper is there
571    -- make sure the detection is done on the correct expr.
572    let getExpressionAndCharacterSet file = do
573            expr <- getExpression file
574
575            let characterSet = fromMaybe (detectCharacterSet expr) chosenCharacterSet
576
577            return (expr, characterSet)
578
579    let handle io =
580            Control.Exception.catches io
581                [ Handler handleTypeError
582                , Handler handleImported
583                , Handler handleExitCode
584                ]
585          where
586            handleAll e = do
587                let string = show (e :: SomeException)
588
589                if not (null string)
590                    then System.IO.hPutStrLn System.IO.stderr string
591                    else return ()
592
593                System.Exit.exitFailure
594
595            handleTypeError e = Control.Exception.handle handleAll $ do
596                let _ = e :: TypeError Src Void
597                System.IO.hPutStrLn System.IO.stderr ""
598                if explain
599                    then
600                        case censor of
601                            Censor   -> Control.Exception.throwIO (CensoredDetailed (DetailedTypeError e))
602                            NoCensor -> Control.Exception.throwIO (DetailedTypeError e)
603
604                    else do
605                        Data.Text.IO.hPutStrLn System.IO.stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m"
606                        case censor of
607                            Censor   -> Control.Exception.throwIO (Censored e)
608                            NoCensor -> Control.Exception.throwIO e
609
610            handleImported (Imported ps e) = Control.Exception.handle handleAll $ do
611                let _ = e :: TypeError Src Void
612                System.IO.hPutStrLn System.IO.stderr ""
613                if explain
614                    then Control.Exception.throwIO (Imported ps (DetailedTypeError e))
615                    else do
616                        Data.Text.IO.hPutStrLn System.IO.stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m"
617                        Control.Exception.throwIO (Imported ps e)
618
619            handleExitCode e =
620                Control.Exception.throwIO (e :: ExitCode)
621
622    let renderDoc :: Handle -> Doc Ann -> IO ()
623        renderDoc h doc = do
624            let stream = Dhall.Pretty.layout doc
625
626            supportsANSI <- System.Console.ANSI.hSupportsANSI h
627            let ansiStream =
628                    if supportsANSI && not plain
629                    then fmap annToAnsiStyle stream
630                    else Pretty.unAnnotateS stream
631
632            Pretty.renderIO h ansiStream
633            Data.Text.IO.hPutStrLn h ""
634
635    let render :: Pretty a => Handle -> CharacterSet -> Expr Src a -> IO ()
636        render h characterSet expression = do
637            let doc = Dhall.Pretty.prettyCharacterSet characterSet expression
638
639            renderDoc h doc
640
641    let writeDocToFile :: FilePath -> Doc ann -> IO ()
642        writeDocToFile file doc = do
643            let stream = Dhall.Pretty.layout (doc <> "\n")
644
645            AtomicWrite.LazyText.atomicWriteFile file (Pretty.Text.renderLazy stream)
646
647    handle $ case mode of
648        Version ->
649            putStrLn dhallVersionString
650
651        Default {..} -> do
652            if version
653                then do
654                    putStrLn dhallVersionString
655                    Exit.exitSuccess
656                else return ()
657
658            (expression, characterSet) <- getExpressionAndCharacterSet file
659
660            resolvedExpression <-
661                Dhall.Import.loadRelativeTo (rootDirectory file) semanticCacheMode expression
662
663            inferredType <- Dhall.Core.throws (Dhall.TypeCheck.typeOf resolvedExpression)
664
665            let normalizedExpression = Dhall.Core.normalize resolvedExpression
666
667            let alphaNormalizedExpression =
668                    if alpha
669                    then Dhall.Core.alphaNormalize normalizedExpression
670                    else normalizedExpression
671
672            let annotatedExpression =
673                    if annotate
674                        then Annot alphaNormalizedExpression inferredType
675                        else alphaNormalizedExpression
676
677            case output of
678                StandardOutput -> render System.IO.stdout characterSet annotatedExpression
679
680                OutputFile file_ ->
681                    writeDocToFile
682                        file_
683                        (Dhall.Pretty.prettyCharacterSet characterSet annotatedExpression)
684
685        Resolve { resolveMode = Just Dot, ..} -> do
686            expression <- getExpression file
687
688            (Dhall.Import.Types.Status { _graph, _stack }) <-
689                State.execStateT (Dhall.Import.loadWith expression) (toStatus file) { _semanticCacheMode = semanticCacheMode }
690
691            let (rootImport :| _) = _stack
692                imports = rootImport : map parent _graph ++ map child _graph
693                importIds = Data.Map.fromList (zip imports [Text.Dot.userNodeId i | i <- [0..]])
694
695            let dotNode (i, nodeId) =
696                    Text.Dot.userNode
697                        nodeId
698                        [ ("label", Data.Text.unpack $ pretty (convert i))
699                        , ("shape", "box")
700                        , ("style", "rounded")
701                        ]
702                  where
703                    convert = noHeaders . Dhall.Import.chainedImport
704
705            let dotEdge (Depends parent child) =
706                    case (Data.Map.lookup parent importIds, Data.Map.lookup child importIds) of
707                        (Just from, Just to) -> from .->. to
708                        _                    -> pure ()
709
710            let dot = do Text.Dot.attribute ("rankdir", "LR")
711                         mapM_ dotNode (Data.Map.assocs importIds)
712                         mapM_ dotEdge _graph
713
714            putStr . ("strict " <>) . Text.Dot.showDot $ dot
715
716        Resolve { resolveMode = Just ListImmediateDependencies, ..} -> do
717            expression <- getExpression file
718
719            mapM_ (print . Pretty.pretty . noHeaders) expression
720
721        Resolve { resolveMode = Just ListTransitiveDependencies, ..} -> do
722            expression <- getExpression file
723
724            (Dhall.Import.Types.Status { _cache }) <-
725                State.execStateT (Dhall.Import.loadWith expression) (toStatus file) { _semanticCacheMode = semanticCacheMode }
726
727            mapM_ print
728                 .   fmap ( Pretty.pretty
729                          . noHeaders
730                          . Dhall.Import.chainedImport
731                          )
732                 .   reverse
733                 .   Dhall.Map.keys
734                 $   _cache
735
736        Resolve { resolveMode = Nothing, ..} -> do
737            (expression, characterSet) <- getExpressionAndCharacterSet file
738
739            resolvedExpression <-
740                Dhall.Import.loadRelativeTo (rootDirectory file) semanticCacheMode expression
741
742            render System.IO.stdout characterSet resolvedExpression
743
744        Normalize {..} -> do
745            (expression, characterSet) <- getExpressionAndCharacterSet file
746
747            resolvedExpression <- Dhall.Import.assertNoImports expression
748
749            _ <- Dhall.Core.throws (Dhall.TypeCheck.typeOf resolvedExpression)
750
751            let normalizedExpression = Dhall.Core.normalize resolvedExpression
752
753            let alphaNormalizedExpression =
754                    if alpha
755                    then Dhall.Core.alphaNormalize normalizedExpression
756                    else normalizedExpression
757
758            render System.IO.stdout characterSet alphaNormalizedExpression
759
760        Type {..} -> do
761            (expression, characterSet) <- getExpressionAndCharacterSet file
762
763            resolvedExpression <-
764                Dhall.Import.loadRelativeTo (rootDirectory file) semanticCacheMode expression
765
766            inferredType <- Dhall.Core.throws (Dhall.TypeCheck.typeOf resolvedExpression)
767
768            if quiet
769                then return ()
770                else render System.IO.stdout characterSet inferredType
771
772        Repl ->
773            Dhall.Repl.repl
774                (fromMaybe Unicode chosenCharacterSet) -- Default to Unicode if no characterSet specified
775                explain
776
777        Diff {..} -> do
778            expression1 <- Dhall.inputExpr expr1
779
780            expression2 <- Dhall.inputExpr expr2
781
782            let diff = Dhall.Diff.diffNormalized expression1 expression2
783
784            renderDoc System.IO.stdout (Dhall.Diff.doc diff)
785
786            if Dhall.Diff.same diff
787                then return ()
788                else Exit.exitFailure
789
790        Format {..} ->
791            Dhall.Format.format
792                Dhall.Format.Format{ input = possiblyTransitiveInput, ..}
793
794        Freeze {..} -> do
795            let scope = if all_ then AllImports else OnlyRemoteImports
796
797            let intent = if cache then Cache else Secure
798
799            Dhall.Freeze.freeze outputMode possiblyTransitiveInput scope intent chosenCharacterSet censor
800
801        Hash {..} -> do
802            expression <- getExpression file
803
804            resolvedExpression <-
805                Dhall.Import.loadRelativeTo (rootDirectory file) UseSemanticCache expression
806
807            _ <- Dhall.Core.throws (Dhall.TypeCheck.typeOf resolvedExpression)
808
809            let normalizedExpression =
810                    Dhall.Core.alphaNormalize (Dhall.Core.normalize resolvedExpression)
811
812            if cache
813                then Dhall.Import.writeExpressionToSemanticCache normalizedExpression
814                else return ()
815
816            Data.Text.IO.putStrLn (Dhall.Import.hashExpressionToCode normalizedExpression)
817
818        Lint { possiblyTransitiveInput = input0, ..} -> go input0
819          where
820            go input = do
821                let directory = case input of
822                        NonTransitiveStandardInput         -> "."
823                        PossiblyTransitiveInputFile file _ -> System.FilePath.takeDirectory file
824
825                let status = Dhall.Import.emptyStatus directory
826
827                (originalText, transitivity) <- case input of
828                    PossiblyTransitiveInputFile file transitivity -> do
829                        text <- Data.Text.IO.readFile file
830
831                        return (text, transitivity)
832                    NonTransitiveStandardInput -> do
833                        text <- Data.Text.IO.getContents
834
835                        return (text, NonTransitive)
836
837                (Header header, parsedExpression) <-
838                    Dhall.Util.getExpressionAndHeaderFromStdinText censor originalText
839
840                let characterSet = fromMaybe (detectCharacterSet parsedExpression) chosenCharacterSet
841
842                case transitivity of
843                    Transitive ->
844                        for_ parsedExpression $ \import_ -> do
845                            maybeFilepath <- Dhall.Import.dependencyToFile status import_
846
847                            for_ maybeFilepath $ \filepath ->
848                                go (PossiblyTransitiveInputFile filepath Transitive)
849
850                    NonTransitive ->
851                        return ()
852
853                let lintedExpression = Dhall.Lint.lint parsedExpression
854
855                let doc =   Pretty.pretty header
856                        <>  Dhall.Pretty.prettyCharacterSet characterSet lintedExpression
857
858                let stream = Dhall.Pretty.layout doc
859
860                let modifiedText = Pretty.Text.renderStrict stream <> "\n"
861
862                case outputMode of
863                    Write ->
864                        case input of
865                            PossiblyTransitiveInputFile file _ ->
866                                if originalText == modifiedText
867                                    then return ()
868                                    else writeDocToFile file doc
869
870                            NonTransitiveStandardInput ->
871                                renderDoc System.IO.stdout doc
872
873                    Check ->
874                        if originalText == modifiedText
875                            then return ()
876                            else do
877                                let modified = "linted"
878
879                                Control.Exception.throwIO CheckFailed{ command = "lint", ..}
880
881        Encode {..} -> do
882            expression <- getExpression file
883
884            let bytes = Dhall.Binary.encodeExpression (Dhall.Core.denote expression)
885
886            if json
887                then do
888                    let decoder = Codec.CBOR.JSON.decodeValue False
889
890                    (_, value) <- Dhall.Core.throws (Codec.CBOR.Read.deserialiseFromBytes decoder bytes)
891
892                    let jsonBytes = Data.Aeson.Encode.Pretty.encodePretty value
893
894                    Data.ByteString.Lazy.Char8.putStrLn jsonBytes
895
896                else
897                    Data.ByteString.Lazy.putStr bytes
898
899        Decode {..} -> do
900            bytes <-
901                case file of
902                    InputFile f   -> Data.ByteString.Lazy.readFile f
903                    StandardInput -> Data.ByteString.Lazy.getContents
904
905            expression <-
906                if json
907                    then do
908                        value <- case Data.Aeson.eitherDecode' bytes of
909                            Left  string -> fail string
910                            Right value  -> return value
911
912                        let encoding = Codec.CBOR.JSON.encodeValue value
913
914                        let cborgBytes = Codec.CBOR.Write.toLazyByteString encoding
915
916                        Dhall.Core.throws (Dhall.Binary.decodeExpression cborgBytes)
917                    else
918                        Dhall.Core.throws (Dhall.Binary.decodeExpression bytes)
919
920
921            if quiet
922                then return ()
923                else do
924                    let doc =
925                            Dhall.Pretty.prettyCharacterSet
926                                (fromMaybe Unicode chosenCharacterSet) -- default to Unicode
927                                (Dhall.Core.renote expression :: Expr Src Import)
928
929                    renderDoc System.IO.stdout doc
930
931        Text {..} -> do
932            expression <- getExpression file
933
934            resolvedExpression <-
935                Dhall.Import.loadRelativeTo (rootDirectory file) UseSemanticCache expression
936
937            _ <- Dhall.Core.throws (Dhall.TypeCheck.typeOf (Annot resolvedExpression Dhall.Core.Text))
938
939            let normalizedExpression = Dhall.Core.normalize resolvedExpression
940
941            case normalizedExpression of
942                Dhall.Core.TextLit (Dhall.Core.Chunks [] text) ->
943                    let write = case output of
944                          StandardOutput -> Data.Text.IO.putStr
945                          OutputFile file_ -> Data.Text.IO.writeFile file_
946                    in write text
947                _ -> do
948                    let invalidDecoderExpected :: Expr Void Void
949                        invalidDecoderExpected = Dhall.Core.Text
950
951                    let invalidDecoderExpression :: Expr Void Void
952                        invalidDecoderExpression = normalizedExpression
953
954                    Control.Exception.throwIO (Dhall.InvalidDecoder {..})
955
956        Tags {..} -> do
957            tags <- Dhall.Tags.generate input suffixes followSymlinks
958
959            case output of
960                OutputFile file ->
961                    System.IO.withFile file System.IO.WriteMode (`Data.Text.IO.hPutStr` tags)
962
963                StandardOutput -> Data.Text.IO.putStrLn tags
964
965        DirectoryTree {..} -> do
966            expression <- getExpression file
967
968            resolvedExpression <-
969                Dhall.Import.loadRelativeTo (rootDirectory file) UseSemanticCache expression
970
971            _ <- Dhall.Core.throws (Dhall.TypeCheck.typeOf resolvedExpression)
972
973            let normalizedExpression = Dhall.Core.normalize resolvedExpression
974
975            DirectoryTree.toDirectoryTree path normalizedExpression
976
977        Dhall.Main.Schemas{..} ->
978            Dhall.Schemas.schemasCommand Dhall.Schemas.Schemas{ input = file, ..}
979
980        SyntaxTree {..} -> do
981            expression <- getExpression file
982
983            if noted then
984                Text.Pretty.Simple.pPrintNoColor expression
985            else
986                let denoted :: Expr Void Import
987                    denoted = Dhall.Core.denote expression
988                in Text.Pretty.Simple.pPrintNoColor denoted
989
990-- | Entry point for the @dhall@ executable
991main :: IO ()
992main = do
993    options <- Options.Applicative.execParser parserInfoOptions
994
995    Dhall.Main.command options
996