    {-# LANGUAGE CPP               #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RecordWildCards   #-}

    {-# OPTIONS_GHC -Wall #-}

    module Dhall.Import.Types where

    import Control.Exception (Exception)
    import Control.Monad.Trans.State.Strict (StateT)
    import Data.Dynamic
    import Data.List.NonEmpty (NonEmpty)
    import Dhall.Map (Map)
    import Data.Semigroup ((<>))
    import Data.Text.Prettyprint.Doc (Pretty(..))
    import Data.Void (Void)
    import Dhall.Context (Context)
    import Dhall.Core
      ( Directory (..)
      , Expr
      , File (..)
      , FilePrefix (..)
      , Import (..)
      , ImportHashed (..)
      , ImportMode (..)
      , ImportType (..)
      , ReifiedNormalizer(..)
      , URL
      )
    #ifdef WITH_HTTP
    import Dhall.Import.Manager (Manager)
    #endif
    import Dhall.Parser (Src)
    import Lens.Family (LensLike')
    import System.FilePath (isRelative, splitDirectories)

    import qualified Dhall.Context
    import qualified Dhall.Map     as Map
    import qualified Dhall.Substitution
    import qualified Data.Text

    -- | A fully 'chained' import, i.e. if it contains a relative path that path is
    --   relative to the current directory. If it is a remote import with headers
    --   those are well-typed (either of type `List { header : Text, value Text}` or
    --   `List { mapKey : Text, mapValue Text})` and in normal form. These
    --   invariants are preserved by the API exposed by @Dhall.Import@.
    newtype Chained = Chained
        { Chained -> Import
    chainedImport :: Import
          -- ^ The underlying import
        }
      deriving (Chained -> Chained -> Bool
    (Chained -> Chained -> Bool)
    -> (Chained -> Chained -> Bool) -> Eq Chained
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Chained -> Chained -> Bool
    $c/= :: Chained -> Chained -> Bool
    == :: Chained -> Chained -> Bool
    $c== :: Chained -> Chained -> Bool
    Eq, Eq Chained
    Eq Chained =>
    (Chained -> Chained -> Ordering)
    -> (Chained -> Chained -> Bool)
    -> (Chained -> Chained -> Bool)
    -> (Chained -> Chained -> Bool)
    -> (Chained -> Chained -> Bool)
    -> (Chained -> Chained -> Chained)
    -> (Chained -> Chained -> Chained)
    -> Ord Chained
    Chained -> Chained -> Bool
    Chained -> Chained -> Ordering
    Chained -> Chained -> Chained
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    min :: Chained -> Chained -> Chained
    $cmin :: Chained -> Chained -> Chained
    max :: Chained -> Chained -> Chained
    $cmax :: Chained -> Chained -> Chained
    >= :: Chained -> Chained -> Bool
    $c>= :: Chained -> Chained -> Bool
    > :: Chained -> Chained -> Bool
    $c> :: Chained -> Chained -> Bool
    <= :: Chained -> Chained -> Bool
    $c<= :: Chained -> Chained -> Bool
    < :: Chained -> Chained -> Bool
    $c< :: Chained -> Chained -> Bool
    compare :: Chained -> Chained -> Ordering
    $ccompare :: Chained -> Chained -> Ordering
    $cp1Ord :: Eq Chained
    Ord)

    instance Pretty Chained where
        pretty :: Chained -> Doc ann
    pretty (Chained import_ :: Import
    import_) = Import -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty Import
    import_

    -- | An import that has been fully interpeted
    data ImportSemantics = ImportSemantics
        { ImportSemantics -> Expr Void Void
    importSemantics :: Expr Void Void
        -- ^ The fully resolved import, typechecked and beta-normal.
        }

    -- | `parent` imports (i.e. depends on) `child`
    data Depends = Depends { Depends -> Chained
    parent :: Chained, Depends -> Chained
    child :: Chained }

    {-| This enables or disables the semantic cache for imports protected by
        integrity checks
    -}
    data SemanticCacheMode = IgnoreSemanticCache | UseSemanticCache deriving (SemanticCacheMode -> SemanticCacheMode -> Bool
    (SemanticCacheMode -> SemanticCacheMode -> Bool)
    -> (SemanticCacheMode -> SemanticCacheMode -> Bool)
    -> Eq SemanticCacheMode
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: SemanticCacheMode -> SemanticCacheMode -> Bool
    $c/= :: SemanticCacheMode -> SemanticCacheMode -> Bool
    == :: SemanticCacheMode -> SemanticCacheMode -> Bool
    $c== :: SemanticCacheMode -> SemanticCacheMode -> Bool
    Eq)

    -- | State threaded throughout the import process
    data Status = Status
        { Status -> NonEmpty Chained
    _stack :: NonEmpty Chained
        -- ^ Stack of `Import`s that we've imported along the way to get to the
        -- current point

        , Status -> [Depends]
    _graph :: [Depends]
        -- ^ Graph of all the imports visited so far, represented by a list of
        --   import dependencies.

        , Status -> Map Chained ImportSemantics
    _cache :: Map Chained ImportSemantics
        -- ^ Cache of imported expressions with their node id in order to avoid
        --   importing the same expression twice with different values

    #ifdef WITH_HTTP
        , Status -> Maybe Manager
    _manager :: Maybe Manager
    #else
        , _manager :: Maybe Void
    #endif
        -- ^ Used to cache the `Manager` when making multiple requests

        , Status -> URL -> StateT Status IO Text
    _remote :: URL -> StateT Status IO Data.Text.Text
        -- ^ The remote resolver, fetches the content at the given URL.

        , Status -> Substitutions Src Void
    _substitutions :: Dhall.Substitution.Substitutions Src Void

        , Status -> Maybe (ReifiedNormalizer Void)
    _normalizer :: Maybe (ReifiedNormalizer Void)

        , Status -> Context (Expr Src Void)
    _startingContext :: Context (Expr Src Void)

        , Status -> SemanticCacheMode
    _semanticCacheMode :: SemanticCacheMode
        }

    -- | Initial `Status`, parameterised over the remote resolver, importing
    --   relative to the given directory.
    emptyStatusWith :: (URL -> StateT Status IO Data.Text.Text) -> FilePath -> Status
    emptyStatusWith :: (URL -> StateT Status IO Text) -> FilePath -> Status
    emptyStatusWith _remote :: URL -> StateT Status IO Text
    _remote rootDirectory :: FilePath
    rootDirectory = Status :: NonEmpty Chained
    -> [Depends]
    -> Map Chained ImportSemantics
    -> Maybe Manager
    -> (URL -> StateT Status IO Text)
    -> Substitutions Src Void
    -> Maybe (ReifiedNormalizer Void)
    -> Context (Expr Src Void)
    -> SemanticCacheMode
    -> Status
    Status {..}
      where
        _stack :: NonEmpty Chained
    _stack = Chained -> NonEmpty Chained
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Import -> Chained
    Chained Import
    rootImport)

        _graph :: [a]
    _graph = []

        _cache :: Map Chained v
    _cache = Map Chained v
    forall k v. Ord k => Map k v
    Map.empty

        _manager :: Maybe a
    _manager = Maybe a
    forall a. Maybe a
    Nothing

        _substitutions :: Substitutions s a
    _substitutions = Substitutions s a
    forall s a. Substitutions s a
    Dhall.Substitution.empty

        _normalizer :: Maybe a
    _normalizer = Maybe a
    forall a. Maybe a
    Nothing

        _startingContext :: Context a
    _startingContext = Context a
    forall a. Context a
    Dhall.Context.empty

        _semanticCacheMode :: SemanticCacheMode
    _semanticCacheMode = SemanticCacheMode
    UseSemanticCache

        prefix :: FilePrefix
    prefix = if FilePath -> Bool
    isRelative FilePath
    rootDirectory
          then FilePrefix
    Here
          else FilePrefix
    Absolute
        pathComponents :: [Text]
    pathComponents =
            (FilePath -> Text) -> [FilePath] -> [Text]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FilePath -> Text
    Data.Text.pack ([FilePath] -> [FilePath]
    forall a. [a] -> [a]
    reverse (FilePath -> [FilePath]
    splitDirectories FilePath
    rootDirectory))

        dirAsFile :: File
    dirAsFile = Directory -> Text -> File
    File ([Text] -> Directory
    Directory [Text]
    pathComponents) "."

        -- Fake import to set the directory we're relative to.
        rootImport :: Import
    rootImport = Import :: ImportHashed -> ImportMode -> Import
    Import
          { importHashed :: ImportHashed
    importHashed = ImportHashed :: Maybe SHA256Digest -> ImportType -> ImportHashed
    ImportHashed
            { hash :: Maybe SHA256Digest
    hash = Maybe SHA256Digest
    forall a. Maybe a
    Nothing
            , importType :: ImportType
    importType = FilePrefix -> File -> ImportType
    Local FilePrefix
    prefix File
    dirAsFile
            }
          , importMode :: ImportMode
    importMode = ImportMode
    Code
          }

    -- | Lens from a `Status` to its `_stack` field
    stack :: Functor f => LensLike' f Status (NonEmpty Chained)
    stack :: LensLike' f Status (NonEmpty Chained)
    stack k :: NonEmpty Chained -> f (NonEmpty Chained)
    k s :: Status
    s = (NonEmpty Chained -> Status) -> f (NonEmpty Chained) -> f Status
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\x :: NonEmpty Chained
    x -> Status
    s { _stack :: NonEmpty Chained
    _stack = NonEmpty Chained
    x }) (NonEmpty Chained -> f (NonEmpty Chained)
    k (Status -> NonEmpty Chained
    _stack Status
    s))

    -- | Lens from a `Status` to its `_graph` field
    graph :: Functor f => LensLike' f Status [Depends]
    graph :: LensLike' f Status [Depends]
    graph k :: [Depends] -> f [Depends]
    k s :: Status
    s = ([Depends] -> Status) -> f [Depends] -> f Status
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\x :: [Depends]
    x -> Status
    s { _graph :: [Depends]
    _graph = [Depends]
    x }) ([Depends] -> f [Depends]
    k (Status -> [Depends]
    _graph Status
    s))

    -- | Lens from a `Status` to its `_cache` field
    cache :: Functor f => LensLike' f Status (Map Chained ImportSemantics)
    cache :: LensLike' f Status (Map Chained ImportSemantics)
    cache k :: Map Chained ImportSemantics -> f (Map Chained ImportSemantics)
    k s :: Status
    s = (Map Chained ImportSemantics -> Status)
    -> f (Map Chained ImportSemantics) -> f Status
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\x :: Map Chained ImportSemantics
    x -> Status
    s { _cache :: Map Chained ImportSemantics
    _cache = Map Chained ImportSemantics
    x }) (Map Chained ImportSemantics -> f (Map Chained ImportSemantics)
    k (Status -> Map Chained ImportSemantics
    _cache Status
    s))

    -- | Lens from a `Status` to its `_remote` field
    remote
        :: Functor f => LensLike' f Status (URL -> StateT Status IO Data.Text.Text)
    remote :: LensLike' f Status (URL -> StateT Status IO Text)
    remote k :: (URL -> StateT Status IO Text) -> f (URL -> StateT Status IO Text)
    k s :: Status
    s = ((URL -> StateT Status IO Text) -> Status)
    -> f (URL -> StateT Status IO Text) -> f Status
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\x :: URL -> StateT Status IO Text
    x -> Status
    s { _remote :: URL -> StateT Status IO Text
    _remote = URL -> StateT Status IO Text
    x }) ((URL -> StateT Status IO Text) -> f (URL -> StateT Status IO Text)
    k (Status -> URL -> StateT Status IO Text
    _remote Status
    s))

    -- | Lens from a `Status` to its `_substitutions` field
    substitutions :: Functor f => LensLike' f Status (Dhall.Substitution.Substitutions Src Void)
    substitutions :: LensLike' f Status (Substitutions Src Void)
    substitutions k :: Substitutions Src Void -> f (Substitutions Src Void)
    k s :: Status
    s =
        (Substitutions Src Void -> Status)
    -> f (Substitutions Src Void) -> f Status
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\x :: Substitutions Src Void
    x -> Status
    s { _substitutions :: Substitutions Src Void
    _substitutions = Substitutions Src Void
    x }) (Substitutions Src Void -> f (Substitutions Src Void)
    k (Status -> Substitutions Src Void
    _substitutions Status
    s))

    -- | Lens from a `Status` to its `_normalizer` field
    normalizer :: Functor f => LensLike' f Status (Maybe (ReifiedNormalizer Void))
    normalizer :: LensLike' f Status (Maybe (ReifiedNormalizer Void))
    normalizer k :: Maybe (ReifiedNormalizer Void)
    -> f (Maybe (ReifiedNormalizer Void))
    k s :: Status
    s = (Maybe (ReifiedNormalizer Void) -> Status)
    -> f (Maybe (ReifiedNormalizer Void)) -> f Status
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\x :: Maybe (ReifiedNormalizer Void)
    x -> Status
    s {_normalizer :: Maybe (ReifiedNormalizer Void)
    _normalizer = Maybe (ReifiedNormalizer Void)
    x}) (Maybe (ReifiedNormalizer Void)
    -> f (Maybe (ReifiedNormalizer Void))
    k (Status -> Maybe (ReifiedNormalizer Void)
    _normalizer Status
    s))

    -- | Lens from a `Status` to its `_startingContext` field
    startingContext :: Functor f => LensLike' f Status (Context (Expr Src Void))
    startingContext :: LensLike' f Status (Context (Expr Src Void))
    startingContext k :: Context (Expr Src Void) -> f (Context (Expr Src Void))
    k s :: Status
    s =
        (Context (Expr Src Void) -> Status)
    -> f (Context (Expr Src Void)) -> f Status
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\x :: Context (Expr Src Void)
    x -> Status
    s { _startingContext :: Context (Expr Src Void)
    _startingContext = Context (Expr Src Void)
    x }) (Context (Expr Src Void) -> f (Context (Expr Src Void))
    k (Status -> Context (Expr Src Void)
    _startingContext Status
    s))

    {-| This exception indicates that there was an internal error in Dhall's
        import-related logic
        the `expected` type then the `extract` function must succeed.  If not, then
        this exception is thrown

        This exception indicates that an invalid `Type` was provided to the `input`
        function
    -}
    data InternalError = InternalError deriving (Typeable)

    instance Show InternalError where
        show :: InternalError -> FilePath
    show InternalError = [FilePath] -> FilePath
    unlines
            [ FilePath
    _ERROR FilePath -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ": Compiler bug                                                        "
            , "                                                                                "
            , "Explanation: This error message means that there is a bug in the Dhall compiler."
            , "You didn't do anything wrong, but if you would like to see this problem fixed   "
            , "then you should report the bug at:                                              "
            , "                                                                                "
            , "https://github.com/dhall-lang/dhall-haskell/issues                              "
            , "                                                                                "
            , "Please include the following text in your bug report:                           "
            , "                                                                                "
            , "```                                                                             "
            , "Header extraction failed even though the header type-checked                    "
            , "```                                                                             "
            ]
          where
            _ERROR :: String
            _ERROR :: FilePath
    _ERROR = "\ESC[1;31mError\ESC[0m"

    instance Exception InternalError

    -- | Wrapper around `HttpException`s with a prettier `Show` instance.
    --
    -- In order to keep the library API constant even when the @with-http@ Cabal
    -- flag is disabled the pretty error message is pre-rendered and the real
    -- 'HttpExcepion' is stored in a 'Dynamic'
    data PrettyHttpException = PrettyHttpException String Dynamic
        deriving (Typeable)

    instance Exception PrettyHttpException

    instance Show PrettyHttpException where
      show :: PrettyHttpException -> FilePath
    show (PrettyHttpException msg :: FilePath
    msg _) = FilePath
    msg