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