{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Dhall.Main
(
Options(..)
, Mode(..)
, parseOptions
, parserInfoOptions
, Dhall.Main.command
, main
) where
import Control.Applicative (optional, (<|>))
import Control.Exception (Handler(..), SomeException)
import Control.Monad (when)
import Data.Bifunctor (first)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Monoid ((<>))
import Data.Text (Text)
import Data.Text.Prettyprint.Doc (Doc, Pretty)
import Data.Void (Void)
import Dhall.Freeze (Intent(..), Scope(..))
import Dhall.Import (Imported(..), Depends(..), SemanticCacheMode(..), _semanticCacheMode)
import Dhall.Parser (Src)
import Dhall.Pretty (Ann, CharacterSet(..), annToAnsiStyle)
import Dhall.TypeCheck (Censored(..), DetailedTypeError(..), TypeError)
import Dhall.Version (dhallVersionString)
import Options.Applicative (Parser, ParserInfo)
import System.Exit (ExitCode, exitFailure)
import System.IO (Handle)
import Text.Dot ((.->.))
import Dhall.Core
( Expr(Annot)
, Import(..)
, ImportHashed(..)
, ImportType(..)
, URL(..)
, pretty
)
import Dhall.Util
( Censor(..)
, CheckFailed(..)
, Header (..)
, Input(..)
, OutputMode(..)
, Output(..)
)
import qualified Codec.CBOR.JSON
import qualified Codec.CBOR.Read
import qualified Codec.CBOR.Write
import qualified Control.Exception
import qualified Control.Monad.Trans.State.Strict as State
import qualified Data.Aeson
import qualified Data.Aeson.Encode.Pretty
import qualified Data.ByteString.Lazy
import qualified Data.ByteString.Lazy.Char8
import qualified Data.Map
import qualified Data.Text
import qualified Data.Text.IO
import qualified Data.Text.Prettyprint.Doc as Pretty
import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty
import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty.Text
import qualified Dhall
import qualified Dhall.Binary
import qualified Dhall.Core
import qualified Dhall.Diff
import qualified Dhall.DirectoryTree as DirectoryTree
import qualified Dhall.Format
import qualified Dhall.Freeze
import qualified Dhall.Import
import qualified Dhall.Import.Types
import qualified Dhall.Lint
import qualified Dhall.Parser as Parser
import qualified Dhall.Map
import qualified Dhall.Tags
import qualified Dhall.Pretty
import qualified Dhall.Repl
import qualified Dhall.TypeCheck
import qualified Dhall.Util
import qualified GHC.IO.Encoding
import qualified Options.Applicative
import qualified System.AtomicWrite.Writer.LazyText as AtomicWrite.LazyText
import qualified System.Console.ANSI
import qualified System.Exit as Exit
import qualified System.IO
import qualified System.FilePath
import qualified Text.Dot
import qualified Text.Pretty.Simple
data Options = Options
{ Options -> Mode
mode :: Mode
, Options -> Bool
explain :: Bool
, Options -> Bool
plain :: Bool
, Options -> Bool
ascii :: Bool
, Options -> Censor
censor :: Censor
}
ignoreSemanticCache :: Mode -> Bool
ignoreSemanticCache :: Mode -> Bool
ignoreSemanticCache Default {..} = SemanticCacheMode
semanticCacheMode SemanticCacheMode -> SemanticCacheMode -> Bool
forall a. Eq a => a -> a -> Bool
== SemanticCacheMode
IgnoreSemanticCache
ignoreSemanticCache Resolve {..} = SemanticCacheMode
semanticCacheMode SemanticCacheMode -> SemanticCacheMode -> Bool
forall a. Eq a => a -> a -> Bool
== SemanticCacheMode
IgnoreSemanticCache
ignoreSemanticCache Type {..} = SemanticCacheMode
semanticCacheMode SemanticCacheMode -> SemanticCacheMode -> Bool
forall a. Eq a => a -> a -> Bool
== SemanticCacheMode
IgnoreSemanticCache
ignoreSemanticCache _ = Bool
False
data Mode
= Default
{ Mode -> Input
file :: Input
, Mode -> Output
output :: Output
, Mode -> Bool
annotate :: Bool
, Mode -> Bool
alpha :: Bool
, Mode -> SemanticCacheMode
semanticCacheMode :: SemanticCacheMode
, Mode -> Bool
version :: Bool
}
| Version
| Resolve
{ file :: Input
, Mode -> Maybe ResolveMode
resolveMode :: Maybe ResolveMode
, semanticCacheMode :: SemanticCacheMode
}
| Type
{ file :: Input
, Mode -> Bool
quiet :: Bool
, semanticCacheMode :: SemanticCacheMode
}
| Normalize { file :: Input , alpha :: Bool }
| Repl
| Format { Mode -> Input
input :: Input, Mode -> OutputMode
outputMode :: OutputMode }
| Freeze { input :: Input, Mode -> Bool
all_ :: Bool, Mode -> Bool
cache :: Bool, outputMode :: OutputMode }
| Hash { file :: Input }
| Diff { Mode -> Text
expr1 :: Text, Mode -> Text
expr2 :: Text }
| Lint { input :: Input, outputMode :: OutputMode }
| Tags
{ input :: Input
, output :: Output
, Mode -> Maybe [Text]
suffixes :: Maybe [Text]
, Mode -> Bool
followSymlinks :: Bool
}
| Encode { file :: Input, Mode -> Bool
json :: Bool }
| Decode { file :: Input, json :: Bool }
| Text { file :: Input }
| DirectoryTree { file :: Input, Mode -> FilePath
path :: FilePath }
| SyntaxTree { file :: Input }
data ResolveMode
= Dot
| ListTransitiveDependencies
| ListImmediateDependencies
parseOptions :: Parser Options
parseOptions :: Parser Options
parseOptions =
Mode -> Bool -> Bool -> Bool -> Censor -> Options
Options
(Mode -> Bool -> Bool -> Bool -> Censor -> Options)
-> Parser Mode
-> Parser (Bool -> Bool -> Bool -> Censor -> Options)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Mode
parseMode
Parser (Bool -> Bool -> Bool -> Censor -> Options)
-> Parser Bool -> Parser (Bool -> Bool -> Censor -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> FilePath -> Parser Bool
switch "explain" "Explain error messages in more detail"
Parser (Bool -> Bool -> Censor -> Options)
-> Parser Bool -> Parser (Bool -> Censor -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> FilePath -> Parser Bool
switch "plain" "Disable syntax highlighting"
Parser (Bool -> Censor -> Options)
-> Parser Bool -> Parser (Censor -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> FilePath -> Parser Bool
switch "ascii" "Format code using only ASCII syntax"
Parser (Censor -> Options) -> Parser Censor -> Parser Options
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Censor
parseCensor
where
switch :: FilePath -> FilePath -> Parser Bool
switch name :: FilePath
name description :: FilePath
description =
Mod FlagFields Bool -> Parser Bool
Options.Applicative.switch
( FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long FilePath
name
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help FilePath
description
)
parseCensor :: Parser Censor
parseCensor = (Bool -> Censor) -> Parser Bool -> Parser Censor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Censor
f (FilePath -> FilePath -> Parser Bool
switch "censor" "Hide source code in error messages")
where
f :: Bool -> Censor
f True = Censor
Censor
f False = Censor
NoCensor
subcommand' :: Bool -> String -> String -> Parser a -> Parser a
subcommand' :: Bool -> FilePath -> FilePath -> Parser a -> Parser a
subcommand' internal :: Bool
internal name :: FilePath
name description :: FilePath
description parser :: Parser a
parser =
Mod CommandFields a -> Parser a
forall a. Mod CommandFields a -> Parser a
Options.Applicative.hsubparser
( FilePath -> ParserInfo a -> Mod CommandFields a
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
Options.Applicative.command FilePath
name ParserInfo a
parserInfo
Mod CommandFields a -> Mod CommandFields a -> Mod CommandFields a
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod CommandFields a
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Options.Applicative.metavar FilePath
name
Mod CommandFields a -> Mod CommandFields a -> Mod CommandFields a
forall a. Semigroup a => a -> a -> a
<> if Bool
internal then Mod CommandFields a
forall (f :: * -> *) a. Mod f a
Options.Applicative.internal else Mod CommandFields a
forall a. Monoid a => a
mempty
)
where
parserInfo :: ParserInfo a
parserInfo =
Parser a -> InfoMod a -> ParserInfo a
forall a. Parser a -> InfoMod a -> ParserInfo a
Options.Applicative.info Parser a
parser
( InfoMod a
forall a. InfoMod a
Options.Applicative.fullDesc
InfoMod a -> InfoMod a -> InfoMod a
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod a
forall a. FilePath -> InfoMod a
Options.Applicative.progDesc FilePath
description
)
subcommand :: String -> String -> Parser a -> Parser a
subcommand :: FilePath -> FilePath -> Parser a -> Parser a
subcommand = Bool -> FilePath -> FilePath -> Parser a -> Parser a
forall a. Bool -> FilePath -> FilePath -> Parser a -> Parser a
subcommand' Bool
False
internalSubcommand :: String -> String -> Parser a -> Parser a
internalSubcommand :: FilePath -> FilePath -> Parser a -> Parser a
internalSubcommand = Bool -> FilePath -> FilePath -> Parser a -> Parser a
forall a. Bool -> FilePath -> FilePath -> Parser a -> Parser a
subcommand' Bool
True
parseMode :: Parser Mode
parseMode :: Parser Mode
parseMode =
FilePath -> FilePath -> Parser Mode -> Parser Mode
forall a. FilePath -> FilePath -> Parser a -> Parser a
subcommand
"version"
"Display version"
(Mode -> Parser Mode
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mode
Version)
Parser Mode -> Parser Mode -> Parser Mode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> FilePath -> Parser Mode -> Parser Mode
forall a. FilePath -> FilePath -> Parser a -> Parser a
subcommand
"resolve"
"Resolve an expression's imports"
(Input -> Maybe ResolveMode -> SemanticCacheMode -> Mode
Resolve (Input -> Maybe ResolveMode -> SemanticCacheMode -> Mode)
-> Parser Input
-> Parser (Maybe ResolveMode -> SemanticCacheMode -> Mode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Input
parseFile Parser (Maybe ResolveMode -> SemanticCacheMode -> Mode)
-> Parser (Maybe ResolveMode) -> Parser (SemanticCacheMode -> Mode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe ResolveMode)
parseResolveMode Parser (SemanticCacheMode -> Mode)
-> Parser SemanticCacheMode -> Parser Mode
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SemanticCacheMode
parseSemanticCacheMode)
Parser Mode -> Parser Mode -> Parser Mode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> FilePath -> Parser Mode -> Parser Mode
forall a. FilePath -> FilePath -> Parser a -> Parser a
subcommand
"type"
"Infer an expression's type"
(Input -> Bool -> SemanticCacheMode -> Mode
Type (Input -> Bool -> SemanticCacheMode -> Mode)
-> Parser Input -> Parser (Bool -> SemanticCacheMode -> Mode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Input
parseFile Parser (Bool -> SemanticCacheMode -> Mode)
-> Parser Bool -> Parser (SemanticCacheMode -> Mode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
parseQuiet Parser (SemanticCacheMode -> Mode)
-> Parser SemanticCacheMode -> Parser Mode
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SemanticCacheMode
parseSemanticCacheMode)
Parser Mode -> Parser Mode -> Parser Mode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> FilePath -> Parser Mode -> Parser Mode
forall a. FilePath -> FilePath -> Parser a -> Parser a
subcommand
"normalize"
"Normalize an expression"
(Input -> Bool -> Mode
Normalize (Input -> Bool -> Mode) -> Parser Input -> Parser (Bool -> Mode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Input
parseFile Parser (Bool -> Mode) -> Parser Bool -> Parser Mode
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
parseAlpha)
Parser Mode -> Parser Mode -> Parser Mode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> FilePath -> Parser Mode -> Parser Mode
forall a. FilePath -> FilePath -> Parser a -> Parser a
subcommand
"repl"
"Interpret expressions in a REPL"
(Mode -> Parser Mode
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mode
Repl)
Parser Mode -> Parser Mode -> Parser Mode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> FilePath -> Parser Mode -> Parser Mode
forall a. FilePath -> FilePath -> Parser a -> Parser a
subcommand
"diff"
"Render the difference between the normal form of two expressions"
(Text -> Text -> Mode
Diff (Text -> Text -> Mode) -> Parser Text -> Parser (Text -> Mode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Parser Text
argument "expr1" Parser (Text -> Mode) -> Parser Text -> Parser Mode
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> Parser Text
argument "expr2")
Parser Mode -> Parser Mode -> Parser Mode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> FilePath -> Parser Mode -> Parser Mode
forall a. FilePath -> FilePath -> Parser a -> Parser a
subcommand
"hash"
"Compute semantic hashes for Dhall expressions"
(Input -> Mode
Hash (Input -> Mode) -> Parser Input -> Parser Mode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Input
parseFile)
Parser Mode -> Parser Mode -> Parser Mode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> FilePath -> Parser Mode -> Parser Mode
forall a. FilePath -> FilePath -> Parser a -> Parser a
subcommand
"lint"
"Improve Dhall code by using newer language features and removing dead code"
(Input -> OutputMode -> Mode
Lint (Input -> OutputMode -> Mode)
-> Parser Input -> Parser (OutputMode -> Mode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Input
parseInplace Parser (OutputMode -> Mode) -> Parser OutputMode -> Parser Mode
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputMode
parseCheck)
Parser Mode -> Parser Mode -> Parser Mode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> FilePath -> Parser Mode -> Parser Mode
forall a. FilePath -> FilePath -> Parser a -> Parser a
subcommand
"tags"
"Generate etags file"
(Input -> Output -> Maybe [Text] -> Bool -> Mode
Tags (Input -> Output -> Maybe [Text] -> Bool -> Mode)
-> Parser Input -> Parser (Output -> Maybe [Text] -> Bool -> Mode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Input
parseInput Parser (Output -> Maybe [Text] -> Bool -> Mode)
-> Parser Output -> Parser (Maybe [Text] -> Bool -> Mode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Output
parseTagsOutput Parser (Maybe [Text] -> Bool -> Mode)
-> Parser (Maybe [Text]) -> Parser (Bool -> Mode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe [Text])
parseSuffixes Parser (Bool -> Mode) -> Parser Bool -> Parser Mode
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
parseFollowSymlinks)
Parser Mode -> Parser Mode -> Parser Mode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> FilePath -> Parser Mode -> Parser Mode
forall a. FilePath -> FilePath -> Parser a -> Parser a
subcommand
"format"
"Standard code formatter for the Dhall language"
(Input -> OutputMode -> Mode
Format (Input -> OutputMode -> Mode)
-> Parser Input -> Parser (OutputMode -> Mode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Input
parseInplace Parser (OutputMode -> Mode) -> Parser OutputMode -> Parser Mode
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputMode
parseCheck)
Parser Mode -> Parser Mode -> Parser Mode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> FilePath -> Parser Mode -> Parser Mode
forall a. FilePath -> FilePath -> Parser a -> Parser a
subcommand
"freeze"
"Add integrity checks to remote import statements of an expression"
(Input -> Bool -> Bool -> OutputMode -> Mode
Freeze (Input -> Bool -> Bool -> OutputMode -> Mode)
-> Parser Input -> Parser (Bool -> Bool -> OutputMode -> Mode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Input
parseInplace Parser (Bool -> Bool -> OutputMode -> Mode)
-> Parser Bool -> Parser (Bool -> OutputMode -> Mode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
parseAllFlag Parser (Bool -> OutputMode -> Mode)
-> Parser Bool -> Parser (OutputMode -> Mode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
parseCacheFlag Parser (OutputMode -> Mode) -> Parser OutputMode -> Parser Mode
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputMode
parseCheck)
Parser Mode -> Parser Mode -> Parser Mode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> FilePath -> Parser Mode -> Parser Mode
forall a. FilePath -> FilePath -> Parser a -> Parser a
subcommand
"encode"
"Encode a Dhall expression to binary"
(Input -> Bool -> Mode
Encode (Input -> Bool -> Mode) -> Parser Input -> Parser (Bool -> Mode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Input
parseFile Parser (Bool -> Mode) -> Parser Bool -> Parser Mode
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
parseJSONFlag)
Parser Mode -> Parser Mode -> Parser Mode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> FilePath -> Parser Mode -> Parser Mode
forall a. FilePath -> FilePath -> Parser a -> Parser a
subcommand
"decode"
"Decode a Dhall expression from binary"
(Input -> Bool -> Mode
Decode (Input -> Bool -> Mode) -> Parser Input -> Parser (Bool -> Mode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Input
parseFile Parser (Bool -> Mode) -> Parser Bool -> Parser Mode
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
parseJSONFlag)
Parser Mode -> Parser Mode -> Parser Mode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> FilePath -> Parser Mode -> Parser Mode
forall a. FilePath -> FilePath -> Parser a -> Parser a
subcommand
"text"
"Render a Dhall expression that evaluates to a Text literal"
(Input -> Mode
Text (Input -> Mode) -> Parser Input -> Parser Mode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Input
parseFile)
Parser Mode -> Parser Mode -> Parser Mode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> FilePath -> Parser Mode -> Parser Mode
forall a. FilePath -> FilePath -> Parser a -> Parser a
subcommand
"to-directory-tree"
"Convert nested records of Text literals into a directory tree"
(Input -> FilePath -> Mode
DirectoryTree (Input -> FilePath -> Mode)
-> Parser Input -> Parser (FilePath -> Mode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Input
parseFile Parser (FilePath -> Mode) -> Parser FilePath -> Parser Mode
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath
parseDirectoryTreeOutput)
Parser Mode -> Parser Mode -> Parser Mode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> FilePath -> Parser Mode -> Parser Mode
forall a. FilePath -> FilePath -> Parser a -> Parser a
internalSubcommand
"haskell-syntax-tree"
"Output the parsed syntax tree (for debugging)"
(Input -> Mode
SyntaxTree (Input -> Mode) -> Parser Input -> Parser Mode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Input
parseFile)
Parser Mode -> Parser Mode -> Parser Mode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( Input
-> Output -> Bool -> Bool -> SemanticCacheMode -> Bool -> Mode
Default
(Input
-> Output -> Bool -> Bool -> SemanticCacheMode -> Bool -> Mode)
-> Parser Input
-> Parser
(Output -> Bool -> Bool -> SemanticCacheMode -> Bool -> Mode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Input
parseFile
Parser
(Output -> Bool -> Bool -> SemanticCacheMode -> Bool -> Mode)
-> Parser Output
-> Parser (Bool -> Bool -> SemanticCacheMode -> Bool -> Mode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Output
parseOutput
Parser (Bool -> Bool -> SemanticCacheMode -> Bool -> Mode)
-> Parser Bool
-> Parser (Bool -> SemanticCacheMode -> Bool -> Mode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
parseAnnotate
Parser (Bool -> SemanticCacheMode -> Bool -> Mode)
-> Parser Bool -> Parser (SemanticCacheMode -> Bool -> Mode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
parseAlpha
Parser (SemanticCacheMode -> Bool -> Mode)
-> Parser SemanticCacheMode -> Parser (Bool -> Mode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SemanticCacheMode
parseSemanticCacheMode
Parser (Bool -> Mode) -> Parser Bool -> Parser Mode
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
parseVersion
)
where
argument :: FilePath -> Parser Text
argument =
(FilePath -> Text) -> Parser FilePath -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
Data.Text.pack
(Parser FilePath -> Parser Text)
-> (FilePath -> Parser FilePath) -> FilePath -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
Options.Applicative.strArgument
(Mod ArgumentFields FilePath -> Parser FilePath)
-> (FilePath -> Mod ArgumentFields FilePath)
-> FilePath
-> Parser FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Options.Applicative.metavar
parseFile :: Parser Input
parseFile = (Maybe FilePath -> Input)
-> Parser (Maybe FilePath) -> Parser Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe FilePath -> Input
f (Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser FilePath
p)
where
f :: Maybe FilePath -> Input
f Nothing = Input
StandardInput
f (Just file :: FilePath
file) = FilePath -> Input
InputFile FilePath
file
p :: Parser FilePath
p = Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
Options.Applicative.strOption
( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long "file"
Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help "Read expression from a file instead of standard input"
Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Options.Applicative.metavar "FILE"
)
parseOutput :: Parser Output
parseOutput = (Maybe FilePath -> Output)
-> Parser (Maybe FilePath) -> Parser Output
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe FilePath -> Output
f (Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser FilePath
p)
where
f :: Maybe FilePath -> Output
f Nothing = Output
StandardOutput
f (Just file :: FilePath
file) = FilePath -> Output
OutputFile FilePath
file
p :: Parser FilePath
p = Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
Options.Applicative.strOption
( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long "output"
Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help "Write result to a file instead of standard output"
Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Options.Applicative.metavar "FILE"
)
parseAlpha :: Parser Bool
parseAlpha =
Mod FlagFields Bool -> Parser Bool
Options.Applicative.switch
( FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long "alpha"
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help "α-normalize expression"
)
parseAnnotate :: Parser Bool
parseAnnotate =
Mod FlagFields Bool -> Parser Bool
Options.Applicative.switch
( FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long "annotate"
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help "Add a type annotation to the output"
)
parseSemanticCacheMode :: Parser SemanticCacheMode
parseSemanticCacheMode =
SemanticCacheMode
-> SemanticCacheMode
-> Mod FlagFields SemanticCacheMode
-> Parser SemanticCacheMode
forall a. a -> a -> Mod FlagFields a -> Parser a
Options.Applicative.flag
SemanticCacheMode
UseSemanticCache
SemanticCacheMode
IgnoreSemanticCache
( FilePath -> Mod FlagFields SemanticCacheMode
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long "no-cache"
Mod FlagFields SemanticCacheMode
-> Mod FlagFields SemanticCacheMode
-> Mod FlagFields SemanticCacheMode
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields SemanticCacheMode
forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help
"Handle protected imports as if the cache was empty"
)
parseVersion :: Parser Bool
parseVersion =
Mod FlagFields Bool -> Parser Bool
Options.Applicative.switch
( FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long "version"
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help "Display version"
)
parseResolveMode :: Parser (Maybe ResolveMode)
parseResolveMode =
Maybe ResolveMode
-> Mod FlagFields (Maybe ResolveMode) -> Parser (Maybe ResolveMode)
forall a. a -> Mod FlagFields a -> Parser a
Options.Applicative.flag' (ResolveMode -> Maybe ResolveMode
forall a. a -> Maybe a
Just ResolveMode
Dot)
( FilePath -> Mod FlagFields (Maybe ResolveMode)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long "dot"
Mod FlagFields (Maybe ResolveMode)
-> Mod FlagFields (Maybe ResolveMode)
-> Mod FlagFields (Maybe ResolveMode)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields (Maybe ResolveMode)
forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help
"Output import dependency graph in dot format"
)
Parser (Maybe ResolveMode)
-> Parser (Maybe ResolveMode) -> Parser (Maybe ResolveMode)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Maybe ResolveMode
-> Mod FlagFields (Maybe ResolveMode) -> Parser (Maybe ResolveMode)
forall a. a -> Mod FlagFields a -> Parser a
Options.Applicative.flag' (ResolveMode -> Maybe ResolveMode
forall a. a -> Maybe a
Just ResolveMode
ListImmediateDependencies)
( FilePath -> Mod FlagFields (Maybe ResolveMode)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long "immediate-dependencies"
Mod FlagFields (Maybe ResolveMode)
-> Mod FlagFields (Maybe ResolveMode)
-> Mod FlagFields (Maybe ResolveMode)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields (Maybe ResolveMode)
forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help
"List immediate import dependencies"
)
Parser (Maybe ResolveMode)
-> Parser (Maybe ResolveMode) -> Parser (Maybe ResolveMode)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Maybe ResolveMode
-> Mod FlagFields (Maybe ResolveMode) -> Parser (Maybe ResolveMode)
forall a. a -> Mod FlagFields a -> Parser a
Options.Applicative.flag' (ResolveMode -> Maybe ResolveMode
forall a. a -> Maybe a
Just ResolveMode
ListTransitiveDependencies)
( FilePath -> Mod FlagFields (Maybe ResolveMode)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long "transitive-dependencies"
Mod FlagFields (Maybe ResolveMode)
-> Mod FlagFields (Maybe ResolveMode)
-> Mod FlagFields (Maybe ResolveMode)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields (Maybe ResolveMode)
forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help
"List transitive import dependencies in post-order"
)
Parser (Maybe ResolveMode)
-> Parser (Maybe ResolveMode) -> Parser (Maybe ResolveMode)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe ResolveMode -> Parser (Maybe ResolveMode)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ResolveMode
forall a. Maybe a
Nothing
parseQuiet :: Parser Bool
parseQuiet =
Mod FlagFields Bool -> Parser Bool
Options.Applicative.switch
( FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long "quiet"
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help "Don't print the inferred type"
)
parseInplace :: Parser Input
parseInplace = (Maybe FilePath -> Input)
-> Parser (Maybe FilePath) -> Parser Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe FilePath -> Input
f (Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser FilePath
p)
where
f :: Maybe FilePath -> Input
f Nothing = Input
StandardInput
f (Just file :: FilePath
file) = FilePath -> Input
InputFile FilePath
file
p :: Parser FilePath
p = Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
Options.Applicative.strOption
( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long "inplace"
Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help "Modify the specified file in-place"
Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Options.Applicative.metavar "FILE"
)
parseInput :: Parser Input
parseInput = (Maybe FilePath -> Input)
-> Parser (Maybe FilePath) -> Parser Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe FilePath -> Input
f (Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser FilePath
p)
where
f :: Maybe FilePath -> Input
f Nothing = Input
StandardInput
f (Just path :: FilePath
path) = FilePath -> Input
InputFile FilePath
path
p :: Parser FilePath
p = Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
Options.Applicative.strOption
( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long "path"
Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help "Index all files in path recursively. Will get list of files from STDIN if omitted."
Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Options.Applicative.metavar "PATH"
)
parseTagsOutput :: Parser Output
parseTagsOutput = (Maybe FilePath -> Output)
-> Parser (Maybe FilePath) -> Parser Output
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe FilePath -> Output
f (Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser FilePath
p)
where
f :: Maybe FilePath -> Output
f Nothing = FilePath -> Output
OutputFile "tags"
f (Just file :: FilePath
file) = FilePath -> Output
OutputFile FilePath
file
p :: Parser FilePath
p = Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
Options.Applicative.strOption
( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long "output"
Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help "The name of the file that the tags are written to. Defaults to \"tags\""
Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Options.Applicative.metavar "FILENAME"
)
parseSuffixes :: Parser (Maybe [Text])
parseSuffixes = (Maybe Text -> Maybe [Text])
-> Parser (Maybe Text) -> Parser (Maybe [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Text -> Maybe [Text]
f (Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text
p)
where
f :: Maybe Text -> Maybe [Text]
f Nothing = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [".dhall"]
f (Just "") = Maybe [Text]
forall a. Maybe a
Nothing
f (Just line :: Text
line) = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just (Text -> Text -> [Text]
Data.Text.splitOn " " Text
line)
p :: Parser Text
p = Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
Options.Applicative.strOption
( FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long "suffixes"
Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help "Index only files with suffixes. \"\" to index all files."
Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Options.Applicative.metavar "SUFFIXES"
)
parseFollowSymlinks :: Parser Bool
parseFollowSymlinks =
Mod FlagFields Bool -> Parser Bool
Options.Applicative.switch
( FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long "follow-symlinks"
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help "Follow symlinks when recursing directories"
)
parseJSONFlag :: Parser Bool
parseJSONFlag =
Mod FlagFields Bool -> Parser Bool
Options.Applicative.switch
( FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long "json"
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help "Use JSON representation of CBOR"
)
parseAllFlag :: Parser Bool
parseAllFlag =
Mod FlagFields Bool -> Parser Bool
Options.Applicative.switch
( FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long "all"
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help "Add integrity checks to all imports (not just remote imports)"
)
parseCacheFlag :: Parser Bool
parseCacheFlag =
Mod FlagFields Bool -> Parser Bool
Options.Applicative.switch
( FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long "cache"
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help "Add fallback unprotected imports when using integrity checks purely for caching purposes"
)
parseCheck :: Parser OutputMode
parseCheck = (Bool -> OutputMode) -> Parser Bool -> Parser OutputMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> OutputMode
adapt Parser Bool
switch
where
adapt :: Bool -> OutputMode
adapt True = OutputMode
Check
adapt False = OutputMode
Write
switch :: Parser Bool
switch =
Mod FlagFields Bool -> Parser Bool
Options.Applicative.switch
( FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long "check"
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help "Only check if the input is formatted"
)
parseDirectoryTreeOutput :: Parser FilePath
parseDirectoryTreeOutput =
Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
Options.Applicative.strOption
( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long "output"
Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help "The destination path to create"
Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Options.Applicative.metavar "PATH"
)
parserInfoOptions :: ParserInfo Options
parserInfoOptions :: ParserInfo Options
parserInfoOptions =
Parser Options -> InfoMod Options -> ParserInfo Options
forall a. Parser a -> InfoMod a -> ParserInfo a
Options.Applicative.info
(Parser (Options -> Options)
forall a. Parser (a -> a)
Options.Applicative.helper Parser (Options -> Options) -> Parser Options -> Parser Options
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Options
parseOptions)
( FilePath -> InfoMod Options
forall a. FilePath -> InfoMod a
Options.Applicative.progDesc "Interpreter for the Dhall language"
InfoMod Options -> InfoMod Options -> InfoMod Options
forall a. Semigroup a => a -> a -> a
<> InfoMod Options
forall a. InfoMod a
Options.Applicative.fullDesc
)
noHeaders :: Import -> Import
(Import { importHashed :: Import -> ImportHashed
importHashed = ImportHashed { importType :: ImportHashed -> ImportType
importType = Remote URL{ .. }, ..}, .. }) =
Import :: ImportHashed -> ImportMode -> Import
Import { importHashed :: ImportHashed
importHashed = ImportHashed :: Maybe SHA256Digest -> ImportType -> ImportHashed
ImportHashed { importType :: ImportType
importType = URL -> ImportType
Remote URL :: Scheme
-> Text -> File -> Maybe Text -> Maybe (Expr Src Import) -> URL
URL{ headers :: Maybe (Expr Src Import)
headers = Maybe (Expr Src Import)
forall a. Maybe a
Nothing, .. }, .. }, .. }
noHeaders i :: Import
i =
Import
i
command :: Options -> IO ()
command :: Options -> IO ()
command (Options {..}) = do
let characterSet :: CharacterSet
characterSet = case Bool
ascii of
True -> CharacterSet
ASCII
False -> CharacterSet
Unicode
TextEncoding -> IO ()
GHC.IO.Encoding.setLocaleEncoding TextEncoding
System.IO.utf8
let rootDirectory :: Input -> FilePath
rootDirectory = \case
InputFile f :: FilePath
f -> FilePath -> FilePath
System.FilePath.takeDirectory FilePath
f
StandardInput -> "."
let toStatus :: Input -> Status
toStatus = FilePath -> Status
Dhall.Import.emptyStatus (FilePath -> Status) -> (Input -> FilePath) -> Input -> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input -> FilePath
rootDirectory
let getExpression :: Input -> IO (Expr Src Import)
getExpression = Censor -> Input -> IO (Expr Src Import)
Dhall.Util.getExpression Censor
censor
let getExpressionAndHeader :: Input -> IO (Header, Expr Src Import)
getExpressionAndHeader = Censor -> Input -> IO (Header, Expr Src Import)
Dhall.Util.getExpressionAndHeader Censor
censor
let handle :: IO a -> IO a
handle io :: IO a
io =
IO a -> [Handler a] -> IO a
forall a. IO a -> [Handler a] -> IO a
Control.Exception.catches IO a
io
[ (TypeError Src X -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler TypeError Src X -> IO a
forall a. TypeError Src X -> IO a
handleTypeError
, (Imported (TypeError Src X) -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler Imported (TypeError Src X) -> IO a
forall a. Imported (TypeError Src X) -> IO a
handleImported
, (ExitCode -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ExitCode -> IO a
forall a. ExitCode -> IO a
handleExitCode
]
where
handleAll :: SomeException -> IO b
handleAll e :: SomeException
e = do
let string :: FilePath
string = SomeException -> FilePath
forall a. Show a => a -> FilePath
show (SomeException
e :: SomeException)
if Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
string)
then Handle -> FilePath -> IO ()
System.IO.hPutStrLn Handle
System.IO.stderr FilePath
string
else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
IO b
forall a. IO a
System.Exit.exitFailure
handleTypeError :: TypeError Src X -> IO a
handleTypeError e :: TypeError Src X
e = (SomeException -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
Control.Exception.handle SomeException -> IO a
forall b. SomeException -> IO b
handleAll (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
let TypeError Src X
_ = TypeError Src X
e :: TypeError Src Void
Handle -> FilePath -> IO ()
System.IO.hPutStrLn Handle
System.IO.stderr ""
if Bool
explain
then
case Censor
censor of
Censor -> Censored -> IO a
forall e a. Exception e => e -> IO a
Control.Exception.throwIO (DetailedTypeError Src X -> Censored
CensoredDetailed (TypeError Src X -> DetailedTypeError Src X
forall s a. TypeError s a -> DetailedTypeError s a
DetailedTypeError TypeError Src X
e))
NoCensor -> DetailedTypeError Src X -> IO a
forall e a. Exception e => e -> IO a
Control.Exception.throwIO (TypeError Src X -> DetailedTypeError Src X
forall s a. TypeError s a -> DetailedTypeError s a
DetailedTypeError TypeError Src X
e)
else do
Handle -> Text -> IO ()
Data.Text.IO.hPutStrLn Handle
System.IO.stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m"
case Censor
censor of
Censor -> Censored -> IO a
forall e a. Exception e => e -> IO a
Control.Exception.throwIO (TypeError Src X -> Censored
Censored TypeError Src X
e)
NoCensor -> TypeError Src X -> IO a
forall e a. Exception e => e -> IO a
Control.Exception.throwIO TypeError Src X
e
handleImported :: Imported (TypeError Src X) -> IO a
handleImported (Imported ps :: NonEmpty Chained
ps e :: TypeError Src X
e) = (SomeException -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
Control.Exception.handle SomeException -> IO a
forall b. SomeException -> IO b
handleAll (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
let TypeError Src X
_ = TypeError Src X
e :: TypeError Src Void
Handle -> FilePath -> IO ()
System.IO.hPutStrLn Handle
System.IO.stderr ""
if Bool
explain
then Imported (DetailedTypeError Src X) -> IO a
forall e a. Exception e => e -> IO a
Control.Exception.throwIO (NonEmpty Chained
-> DetailedTypeError Src X -> Imported (DetailedTypeError Src X)
forall e. NonEmpty Chained -> e -> Imported e
Imported NonEmpty Chained
ps (TypeError Src X -> DetailedTypeError Src X
forall s a. TypeError s a -> DetailedTypeError s a
DetailedTypeError TypeError Src X
e))
else do
Handle -> Text -> IO ()
Data.Text.IO.hPutStrLn Handle
System.IO.stderr "\ESC[2mUse \"dhall --explain\" for detailed errors\ESC[0m"
Imported (TypeError Src X) -> IO a
forall e a. Exception e => e -> IO a
Control.Exception.throwIO (NonEmpty Chained -> TypeError Src X -> Imported (TypeError Src X)
forall e. NonEmpty Chained -> e -> Imported e
Imported NonEmpty Chained
ps TypeError Src X
e)
handleExitCode :: ExitCode -> IO a
handleExitCode e :: ExitCode
e = do
ExitCode -> IO a
forall e a. Exception e => e -> IO a
Control.Exception.throwIO (ExitCode
e :: ExitCode)
let renderDoc :: Handle -> Doc Ann -> IO ()
renderDoc :: Handle -> Doc Ann -> IO ()
renderDoc h :: Handle
h doc :: Doc Ann
doc = do
let stream :: SimpleDocStream Ann
stream = Doc Ann -> SimpleDocStream Ann
forall ann. Doc ann -> SimpleDocStream ann
Dhall.Pretty.layout Doc Ann
doc
Bool
supportsANSI <- Handle -> IO Bool
System.Console.ANSI.hSupportsANSI Handle
h
let ansiStream :: SimpleDocStream AnsiStyle
ansiStream =
if Bool
supportsANSI Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
plain
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
stream
else SimpleDocStream Ann -> SimpleDocStream AnsiStyle
forall ann xxx. SimpleDocStream ann -> SimpleDocStream xxx
Pretty.unAnnotateS SimpleDocStream Ann
stream
Handle -> SimpleDocStream AnsiStyle -> IO ()
Pretty.renderIO Handle
h SimpleDocStream AnsiStyle
ansiStream
Handle -> Text -> IO ()
Data.Text.IO.hPutStrLn Handle
h ""
let render :: Pretty a => Handle -> Expr Src a -> IO ()
render :: Handle -> Expr Src a -> IO ()
render h :: Handle
h expression :: Expr Src a
expression = do
let doc :: Doc Ann
doc = CharacterSet -> Expr Src a -> Doc Ann
forall a. Pretty a => CharacterSet -> Expr Src a -> Doc Ann
Dhall.Pretty.prettyCharacterSet CharacterSet
characterSet Expr Src a
expression
Handle -> Doc Ann -> IO ()
renderDoc Handle
h Doc Ann
doc
let writeDocToFile :: FilePath -> Doc ann -> IO ()
writeDocToFile :: FilePath -> Doc ann -> IO ()
writeDocToFile file :: FilePath
file doc :: Doc ann
doc = do
let stream :: SimpleDocStream ann
stream = Doc ann -> SimpleDocStream ann
forall ann. Doc ann -> SimpleDocStream ann
Dhall.Pretty.layout (Doc ann
doc Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> "\n")
FilePath -> Text -> IO ()
AtomicWrite.LazyText.atomicWriteFile FilePath
file (SimpleDocStream ann -> Text
forall ann. SimpleDocStream ann -> Text
Pretty.Text.renderLazy SimpleDocStream ann
stream)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Mode -> Bool
ignoreSemanticCache Mode
mode) IO ()
forall (m :: * -> *).
(MonadCatch m, Alternative m, MonadIO m) =>
m ()
Dhall.Import.warnAboutMissingCaches
IO () -> IO ()
forall a. IO a -> IO a
handle (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ case Mode
mode of
Version -> do
FilePath -> IO ()
putStrLn FilePath
dhallVersionString
Default {..} -> do
if Bool
version
then do
FilePath -> IO ()
putStrLn FilePath
dhallVersionString
IO ()
forall a. IO a
Exit.exitSuccess
else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Expr Src Import
expression <- Input -> IO (Expr Src Import)
getExpression Input
file
Expr Src X
resolvedExpression <-
FilePath -> SemanticCacheMode -> Expr Src Import -> IO (Expr Src X)
Dhall.Import.loadRelativeTo (Input -> FilePath
rootDirectory Input
file) SemanticCacheMode
semanticCacheMode Expr Src Import
expression
Expr Src X
inferredType <- Either (TypeError Src X) (Expr Src X) -> IO (Expr Src X)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Dhall.Core.throws (Expr Src X -> Either (TypeError Src X) (Expr Src X)
forall s. Expr s X -> Either (TypeError s X) (Expr s X)
Dhall.TypeCheck.typeOf Expr Src X
resolvedExpression)
let normalizedExpression :: Expr t X
normalizedExpression = Expr Src X -> Expr t X
forall a s t. Eq a => Expr s a -> Expr t a
Dhall.Core.normalize Expr Src X
resolvedExpression
let alphaNormalizedExpression :: Expr s X
alphaNormalizedExpression =
if Bool
alpha
then Expr s X -> Expr s X
forall s a. Expr s a -> Expr s a
Dhall.Core.alphaNormalize Expr s X
forall t. Expr t X
normalizedExpression
else Expr s X
forall t. Expr t X
normalizedExpression
let annotatedExpression :: Expr Src X
annotatedExpression =
if Bool
annotate
then Expr Src X -> Expr Src X -> Expr Src X
forall s a. Expr s a -> Expr s a -> Expr s a
Annot Expr Src X
forall t. Expr t X
alphaNormalizedExpression Expr Src X
inferredType
else Expr Src X
forall t. Expr t X
alphaNormalizedExpression
case Output
output of
StandardOutput -> Handle -> Expr Src X -> IO ()
forall a. Pretty a => Handle -> Expr Src a -> IO ()
render Handle
System.IO.stdout Expr Src X
annotatedExpression
OutputFile file_ :: FilePath
file_ ->
FilePath -> Doc Ann -> IO ()
forall ann. FilePath -> Doc ann -> IO ()
writeDocToFile
FilePath
file_
(CharacterSet -> Expr Src X -> Doc Ann
forall a. Pretty a => CharacterSet -> Expr Src a -> Doc Ann
Dhall.Pretty.prettyCharacterSet CharacterSet
characterSet Expr Src X
annotatedExpression)
Resolve { resolveMode :: Mode -> Maybe ResolveMode
resolveMode = Just Dot, ..} -> do
Expr Src Import
expression <- Input -> IO (Expr Src Import)
getExpression Input
file
(Dhall.Import.Types.Status { [Depends]
_graph :: Status -> [Depends]
_graph :: [Depends]
_graph, NonEmpty Chained
_stack :: Status -> NonEmpty Chained
_stack :: NonEmpty Chained
_stack }) <-
StateT Status IO (Expr Src X) -> Status -> IO Status
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
State.execStateT (Expr Src Import -> StateT Status IO (Expr Src X)
Dhall.Import.loadWith Expr Src Import
expression) (Input -> Status
toStatus Input
file) { _semanticCacheMode :: SemanticCacheMode
_semanticCacheMode = SemanticCacheMode
semanticCacheMode }
let (rootImport :: Chained
rootImport :| _) = NonEmpty Chained
_stack
imports :: [Chained]
imports = Chained
rootImport Chained -> [Chained] -> [Chained]
forall a. a -> [a] -> [a]
: (Depends -> Chained) -> [Depends] -> [Chained]
forall a b. (a -> b) -> [a] -> [b]
map Depends -> Chained
parent [Depends]
_graph [Chained] -> [Chained] -> [Chained]
forall a. [a] -> [a] -> [a]
++ (Depends -> Chained) -> [Depends] -> [Chained]
forall a b. (a -> b) -> [a] -> [b]
map Depends -> Chained
child [Depends]
_graph
importIds :: Map Chained NodeId
importIds = [(Chained, NodeId)] -> Map Chained NodeId
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList ([Chained] -> [NodeId] -> [(Chained, NodeId)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Chained]
imports [Int -> NodeId
Text.Dot.userNodeId Int
i | Int
i <- [0..]])
let dotNode :: (Chained, NodeId) -> Dot ()
dotNode (i :: Chained
i, nodeId :: NodeId
nodeId) =
NodeId -> [(FilePath, FilePath)] -> Dot ()
Text.Dot.userNode
NodeId
nodeId
[ ("label", Text -> FilePath
Data.Text.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Import -> Text
forall a. Pretty a => a -> Text
pretty (Chained -> Import
convert Chained
i))
, ("shape", "box")
, ("style", "rounded")
]
where
convert :: Chained -> Import
convert = Import -> Import
noHeaders (Import -> Import) -> (Chained -> Import) -> Chained -> Import
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chained -> Import
Dhall.Import.chainedImport
let dotEdge :: Depends -> Dot ()
dotEdge (Depends parent :: Chained
parent child :: Chained
child) =
case (Chained -> Map Chained NodeId -> Maybe NodeId
forall k a. Ord k => k -> Map k a -> Maybe a
Data.Map.lookup Chained
parent Map Chained NodeId
importIds, Chained -> Map Chained NodeId -> Maybe NodeId
forall k a. Ord k => k -> Map k a -> Maybe a
Data.Map.lookup Chained
child Map Chained NodeId
importIds) of
(Just from :: NodeId
from, Just to :: NodeId
to) -> NodeId
from NodeId -> NodeId -> Dot ()
.->. NodeId
to
_ -> () -> Dot ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
let dot :: Dot ()
dot = do (FilePath, FilePath) -> Dot ()
Text.Dot.attribute ("rankdir", "LR")
((Chained, NodeId) -> Dot ()) -> [(Chained, NodeId)] -> Dot ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Chained, NodeId) -> Dot ()
dotNode (Map Chained NodeId -> [(Chained, NodeId)]
forall k a. Map k a -> [(k, a)]
Data.Map.assocs Map Chained NodeId
importIds)
(Depends -> Dot ()) -> [Depends] -> Dot ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Depends -> Dot ()
dotEdge [Depends]
_graph
FilePath -> IO ()
putStr (FilePath -> IO ()) -> (Dot () -> FilePath) -> Dot () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("strict " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> FilePath)
-> (Dot () -> FilePath) -> Dot () -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dot () -> FilePath
forall a. Dot a -> FilePath
Text.Dot.showDot (Dot () -> IO ()) -> Dot () -> IO ()
forall a b. (a -> b) -> a -> b
$ Dot ()
dot
Resolve { resolveMode :: Mode -> Maybe ResolveMode
resolveMode = Just ListImmediateDependencies, ..} -> do
Expr Src Import
expression <- Input -> IO (Expr Src Import)
getExpression Input
file
(Import -> IO ()) -> Expr Src Import -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Doc Any -> IO ()
forall a. Show a => a -> IO ()
print (Doc Any -> IO ()) -> (Import -> Doc Any) -> Import -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Import -> Doc Any
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (Import -> Doc Any) -> (Import -> Import) -> Import -> Doc Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Import -> Import
noHeaders) Expr Src Import
expression
Resolve { resolveMode :: Mode -> Maybe ResolveMode
resolveMode = Just ListTransitiveDependencies, ..} -> do
Expr Src Import
expression <- Input -> IO (Expr Src Import)
getExpression Input
file
(Dhall.Import.Types.Status { Map Chained ImportSemantics
_cache :: Status -> Map Chained ImportSemantics
_cache :: Map Chained ImportSemantics
_cache }) <-
StateT Status IO (Expr Src X) -> Status -> IO Status
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
State.execStateT (Expr Src Import -> StateT Status IO (Expr Src X)
Dhall.Import.loadWith Expr Src Import
expression) (Input -> Status
toStatus Input
file) { _semanticCacheMode :: SemanticCacheMode
_semanticCacheMode = SemanticCacheMode
semanticCacheMode }
(Doc Any -> IO ()) -> [Doc Any] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Doc Any -> IO ()
forall a. Show a => a -> IO ()
print
([Doc Any] -> IO ())
-> (Map Chained ImportSemantics -> [Doc Any])
-> Map Chained ImportSemantics
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chained -> Doc Any) -> [Chained] -> [Doc Any]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( Import -> Doc Any
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty
(Import -> Doc Any) -> (Chained -> Import) -> Chained -> Doc Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Import -> Import
noHeaders
(Import -> Import) -> (Chained -> Import) -> Chained -> Import
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chained -> Import
Dhall.Import.chainedImport
)
([Chained] -> [Doc Any])
-> (Map Chained ImportSemantics -> [Chained])
-> Map Chained ImportSemantics
-> [Doc Any]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Chained] -> [Chained]
forall a. [a] -> [a]
reverse
([Chained] -> [Chained])
-> (Map Chained ImportSemantics -> [Chained])
-> Map Chained ImportSemantics
-> [Chained]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Chained ImportSemantics -> [Chained]
forall k v. Map k v -> [k]
Dhall.Map.keys
(Map Chained ImportSemantics -> IO ())
-> Map Chained ImportSemantics -> IO ()
forall a b. (a -> b) -> a -> b
$ Map Chained ImportSemantics
_cache
Resolve { resolveMode :: Mode -> Maybe ResolveMode
resolveMode = Maybe ResolveMode
Nothing, ..} -> do
Expr Src Import
expression <- Input -> IO (Expr Src Import)
getExpression Input
file
Expr Src X
resolvedExpression <-
FilePath -> SemanticCacheMode -> Expr Src Import -> IO (Expr Src X)
Dhall.Import.loadRelativeTo (Input -> FilePath
rootDirectory Input
file) SemanticCacheMode
semanticCacheMode Expr Src Import
expression
Handle -> Expr Src X -> IO ()
forall a. Pretty a => Handle -> Expr Src a -> IO ()
render Handle
System.IO.stdout Expr Src X
resolvedExpression
Normalize {..} -> do
Expr Src Import
expression <- Input -> IO (Expr Src Import)
getExpression Input
file
Expr Src X
resolvedExpression <- Expr Src Import -> IO (Expr Src X)
forall (io :: * -> *).
MonadIO io =>
Expr Src Import -> io (Expr Src X)
Dhall.Import.assertNoImports Expr Src Import
expression
Expr Src X
_ <- Either (TypeError Src X) (Expr Src X) -> IO (Expr Src X)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Dhall.Core.throws (Expr Src X -> Either (TypeError Src X) (Expr Src X)
forall s. Expr s X -> Either (TypeError s X) (Expr s X)
Dhall.TypeCheck.typeOf Expr Src X
resolvedExpression)
let normalizedExpression :: Expr t X
normalizedExpression = Expr Src X -> Expr t X
forall a s t. Eq a => Expr s a -> Expr t a
Dhall.Core.normalize Expr Src X
resolvedExpression
let alphaNormalizedExpression :: Expr s X
alphaNormalizedExpression =
if Bool
alpha
then Expr s X -> Expr s X
forall s a. Expr s a -> Expr s a
Dhall.Core.alphaNormalize Expr s X
forall t. Expr t X
normalizedExpression
else Expr s X
forall t. Expr t X
normalizedExpression
Handle -> Expr Src X -> IO ()
forall a. Pretty a => Handle -> Expr Src a -> IO ()
render Handle
System.IO.stdout Expr Src X
forall t. Expr t X
alphaNormalizedExpression
Type {..} -> do
Expr Src Import
expression <- Input -> IO (Expr Src Import)
getExpression Input
file
Expr Src X
resolvedExpression <-
FilePath -> SemanticCacheMode -> Expr Src Import -> IO (Expr Src X)
Dhall.Import.loadRelativeTo (Input -> FilePath
rootDirectory Input
file) SemanticCacheMode
semanticCacheMode Expr Src Import
expression
Expr Src X
inferredType <- Either (TypeError Src X) (Expr Src X) -> IO (Expr Src X)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Dhall.Core.throws (Expr Src X -> Either (TypeError Src X) (Expr Src X)
forall s. Expr s X -> Either (TypeError s X) (Expr s X)
Dhall.TypeCheck.typeOf Expr Src X
resolvedExpression)
if Bool
quiet
then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else Handle -> Expr Src X -> IO ()
forall a. Pretty a => Handle -> Expr Src a -> IO ()
render Handle
System.IO.stdout Expr Src X
inferredType
Repl -> do
CharacterSet -> Bool -> IO ()
Dhall.Repl.repl CharacterSet
characterSet Bool
explain
Diff {..} -> do
Expr Src X
expression1 <- Text -> IO (Expr Src X)
Dhall.inputExpr Text
expr1
Expr Src X
expression2 <- Text -> IO (Expr Src X)
Dhall.inputExpr Text
expr2
let diff :: Diff
diff = Expr Src X -> Expr Src X -> Diff
forall a s. (Eq a, Pretty a) => Expr s a -> Expr s a -> Diff
Dhall.Diff.diffNormalized Expr Src X
expression1 Expr Src X
expression2
Handle -> Doc Ann -> IO ()
renderDoc Handle
System.IO.stdout (Diff -> Doc Ann
Dhall.Diff.doc Diff
diff)
if Diff -> Bool
Dhall.Diff.same Diff
diff
then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else IO ()
forall a. IO a
Exit.exitFailure
Format {..} -> do
Format -> IO ()
Dhall.Format.format (Format :: CharacterSet -> Censor -> Input -> OutputMode -> Format
Dhall.Format.Format {..})
Freeze {..} -> do
let scope :: Scope
scope = if Bool
all_ then Scope
AllImports else Scope
OnlyRemoteImports
let intent :: Intent
intent = if Bool
cache then Intent
Cache else Intent
Secure
OutputMode
-> Input -> Scope -> Intent -> CharacterSet -> Censor -> IO ()
Dhall.Freeze.freeze OutputMode
outputMode Input
input Scope
scope Intent
intent CharacterSet
characterSet Censor
censor
Hash {..} -> do
Expr Src Import
expression <- Input -> IO (Expr Src Import)
getExpression Input
file
Expr Src X
resolvedExpression <-
FilePath -> SemanticCacheMode -> Expr Src Import -> IO (Expr Src X)
Dhall.Import.loadRelativeTo (Input -> FilePath
rootDirectory Input
file) SemanticCacheMode
UseSemanticCache Expr Src Import
expression
Expr Src X
_ <- Either (TypeError Src X) (Expr Src X) -> IO (Expr Src X)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Dhall.Core.throws (Expr Src X -> Either (TypeError Src X) (Expr Src X)
forall s. Expr s X -> Either (TypeError s X) (Expr s X)
Dhall.TypeCheck.typeOf Expr Src X
resolvedExpression)
let normalizedExpression :: Expr s X
normalizedExpression =
Expr s X -> Expr s X
forall s a. Expr s a -> Expr s a
Dhall.Core.alphaNormalize (Expr Src X -> Expr s X
forall a s t. Eq a => Expr s a -> Expr t a
Dhall.Core.normalize Expr Src X
resolvedExpression)
Text -> IO ()
Data.Text.IO.putStrLn (Expr X X -> Text
Dhall.Import.hashExpressionToCode Expr X X
forall t. Expr t X
normalizedExpression)
Lint {..} -> do
case OutputMode
outputMode of
Write -> do
(Header header :: Text
header, expression :: Expr Src Import
expression) <- do
Input -> IO (Header, Expr Src Import)
getExpressionAndHeader Input
input
let lintedExpression :: Expr Src Import
lintedExpression = Expr Src Import -> Expr Src Import
forall s. Expr s Import -> Expr s Import
Dhall.Lint.lint Expr Src Import
expression
let doc :: Doc Ann
doc = 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 Import -> Doc Ann
forall a. Pretty a => CharacterSet -> Expr Src a -> Doc Ann
Dhall.Pretty.prettyCharacterSet CharacterSet
characterSet Expr Src Import
lintedExpression
case Input
input of
InputFile file :: FilePath
file -> FilePath -> Doc Ann -> IO ()
forall ann. FilePath -> Doc ann -> IO ()
writeDocToFile FilePath
file Doc Ann
doc
StandardInput -> Handle -> Doc Ann -> IO ()
renderDoc Handle
System.IO.stdout Doc Ann
doc
Check -> do
Text
originalText <- case Input
input of
InputFile file :: FilePath
file -> FilePath -> IO Text
Data.Text.IO.readFile FilePath
file
StandardInput -> IO Text
Data.Text.IO.getContents
let name :: FilePath
name = case Input
input of
InputFile file :: FilePath
file -> FilePath
file
StandardInput -> "(stdin)"
(Header header :: Text
header, expression :: Expr Src Import
expression) <- do
Either ParseError (Header, Expr Src Import)
-> IO (Header, Expr Src Import)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Dhall.Core.throws ((ParseError -> ParseError)
-> Either ParseError (Header, Expr Src Import)
-> Either ParseError (Header, Expr Src Import)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseError -> ParseError
Parser.censor (FilePath -> Text -> Either ParseError (Header, Expr Src Import)
Parser.exprAndHeaderFromText FilePath
name Text
originalText))
let lintedExpression :: Expr Src Import
lintedExpression = Expr Src Import -> Expr Src Import
forall s. Expr s Import -> Expr s Import
Dhall.Lint.lint Expr Src Import
expression
let doc :: Doc Ann
doc = 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 Import -> Doc Ann
forall a. Pretty a => CharacterSet -> Expr Src a -> Doc Ann
Dhall.Pretty.prettyCharacterSet CharacterSet
characterSet Expr Src Import
lintedExpression
let stream :: SimpleDocStream Ann
stream = Doc Ann -> SimpleDocStream Ann
forall ann. Doc ann -> SimpleDocStream ann
Dhall.Pretty.layout Doc Ann
doc
let modifiedText :: Text
modifiedText = SimpleDocStream Ann -> Text
forall ann. SimpleDocStream ann -> Text
Pretty.Text.renderStrict SimpleDocStream Ann
stream Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n"
if Text
originalText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
modifiedText
then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
let modified :: Text
modified = "linted"
CheckFailed -> IO ()
forall e a. Exception e => e -> IO a
Control.Exception.throwIO CheckFailed :: Text -> Text -> CheckFailed
CheckFailed{ command :: Text
command = "lint", ..}
Encode {..} -> do
Expr Src Import
expression <- Input -> IO (Expr Src Import)
getExpression Input
file
let bytes :: ByteString
bytes = Expr X Import -> ByteString
Dhall.Binary.encodeExpression (Expr Src Import -> Expr X Import
forall s a t. Expr s a -> Expr t a
Dhall.Core.denote Expr Src Import
expression)
if Bool
json
then do
let decoder :: Decoder s Value
decoder = Bool -> Decoder s Value
forall s. Bool -> Decoder s Value
Codec.CBOR.JSON.decodeValue Bool
False
(_, value :: Value
value) <- Either DeserialiseFailure (ByteString, Value)
-> IO (ByteString, Value)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Dhall.Core.throws ((forall s. Decoder s Value)
-> ByteString -> Either DeserialiseFailure (ByteString, Value)
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
Codec.CBOR.Read.deserialiseFromBytes forall s. Decoder s Value
decoder ByteString
bytes)
let jsonBytes :: ByteString
jsonBytes = Value -> ByteString
forall a. ToJSON a => a -> ByteString
Data.Aeson.Encode.Pretty.encodePretty Value
value
ByteString -> IO ()
Data.ByteString.Lazy.Char8.putStrLn ByteString
jsonBytes
else do
ByteString -> IO ()
Data.ByteString.Lazy.putStr ByteString
bytes
Decode {..} -> do
ByteString
bytes <- do
case Input
file of
InputFile f :: FilePath
f -> FilePath -> IO ByteString
Data.ByteString.Lazy.readFile FilePath
f
StandardInput -> IO ByteString
Data.ByteString.Lazy.getContents
Expr X Import
expression <- do
if Bool
json
then do
Value
value <- case ByteString -> Either FilePath Value
forall a. FromJSON a => ByteString -> Either FilePath a
Data.Aeson.eitherDecode' ByteString
bytes of
Left string :: FilePath
string -> FilePath -> IO Value
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
string
Right value :: Value
value -> Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
value
let encoding :: Encoding
encoding = Value -> Encoding
Codec.CBOR.JSON.encodeValue Value
value
let cborgBytes :: ByteString
cborgBytes = Encoding -> ByteString
Codec.CBOR.Write.toLazyByteString Encoding
encoding
Either DecodingFailure (Expr X Import) -> IO (Expr X Import)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Dhall.Core.throws (ByteString -> Either DecodingFailure (Expr X Import)
forall s a.
Serialise (Expr s a) =>
ByteString -> Either DecodingFailure (Expr s a)
Dhall.Binary.decodeExpression ByteString
cborgBytes)
else do
Either DecodingFailure (Expr X Import) -> IO (Expr X Import)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Dhall.Core.throws (ByteString -> Either DecodingFailure (Expr X Import)
forall s a.
Serialise (Expr s a) =>
ByteString -> Either DecodingFailure (Expr s a)
Dhall.Binary.decodeExpression ByteString
bytes)
let doc :: Doc Ann
doc = CharacterSet -> Expr Src Import -> Doc Ann
forall a. Pretty a => CharacterSet -> Expr Src a -> Doc Ann
Dhall.Pretty.prettyCharacterSet CharacterSet
characterSet (Expr X Import -> Expr Src Import
forall a s. Expr X a -> Expr s a
Dhall.Core.renote Expr X Import
expression :: Expr Src Import)
Handle -> Doc Ann -> IO ()
renderDoc Handle
System.IO.stdout Doc Ann
doc
Text {..} -> do
Expr Src Import
expression <- Input -> IO (Expr Src Import)
getExpression Input
file
Expr Src X
resolvedExpression <-
FilePath -> SemanticCacheMode -> Expr Src Import -> IO (Expr Src X)
Dhall.Import.loadRelativeTo (Input -> FilePath
rootDirectory Input
file) SemanticCacheMode
UseSemanticCache Expr Src Import
expression
Expr Src X
_ <- Either (TypeError Src X) (Expr Src X) -> IO (Expr Src X)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Dhall.Core.throws (Expr Src X -> Either (TypeError Src X) (Expr Src X)
forall s. Expr s X -> Either (TypeError s X) (Expr s X)
Dhall.TypeCheck.typeOf (Expr Src X -> Expr Src X -> Expr Src X
forall s a. Expr s a -> Expr s a -> Expr s a
Annot Expr Src X
resolvedExpression Expr Src X
forall s a. Expr s a
Dhall.Core.Text))
let normalizedExpression :: Expr t X
normalizedExpression = Expr Src X -> Expr t X
forall a s t. Eq a => Expr s a -> Expr t a
Dhall.Core.normalize Expr Src X
resolvedExpression
case Expr Any X
forall t. Expr t X
normalizedExpression of
Dhall.Core.TextLit (Dhall.Core.Chunks [] text :: Text
text) -> do
Text -> IO ()
Data.Text.IO.putStr Text
text
_ -> do
let invalidDecoderExpected :: Expr Void Void
invalidDecoderExpected :: Expr X X
invalidDecoderExpected = Expr X X
forall s a. Expr s a
Dhall.Core.Text
let invalidDecoderExpression :: Expr Void Void
invalidDecoderExpression :: Expr X X
invalidDecoderExpression = Expr X X
forall t. Expr t X
normalizedExpression
InvalidDecoder X X -> IO ()
forall e a. Exception e => e -> IO a
Control.Exception.throwIO (InvalidDecoder :: forall s a. Expr s a -> Expr s a -> InvalidDecoder s a
Dhall.InvalidDecoder {..})
Tags {..} -> do
Text
tags <- Input -> Maybe [Text] -> Bool -> IO Text
Dhall.Tags.generate Input
input Maybe [Text]
suffixes Bool
followSymlinks
case Output
output of
OutputFile file :: FilePath
file ->
FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
System.IO.withFile FilePath
file IOMode
System.IO.WriteMode (Handle -> Text -> IO ()
`Data.Text.IO.hPutStr` Text
tags)
StandardOutput -> Text -> IO ()
Data.Text.IO.putStrLn Text
tags
DirectoryTree {..} -> do
Expr Src Import
expression <- Input -> IO (Expr Src Import)
getExpression Input
file
Expr Src X
resolvedExpression <-
FilePath -> SemanticCacheMode -> Expr Src Import -> IO (Expr Src X)
Dhall.Import.loadRelativeTo (Input -> FilePath
rootDirectory Input
file) SemanticCacheMode
UseSemanticCache Expr Src Import
expression
Expr Src X
_ <- Either (TypeError Src X) (Expr Src X) -> IO (Expr Src X)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Dhall.Core.throws (Expr Src X -> Either (TypeError Src X) (Expr Src X)
forall s. Expr s X -> Either (TypeError s X) (Expr s X)
Dhall.TypeCheck.typeOf Expr Src X
resolvedExpression)
let normalizedExpression :: Expr t X
normalizedExpression = Expr Src X -> Expr t X
forall a s t. Eq a => Expr s a -> Expr t a
Dhall.Core.normalize Expr Src X
resolvedExpression
FilePath -> Expr X X -> IO ()
DirectoryTree.toDirectoryTree FilePath
path Expr X X
forall t. Expr t X
normalizedExpression
SyntaxTree {..} -> do
Expr Src Import
expression <- Input -> IO (Expr Src Import)
getExpression Input
file
let denoted :: Expr Void Import
denoted :: Expr X Import
denoted = Expr Src Import -> Expr X Import
forall s a t. Expr s a -> Expr t a
Dhall.Core.denote Expr Src Import
expression
Expr X Import -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
Text.Pretty.Simple.pPrintNoColor Expr X Import
denoted
main :: IO ()
main :: IO ()
main = do
Options
options <- ParserInfo Options -> IO Options
forall a. ParserInfo a -> IO a
Options.Applicative.execParser ParserInfo Options
parserInfoOptions
Options -> IO ()
Dhall.Main.command Options
options