{-# LANGUAGE ApplicativeDo              #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE PolyKinds                  #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}

{-| Please read the "Dhall.Tutorial" module, which contains a tutorial explaining
    how to use the language, the compiler, and this library
-}

module Dhall
    (
    -- * Input
      input
    , inputWithSettings
    , inputFile
    , inputFileWithSettings
    , inputExpr
    , inputExprWithSettings
    , rootDirectory
    , sourceName
    , startingContext
    , substitutions
    , normalizer
    , newManager
    , defaultInputSettings
    , InputSettings
    , defaultEvaluateSettings
    , EvaluateSettings
    , HasEvaluateSettings(..)
    , detailed

    -- * Decoders
    , module Dhall.Marshal.Decode

    -- * Encoders
    , module Dhall.Marshal.Encode

    -- * Miscellaneous
    , rawInput
    ) where

import Control.Applicative    (Alternative, empty)
import Data.Either.Validation (Validation (..))
import Data.Void              (Void)
import Dhall.Import           (Imported (..))
import Dhall.Parser           (Src (..))
import Dhall.Syntax           (Expr (..))
import Dhall.TypeCheck        (DetailedTypeError (..), TypeError)
import GHC.Generics
import Lens.Family            (LensLike', view)
import Prelude                hiding (maybe, sequence)
import System.FilePath        (takeDirectory)

import qualified Control.Exception
import qualified Control.Monad.Trans.State.Strict as State
import qualified Data.Text.IO
import qualified Dhall.Context
import qualified Dhall.Core                       as Core
import qualified Dhall.Import
import qualified Dhall.Parser
import qualified Dhall.Pretty.Internal
import qualified Dhall.Substitution
import qualified Dhall.TypeCheck
import qualified Lens.Family

import Dhall.Marshal.Decode
import Dhall.Marshal.Encode

-- | @since 1.16
data InputSettings = InputSettings
  { InputSettings -> FilePath
_rootDirectory :: FilePath
  , InputSettings -> FilePath
_sourceName :: FilePath
  , InputSettings -> EvaluateSettings
_evaluateSettings :: EvaluateSettings
  }

-- | Default input settings: resolves imports relative to @.@ (the
-- current working directory), report errors as coming from @(input)@,
-- and default evaluation settings from 'defaultEvaluateSettings'.
--
-- @since 1.16
defaultInputSettings :: InputSettings
defaultInputSettings :: InputSettings
defaultInputSettings = InputSettings :: FilePath -> FilePath -> EvaluateSettings -> InputSettings
InputSettings
  { _rootDirectory :: FilePath
_rootDirectory = FilePath
"."
  , _sourceName :: FilePath
_sourceName = FilePath
"(input)"
  , _evaluateSettings :: EvaluateSettings
_evaluateSettings = EvaluateSettings
defaultEvaluateSettings
  }


-- | Access the directory to resolve imports relative to.
--
-- @since 1.16
rootDirectory
  :: (Functor f)
  => LensLike' f InputSettings FilePath
rootDirectory :: LensLike' f InputSettings FilePath
rootDirectory FilePath -> f FilePath
k InputSettings
s =
  (FilePath -> InputSettings) -> f FilePath -> f InputSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\FilePath
x -> InputSettings
s { _rootDirectory :: FilePath
_rootDirectory = FilePath
x }) (FilePath -> f FilePath
k (InputSettings -> FilePath
_rootDirectory InputSettings
s))

-- | Access the name of the source to report locations from; this is
-- only used in error messages, so it's okay if this is a best guess
-- or something symbolic.
--
-- @since 1.16
sourceName
  :: (Functor f)
  => LensLike' f InputSettings FilePath
sourceName :: LensLike' f InputSettings FilePath
sourceName FilePath -> f FilePath
k InputSettings
s =
  (FilePath -> InputSettings) -> f FilePath -> f InputSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\FilePath
x -> InputSettings
s { _sourceName :: FilePath
_sourceName = FilePath
x}) (FilePath -> f FilePath
k (InputSettings -> FilePath
_sourceName InputSettings
s))

-- | @since 1.16
data EvaluateSettings = EvaluateSettings
  { EvaluateSettings -> Substitutions Src Void
_substitutions   :: Dhall.Substitution.Substitutions Src Void
  , EvaluateSettings -> Context (Expr Src Void)
_startingContext :: Dhall.Context.Context (Expr Src Void)
  , EvaluateSettings -> Maybe (ReifiedNormalizer Void)
_normalizer      :: Maybe (Core.ReifiedNormalizer Void)
  , EvaluateSettings -> IO Manager
_newManager      :: IO Dhall.Import.Manager
  }

-- | Default evaluation settings: no extra entries in the initial
-- context, and no special normalizer behaviour.
--
-- @since 1.16
defaultEvaluateSettings :: EvaluateSettings
defaultEvaluateSettings :: EvaluateSettings
defaultEvaluateSettings = EvaluateSettings :: Substitutions Src Void
-> Context (Expr Src Void)
-> Maybe (ReifiedNormalizer Void)
-> IO Manager
-> EvaluateSettings
EvaluateSettings
  { _substitutions :: Substitutions Src Void
_substitutions   = Substitutions Src Void
forall s a. Substitutions s a
Dhall.Substitution.empty
  , _startingContext :: Context (Expr Src Void)
_startingContext = Context (Expr Src Void)
forall a. Context a
Dhall.Context.empty
  , _normalizer :: Maybe (ReifiedNormalizer Void)
_normalizer      = Maybe (ReifiedNormalizer Void)
forall a. Maybe a
Nothing
  , _newManager :: IO Manager
_newManager      = IO Manager
Dhall.Import.defaultNewManager
  }

-- | Access the starting context used for evaluation and type-checking.
--
-- @since 1.16
startingContext
  :: (Functor f, HasEvaluateSettings s)
  => LensLike' f s (Dhall.Context.Context (Expr Src Void))
startingContext :: LensLike' f s (Context (Expr Src Void))
startingContext = LensLike' f s EvaluateSettings
forall s (f :: * -> *).
(HasEvaluateSettings s, Functor f) =>
LensLike' f s EvaluateSettings
evaluateSettings LensLike' f s EvaluateSettings
-> ((Context (Expr Src Void) -> f (Context (Expr Src Void)))
    -> EvaluateSettings -> f EvaluateSettings)
-> LensLike' f s (Context (Expr Src Void))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context (Expr Src Void) -> f (Context (Expr Src Void)))
-> EvaluateSettings -> f EvaluateSettings
forall (f :: * -> *).
Functor f =>
LensLike' f EvaluateSettings (Context (Expr Src Void))
l
  where
    l :: (Functor f)
      => LensLike' f EvaluateSettings (Dhall.Context.Context (Expr Src Void))
    l :: LensLike' f EvaluateSettings (Context (Expr Src Void))
l Context (Expr Src Void) -> f (Context (Expr Src Void))
k EvaluateSettings
s = (Context (Expr Src Void) -> EvaluateSettings)
-> f (Context (Expr Src Void)) -> f EvaluateSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Context (Expr Src Void)
x -> EvaluateSettings
s { _startingContext :: Context (Expr Src Void)
_startingContext = Context (Expr Src Void)
x}) (Context (Expr Src Void) -> f (Context (Expr Src Void))
k (EvaluateSettings -> Context (Expr Src Void)
_startingContext EvaluateSettings
s))

-- | Access the custom substitutions.
--
-- @since 1.30
substitutions
  :: (Functor f, HasEvaluateSettings s)
  => LensLike' f s (Dhall.Substitution.Substitutions Src Void)
substitutions :: LensLike' f s (Substitutions Src Void)
substitutions = LensLike' f s EvaluateSettings
forall s (f :: * -> *).
(HasEvaluateSettings s, Functor f) =>
LensLike' f s EvaluateSettings
evaluateSettings LensLike' f s EvaluateSettings
-> ((Substitutions Src Void -> f (Substitutions Src Void))
    -> EvaluateSettings -> f EvaluateSettings)
-> LensLike' f s (Substitutions Src Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Substitutions Src Void -> f (Substitutions Src Void))
-> EvaluateSettings -> f EvaluateSettings
forall (f :: * -> *).
Functor f =>
LensLike' f EvaluateSettings (Substitutions Src Void)
l
  where
    l :: (Functor f)
      => LensLike' f EvaluateSettings (Dhall.Substitution.Substitutions Src Void)
    l :: LensLike' f EvaluateSettings (Substitutions Src Void)
l Substitutions Src Void -> f (Substitutions Src Void)
k EvaluateSettings
s = (Substitutions Src Void -> EvaluateSettings)
-> f (Substitutions Src Void) -> f EvaluateSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Substitutions Src Void
x -> EvaluateSettings
s { _substitutions :: Substitutions Src Void
_substitutions = Substitutions Src Void
x }) (Substitutions Src Void -> f (Substitutions Src Void)
k (EvaluateSettings -> Substitutions Src Void
_substitutions EvaluateSettings
s))

-- | Access the custom normalizer.
--
-- @since 1.16
normalizer
  :: (Functor f, HasEvaluateSettings s)
  => LensLike' f s (Maybe (Core.ReifiedNormalizer Void))
normalizer :: LensLike' f s (Maybe (ReifiedNormalizer Void))
normalizer = LensLike' f s EvaluateSettings
forall s (f :: * -> *).
(HasEvaluateSettings s, Functor f) =>
LensLike' f s EvaluateSettings
evaluateSettings LensLike' f s EvaluateSettings
-> ((Maybe (ReifiedNormalizer Void)
     -> f (Maybe (ReifiedNormalizer Void)))
    -> EvaluateSettings -> f EvaluateSettings)
-> LensLike' f s (Maybe (ReifiedNormalizer Void))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (ReifiedNormalizer Void)
 -> f (Maybe (ReifiedNormalizer Void)))
-> EvaluateSettings -> f EvaluateSettings
forall (f :: * -> *).
Functor f =>
LensLike' f EvaluateSettings (Maybe (ReifiedNormalizer Void))
l
  where
    l :: (Functor f)
      => LensLike' f EvaluateSettings (Maybe (Core.ReifiedNormalizer Void))
    l :: LensLike' f EvaluateSettings (Maybe (ReifiedNormalizer Void))
l Maybe (ReifiedNormalizer Void)
-> f (Maybe (ReifiedNormalizer Void))
k EvaluateSettings
s = (Maybe (ReifiedNormalizer Void) -> EvaluateSettings)
-> f (Maybe (ReifiedNormalizer Void)) -> f EvaluateSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe (ReifiedNormalizer Void)
x -> EvaluateSettings
s { _normalizer :: Maybe (ReifiedNormalizer Void)
_normalizer = Maybe (ReifiedNormalizer Void)
x }) (Maybe (ReifiedNormalizer Void)
-> f (Maybe (ReifiedNormalizer Void))
k (EvaluateSettings -> Maybe (ReifiedNormalizer Void)
_normalizer EvaluateSettings
s))

-- | Access the HTTP manager initializer.
--
-- @since 1.36
newManager
  :: (Functor f, HasEvaluateSettings s)
  => LensLike' f s (IO Dhall.Import.Manager)
newManager :: LensLike' f s (IO Manager)
newManager = LensLike' f s EvaluateSettings
forall s (f :: * -> *).
(HasEvaluateSettings s, Functor f) =>
LensLike' f s EvaluateSettings
evaluateSettings LensLike' f s EvaluateSettings
-> ((IO Manager -> f (IO Manager))
    -> EvaluateSettings -> f EvaluateSettings)
-> LensLike' f s (IO Manager)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IO Manager -> f (IO Manager))
-> EvaluateSettings -> f EvaluateSettings
forall (f :: * -> *).
Functor f =>
LensLike' f EvaluateSettings (IO Manager)
l
  where
    l :: (Functor f)
      => LensLike' f EvaluateSettings (IO Dhall.Import.Manager)
    l :: LensLike' f EvaluateSettings (IO Manager)
l IO Manager -> f (IO Manager)
k EvaluateSettings
s = (IO Manager -> EvaluateSettings)
-> f (IO Manager) -> f EvaluateSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\IO Manager
x -> EvaluateSettings
s { _newManager :: IO Manager
_newManager = IO Manager
x }) (IO Manager -> f (IO Manager)
k (EvaluateSettings -> IO Manager
_newManager EvaluateSettings
s))

-- | @since 1.16
class HasEvaluateSettings s where
  evaluateSettings
    :: (Functor f)
    => LensLike' f s EvaluateSettings

instance HasEvaluateSettings InputSettings where
  evaluateSettings :: LensLike' f InputSettings EvaluateSettings
evaluateSettings EvaluateSettings -> f EvaluateSettings
k InputSettings
s =
    (EvaluateSettings -> InputSettings)
-> f EvaluateSettings -> f InputSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\EvaluateSettings
x -> InputSettings
s { _evaluateSettings :: EvaluateSettings
_evaluateSettings = EvaluateSettings
x }) (EvaluateSettings -> f EvaluateSettings
k (InputSettings -> EvaluateSettings
_evaluateSettings InputSettings
s))

instance HasEvaluateSettings EvaluateSettings where
  evaluateSettings :: LensLike' f EvaluateSettings EvaluateSettings
evaluateSettings = LensLike' f EvaluateSettings EvaluateSettings
forall a. a -> a
id

{-| Type-check and evaluate a Dhall program, decoding the result into Haskell

    The first argument determines the type of value that you decode:

>>> input integer "+2"
2
>>> input (vector double) "[1.0, 2.0]"
[1.0,2.0]

    Use `auto` to automatically select which type to decode based on the
    inferred return type:

>>> input auto "True" :: IO Bool
True

    This uses the settings from 'defaultInputSettings'.
-}
input
    :: Decoder a
    -- ^ The decoder for the Dhall value
    -> Text
    -- ^ The Dhall program
    -> IO a
    -- ^ The decoded value in Haskell
input :: Decoder a -> Text -> IO a
input =
  InputSettings -> Decoder a -> Text -> IO a
forall a. InputSettings -> Decoder a -> Text -> IO a
inputWithSettings InputSettings
defaultInputSettings

{-| Extend 'input' with a root directory to resolve imports relative
    to, a file to mention in errors as the source, a custom typing
    context, and a custom normalization process.

@since 1.16
-}
inputWithSettings
    :: InputSettings
    -> Decoder a
    -- ^ The decoder for the Dhall value
    -> Text
    -- ^ The Dhall program
    -> IO a
    -- ^ The decoded value in Haskell
inputWithSettings :: InputSettings -> Decoder a -> Text -> IO a
inputWithSettings InputSettings
settings (Decoder {Expector (Expr Src Void)
Expr Src Void -> Extractor Src Void a
expected :: forall a. Decoder a -> Expector (Expr Src Void)
extract :: forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Extractor Src Void a
..}) Text
txt = do
    Expr Src Void
expected' <- case Expector (Expr Src Void)
expected of
        Success Expr Src Void
x -> Expr Src Void -> IO (Expr Src Void)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Src Void
x
        Failure ExpectedTypeErrors
e -> ExpectedTypeErrors -> IO (Expr Src Void)
forall e a. Exception e => e -> IO a
Control.Exception.throwIO ExpectedTypeErrors
e

    let suffix :: Text
suffix = Expr Src Void -> Text
forall a. Pretty a => a -> Text
Dhall.Pretty.Internal.prettyToStrictText Expr Src Void
expected'
    let annotate :: Expr Src Void -> Expr Src Void
annotate Expr Src Void
substituted = case Expr Src Void
substituted of
            Note (Src SourcePos
begin SourcePos
end Text
bytes) Expr Src Void
_ ->
                Src -> Expr Src Void -> Expr Src Void
forall s a. s -> Expr s a -> Expr s a
Note (SourcePos -> SourcePos -> Text -> Src
Src SourcePos
begin SourcePos
end Text
bytes') (Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
Annot Expr Src Void
substituted Expr Src Void
expected')
              where
                bytes' :: Text
bytes' = Text
bytes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" : " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix
            Expr Src Void
_ ->
                Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
Annot Expr Src Void
substituted Expr Src Void
expected'

    Expr Src Void
normExpr <- (Expr Src Void -> Expr Src Void)
-> InputSettings -> Text -> IO (Expr Src Void)
inputHelper Expr Src Void -> Expr Src Void
annotate InputSettings
settings Text
txt

    case Expr Src Void -> Extractor Src Void a
extract Expr Src Void
normExpr  of
        Success a
x  -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
        Failure ExtractErrors Src Void
e -> ExtractErrors Src Void -> IO a
forall e a. Exception e => e -> IO a
Control.Exception.throwIO ExtractErrors Src Void
e

{-| Type-check and evaluate a Dhall program that is read from the
    file-system.

    This uses the settings from 'defaultEvaluateSettings'.

    @since 1.16
-}
inputFile
  :: Decoder a
  -- ^ The decoder for the Dhall value
  -> FilePath
  -- ^ The path to the Dhall program.
  -> IO a
  -- ^ The decoded value in Haskell.
inputFile :: Decoder a -> FilePath -> IO a
inputFile =
  EvaluateSettings -> Decoder a -> FilePath -> IO a
forall a. EvaluateSettings -> Decoder a -> FilePath -> IO a
inputFileWithSettings EvaluateSettings
defaultEvaluateSettings

{-| Extend 'inputFile' with a custom typing context and a custom
    normalization process.

@since 1.16
-}
inputFileWithSettings
  :: EvaluateSettings
  -> Decoder a
  -- ^ The decoder for the Dhall value
  -> FilePath
  -- ^ The path to the Dhall program.
  -> IO a
  -- ^ The decoded value in Haskell.
inputFileWithSettings :: EvaluateSettings -> Decoder a -> FilePath -> IO a
inputFileWithSettings EvaluateSettings
settings Decoder a
ty FilePath
path = do
  Text
text <- FilePath -> IO Text
Data.Text.IO.readFile FilePath
path
  let inputSettings :: InputSettings
inputSettings = InputSettings :: FilePath -> FilePath -> EvaluateSettings -> InputSettings
InputSettings
        { _rootDirectory :: FilePath
_rootDirectory = FilePath -> FilePath
takeDirectory FilePath
path
        , _sourceName :: FilePath
_sourceName = FilePath
path
        , _evaluateSettings :: EvaluateSettings
_evaluateSettings = EvaluateSettings
settings
        }
  InputSettings -> Decoder a -> Text -> IO a
forall a. InputSettings -> Decoder a -> Text -> IO a
inputWithSettings InputSettings
inputSettings Decoder a
ty Text
text

{-| Similar to `input`, but without interpreting the Dhall `Expr` into a Haskell
    type.

    Uses the settings from 'defaultInputSettings'.
-}
inputExpr
    :: Text
    -- ^ The Dhall program
    -> IO (Expr Src Void)
    -- ^ The fully normalized AST
inputExpr :: Text -> IO (Expr Src Void)
inputExpr =
  InputSettings -> Text -> IO (Expr Src Void)
inputExprWithSettings InputSettings
defaultInputSettings

{-| Extend 'inputExpr' with a root directory to resolve imports relative
    to, a file to mention in errors as the source, a custom typing
    context, and a custom normalization process.

@since 1.16
-}
inputExprWithSettings
    :: InputSettings
    -> Text
    -- ^ The Dhall program
    -> IO (Expr Src Void)
    -- ^ The fully normalized AST
inputExprWithSettings :: InputSettings -> Text -> IO (Expr Src Void)
inputExprWithSettings = (Expr Src Void -> Expr Src Void)
-> InputSettings -> Text -> IO (Expr Src Void)
inputHelper Expr Src Void -> Expr Src Void
forall a. a -> a
id

{-| Helper function for the input* function family

@since 1.30
-}
inputHelper
    :: (Expr Src Void -> Expr Src Void)
    -> InputSettings
    -> Text
    -- ^ The Dhall program
    -> IO (Expr Src Void)
    -- ^ The fully normalized AST
inputHelper :: (Expr Src Void -> Expr Src Void)
-> InputSettings -> Text -> IO (Expr Src Void)
inputHelper Expr Src Void -> Expr Src Void
annotate InputSettings
settings Text
txt = do
    Expr Src Import
expr  <- Either ParseError (Expr Src Import) -> IO (Expr Src Import)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Core.throws (FilePath -> Text -> Either ParseError (Expr Src Import)
Dhall.Parser.exprFromText (FoldLike FilePath InputSettings InputSettings FilePath FilePath
-> InputSettings -> FilePath
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike FilePath InputSettings InputSettings FilePath FilePath
forall (f :: * -> *).
Functor f =>
LensLike' f InputSettings FilePath
sourceName InputSettings
settings) Text
txt)

    let InputSettings {FilePath
EvaluateSettings
_evaluateSettings :: EvaluateSettings
_sourceName :: FilePath
_rootDirectory :: FilePath
_evaluateSettings :: InputSettings -> EvaluateSettings
_sourceName :: InputSettings -> FilePath
_rootDirectory :: InputSettings -> FilePath
..} = InputSettings
settings

    let EvaluateSettings {Maybe (ReifiedNormalizer Void)
IO Manager
Context (Expr Src Void)
Substitutions Src Void
_newManager :: IO Manager
_normalizer :: Maybe (ReifiedNormalizer Void)
_startingContext :: Context (Expr Src Void)
_substitutions :: Substitutions Src Void
_newManager :: EvaluateSettings -> IO Manager
_normalizer :: EvaluateSettings -> Maybe (ReifiedNormalizer Void)
_startingContext :: EvaluateSettings -> Context (Expr Src Void)
_substitutions :: EvaluateSettings -> Substitutions Src Void
..} = EvaluateSettings
_evaluateSettings

    let transform :: Status -> Status
transform =
               ASetter
  Status Status (Substitutions Src Void) (Substitutions Src Void)
-> Substitutions Src Void -> Status -> Status
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.Family.set ASetter
  Status Status (Substitutions Src Void) (Substitutions Src Void)
forall (f :: * -> *).
Functor f =>
LensLike' f Status (Substitutions Src Void)
Dhall.Import.substitutions   Substitutions Src Void
_substitutions
            (Status -> Status) -> (Status -> Status) -> Status -> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  ASetter
  Status
  Status
  (Maybe (ReifiedNormalizer Void))
  (Maybe (ReifiedNormalizer Void))
-> Maybe (ReifiedNormalizer Void) -> Status -> Status
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.Family.set ASetter
  Status
  Status
  (Maybe (ReifiedNormalizer Void))
  (Maybe (ReifiedNormalizer Void))
forall (f :: * -> *).
Functor f =>
LensLike' f Status (Maybe (ReifiedNormalizer Void))
Dhall.Import.normalizer      Maybe (ReifiedNormalizer Void)
_normalizer
            (Status -> Status) -> (Status -> Status) -> Status -> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  ASetter
  Status Status (Context (Expr Src Void)) (Context (Expr Src Void))
-> Context (Expr Src Void) -> Status -> Status
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.Family.set ASetter
  Status Status (Context (Expr Src Void)) (Context (Expr Src Void))
forall (f :: * -> *).
Functor f =>
LensLike' f Status (Context (Expr Src Void))
Dhall.Import.startingContext Context (Expr Src Void)
_startingContext

    let status :: Status
status = Status -> Status
transform (IO Manager -> FilePath -> Status
Dhall.Import.emptyStatusWithManager IO Manager
_newManager FilePath
_rootDirectory)

    Expr Src Void
expr' <- StateT Status IO (Expr Src Void) -> Status -> IO (Expr Src Void)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
State.evalStateT (Expr Src Import -> StateT Status IO (Expr Src Void)
Dhall.Import.loadWith Expr Src Import
expr) Status
status

    let substituted :: Expr Src Void
substituted = Expr Src Void -> Substitutions Src Void -> Expr Src Void
forall s a. Expr s a -> Substitutions s a -> Expr s a
Dhall.Substitution.substitute Expr Src Void
expr' (Substitutions Src Void -> Expr Src Void)
-> Substitutions Src Void -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ FoldLike
  (Substitutions Src Void)
  InputSettings
  InputSettings
  (Substitutions Src Void)
  (Substitutions Src Void)
-> InputSettings -> Substitutions Src Void
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike
  (Substitutions Src Void)
  InputSettings
  InputSettings
  (Substitutions Src Void)
  (Substitutions Src Void)
forall (f :: * -> *) s.
(Functor f, HasEvaluateSettings s) =>
LensLike' f s (Substitutions Src Void)
substitutions InputSettings
settings
    let annot :: Expr Src Void
annot = Expr Src Void -> Expr Src Void
annotate Expr Src Void
substituted
    Expr Src Void
_ <- Either (TypeError Src Void) (Expr Src Void) -> IO (Expr Src Void)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Core.throws (Context (Expr Src Void)
-> Expr Src Void -> Either (TypeError Src Void) (Expr Src Void)
forall s.
Context (Expr s Void)
-> Expr s Void -> Either (TypeError s Void) (Expr s Void)
Dhall.TypeCheck.typeWith (FoldLike
  (Context (Expr Src Void))
  InputSettings
  InputSettings
  (Context (Expr Src Void))
  (Context (Expr Src Void))
-> InputSettings -> Context (Expr Src Void)
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike
  (Context (Expr Src Void))
  InputSettings
  InputSettings
  (Context (Expr Src Void))
  (Context (Expr Src Void))
forall (f :: * -> *) s.
(Functor f, HasEvaluateSettings s) =>
LensLike' f s (Context (Expr Src Void))
startingContext InputSettings
settings) Expr Src Void
annot)
    pure (Maybe (ReifiedNormalizer Void) -> Expr Src Void -> Expr Src Void
forall a s t.
Eq a =>
Maybe (ReifiedNormalizer a) -> Expr s a -> Expr t a
Core.normalizeWith (FoldLike
  (Maybe (ReifiedNormalizer Void))
  InputSettings
  InputSettings
  (Maybe (ReifiedNormalizer Void))
  (Maybe (ReifiedNormalizer Void))
-> InputSettings -> Maybe (ReifiedNormalizer Void)
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike
  (Maybe (ReifiedNormalizer Void))
  InputSettings
  InputSettings
  (Maybe (ReifiedNormalizer Void))
  (Maybe (ReifiedNormalizer Void))
forall (f :: * -> *) s.
(Functor f, HasEvaluateSettings s) =>
LensLike' f s (Maybe (ReifiedNormalizer Void))
normalizer InputSettings
settings) Expr Src Void
substituted)

-- | Use this function to extract Haskell values directly from Dhall AST.
--   The intended use case is to allow easy extraction of Dhall values for
--   making the function `Core.normalizeWith` easier to use.
--
--   For other use cases, use `input` from "Dhall" module. It will give you
--   a much better user experience.
rawInput
    :: Alternative f
    => Decoder a
    -- ^ The decoder for the Dhall value
    -> Expr s Void
    -- ^ a closed form Dhall program, which evaluates to the expected type
    -> f a
    -- ^ The decoded value in Haskell
rawInput :: Decoder a -> Expr s Void -> f a
rawInput (Decoder {Expector (Expr Src Void)
Expr Src Void -> Extractor Src Void a
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Extractor Src Void a
expected :: forall a. Decoder a -> Expector (Expr Src Void)
extract :: forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
..}) Expr s Void
expr =
    case Expr Src Void -> Extractor Src Void a
extract (Expr s Void -> Expr Src Void
forall a s t. Eq a => Expr s a -> Expr t a
Core.normalize Expr s Void
expr) of
        Success a
x  -> a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
        Failure ExtractErrors Src Void
_e -> f a
forall (f :: * -> *) a. Alternative f => f a
empty

{-| Use this to provide more detailed error messages

>> input auto "True" :: IO Integer
> *** Exception: Error: Expression doesn't match annotation
>
> True : Integer
>
> (input):1:1

>> detailed (input auto "True") :: IO Integer
> *** Exception: Error: Expression doesn't match annotation
>
> Explanation: You can annotate an expression with its type or kind using the
> ❰:❱ symbol, like this:
>
>
>     ┌───────┐
>     │ x : t │  ❰x❱ is an expression and ❰t❱ is the annotated type or kind of ❰x❱
>     └───────┘
>
> The type checker verifies that the expression's type or kind matches the
> provided annotation
>
> For example, all of the following are valid annotations that the type checker
> accepts:
>
>
>     ┌─────────────┐
>     │ 1 : Natural │  ❰1❱ is an expression that has type ❰Natural❱, so the type
>     └─────────────┘  checker accepts the annotation
>
>
>     ┌───────────────────────┐
>     │ Natural/even 2 : Bool │  ❰Natural/even 2❱ has type ❰Bool❱, so the type
>     └───────────────────────┘  checker accepts the annotation
>
>
>     ┌────────────────────┐
>     │ List : Type → Type │  ❰List❱ is an expression that has kind ❰Type → Type❱,
>     └────────────────────┘  so the type checker accepts the annotation
>
>
>     ┌──────────────────┐
>     │ List Text : Type │  ❰List Text❱ is an expression that has kind ❰Type❱, so
>     └──────────────────┘  the type checker accepts the annotation
>
>
> However, the following annotations are not valid and the type checker will
> reject them:
>
>
>     ┌──────────┐
>     │ 1 : Text │  The type checker rejects this because ❰1❱ does not have type
>     └──────────┘  ❰Text❱
>
>
>     ┌─────────────┐
>     │ List : Type │  ❰List❱ does not have kind ❰Type❱
>     └─────────────┘
>
>
> You or the interpreter annotated this expression:
>
> ↳ True
>
> ... with this type or kind:
>
> ↳ Integer
>
> ... but the inferred type or kind of the expression is actually:
>
> ↳ Bool
>
> Some common reasons why you might get this error:
>
> ● The Haskell Dhall interpreter implicitly inserts a top-level annotation
>   matching the expected type
>
>   For example, if you run the following Haskell code:
>
>
>     ┌───────────────────────────────┐
>     │ >>> input auto "1" :: IO Text │
>     └───────────────────────────────┘
>
>
>   ... then the interpreter will actually type check the following annotated
>   expression:
>
>
>     ┌──────────┐
>     │ 1 : Text │
>     └──────────┘
>
>
>   ... and then type-checking will fail
>
> ────────────────────────────────────────────────────────────────────────────────
>
> True : Integer
>
> (input):1:1

-}
detailed :: IO a -> IO a
detailed :: IO a -> IO a
detailed =
    (TypeError Src Void -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
Control.Exception.handle TypeError Src Void -> IO a
forall a. TypeError Src Void -> IO a
handler1 (IO a -> IO a) -> (IO a -> IO a) -> IO a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Imported (TypeError Src Void) -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
Control.Exception.handle Imported (TypeError Src Void) -> IO a
forall a. Imported (TypeError Src Void) -> IO a
handler0
  where
    handler0 :: Imported (TypeError Src Void) -> IO a
    handler0 :: Imported (TypeError Src Void) -> IO a
handler0 (Imported NonEmpty Chained
ps TypeError Src Void
e) =
        Imported (DetailedTypeError Src Void) -> IO a
forall e a. Exception e => e -> IO a
Control.Exception.throwIO (NonEmpty Chained
-> DetailedTypeError Src Void
-> Imported (DetailedTypeError Src Void)
forall e. NonEmpty Chained -> e -> Imported e
Imported NonEmpty Chained
ps (TypeError Src Void -> DetailedTypeError Src Void
forall s a. TypeError s a -> DetailedTypeError s a
DetailedTypeError TypeError Src Void
e))

    handler1 :: TypeError Src Void -> IO a
    handler1 :: TypeError Src Void -> IO a
handler1 TypeError Src Void
e = DetailedTypeError Src Void -> IO a
forall e a. Exception e => e -> IO a
Control.Exception.throwIO (TypeError Src Void -> DetailedTypeError Src Void
forall s a. TypeError s a -> DetailedTypeError s a
DetailedTypeError TypeError Src Void
e)