    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RecordWildCards   #-}
    {-# LANGUAGE ViewPatterns      #-}

    -- | This module contains the implementation of the @dhall freeze@ subcommand

    module Dhall.Freeze
        ( -- * Freeze
          freeze
        , freezeExpression
        , freezeImport
        , freezeRemoteImport

          -- * Types
        , Scope(..)
        , Intent(..)
        ) where

    import Data.Bifunctor (first)
    import Data.Monoid ((<>))
    import Data.Text
    import Dhall.Parser (Src)
    import Dhall.Pretty (CharacterSet)
    import Dhall.Syntax (Expr(..), Import(..), ImportHashed(..), ImportType(..))
    import Dhall.Util
        ( Censor
        , CheckFailed(..)
        , Header(..)
        , Input(..)
        , OutputMode(..)
        )
    import System.Console.ANSI (hSupportsANSI)

    import qualified Control.Exception                         as Exception
    import qualified Control.Monad.Trans.State.Strict          as State
    import qualified Data.Text.IO                              as 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.Core                                as Core
    import qualified Dhall.Import
    import qualified Dhall.Optics
    import qualified Dhall.Parser                              as Parser
    import qualified Dhall.Pretty
    import qualified Dhall.TypeCheck
    import qualified Dhall.Util                                as Util
    import qualified System.AtomicWrite.Writer.LazyText        as AtomicWrite.LazyText
    import qualified System.FilePath
    import qualified System.IO

    -- | Retrieve an `Import` and update the hash to match the latest contents
    freezeImport
        :: FilePath
        -- ^ Current working directory
        -> Import
        -> IO Import
    freezeImport :: FilePath -> Import -> IO Import
    freezeImport directory :: FilePath
    directory import_ :: Import
    import_ = do
        let unprotectedImport :: Import
    unprotectedImport =
                Import
    import_
                    { importHashed :: ImportHashed
    importHashed =
                        (Import -> ImportHashed
    importHashed Import
    import_)
                            { hash :: Maybe SHA256Digest
    hash = Maybe SHA256Digest
    forall a. Maybe a
    Nothing
                            }
                    }

        let status :: Status
    status = FilePath -> Status
    Dhall.Import.emptyStatus FilePath
    directory

        Expr Src Void
    expression <- 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 (Import -> Expr Src Import
    forall s a. a -> Expr s a
    Embed Import
    unprotectedImport)) Status
    status

        case Expr Src Void -> Either (TypeError Src Void) (Expr Src Void)
    forall s. Expr s Void -> Either (TypeError s Void) (Expr s Void)
    Dhall.TypeCheck.typeOf Expr Src Void
    expression of
            Left  exception :: TypeError Src Void
    exception -> TypeError Src Void -> IO ()
    forall e a. Exception e => e -> IO a
    Exception.throwIO TypeError Src Void
    exception
            Right _         -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

        let normalizedExpression :: Expr s Void
    normalizedExpression = Expr s Void -> Expr s Void
    forall s a. Expr s a -> Expr s a
    Core.alphaNormalize (Expr Src Void -> Expr s Void
    forall a s t. Eq a => Expr s a -> Expr t a
    Core.normalize Expr Src Void
    expression)

        -- make sure the frozen import is present in the semantic cache
        Expr Void Void -> IO ()
    Dhall.Import.writeExpressionToSemanticCache (Expr Src Void -> Expr Void Void
    forall s a t. Expr s a -> Expr t a
    Core.denote Expr Src Void
    expression)

        let expressionHash :: SHA256Digest
    expressionHash = Expr Void Void -> SHA256Digest
    Dhall.Import.hashExpression Expr Void Void
    forall s. Expr s Void
    normalizedExpression

        let newImportHashed :: ImportHashed
    newImportHashed = (Import -> ImportHashed
    importHashed Import
    import_) { hash :: Maybe SHA256Digest
    hash = SHA256Digest -> Maybe SHA256Digest
    forall a. a -> Maybe a
    Just SHA256Digest
    expressionHash }

        let newImport :: Import
    newImport = Import
    import_ { importHashed :: ImportHashed
    importHashed = ImportHashed
    newImportHashed }

        Import -> IO Import
    forall (m :: * -> *) a. Monad m => a -> m a
    return Import
    newImport

    -- | Freeze an import only if the import is a `Remote` import
    freezeRemoteImport
        :: FilePath
        -- ^ Current working directory
        -> Import
        -> IO Import
    freezeRemoteImport :: FilePath -> Import -> IO Import
    freezeRemoteImport directory :: FilePath
    directory import_ :: Import
    import_ = do
        case ImportHashed -> ImportType
    importType (Import -> ImportHashed
    importHashed Import
    import_) of
            Remote {} -> FilePath -> Import -> IO Import
    freezeImport FilePath
    directory Import
    import_
            _         -> Import -> IO Import
    forall (m :: * -> *) a. Monad m => a -> m a
    return Import
    import_

    writeExpr :: Input -> (Text, Expr Src Import) -> CharacterSet -> IO ()
    writeExpr :: Input -> (Text, Expr Src Import) -> CharacterSet -> IO ()
    writeExpr input :: Input
    input (header :: Text
    header, expr :: Expr Src Import
    expr) characterSet :: CharacterSet
    characterSet = do
        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
    expr
                Doc Ann -> Doc Ann -> Doc Ann
    forall a. Semigroup a => a -> a -> a
    <> "\n"

        let stream :: SimpleDocStream Ann
    stream = Doc Ann -> SimpleDocStream Ann
    forall ann. Doc ann -> SimpleDocStream ann
    Dhall.Pretty.layout Doc Ann
    doc

        let unAnnotated :: SimpleDocStream xxx
    unAnnotated = SimpleDocStream Ann -> SimpleDocStream xxx
    forall ann xxx. SimpleDocStream ann -> SimpleDocStream xxx
    Pretty.unAnnotateS SimpleDocStream Ann
    stream

        case Input
    input of
            InputFile file :: FilePath
    file ->
                FilePath -> Text -> IO ()
    AtomicWrite.LazyText.atomicWriteFile
                    FilePath
    file
                    (SimpleDocStream Any -> Text
    forall ann. SimpleDocStream ann -> Text
    Pretty.Text.renderLazy SimpleDocStream Any
    forall xxx. SimpleDocStream xxx
    unAnnotated)

            StandardInput -> do
                Bool
    supportsANSI <- Handle -> IO Bool
    System.Console.ANSI.hSupportsANSI Handle
    System.IO.stdout
                if Bool
    supportsANSI
                   then
                     Handle -> SimpleDocStream AnsiStyle -> IO ()
    Pretty.renderIO Handle
    System.IO.stdout (Ann -> AnsiStyle
    Dhall.Pretty.annToAnsiStyle (Ann -> AnsiStyle)
    -> SimpleDocStream Ann -> SimpleDocStream AnsiStyle
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SimpleDocStream Ann
    stream)
                   else
                     Handle -> SimpleDocStream AnsiStyle -> IO ()
    Pretty.renderIO Handle
    System.IO.stdout SimpleDocStream AnsiStyle
    forall xxx. SimpleDocStream xxx
    unAnnotated

    -- | Specifies which imports to freeze
    data Scope
        = OnlyRemoteImports
        -- ^ Freeze only remote imports (i.e. URLs)
        | AllImports
        -- ^ Freeze all imports (including paths and environment variables)

    -- | Specifies why we are adding semantic integrity checks
    data Intent
        = Secure
        -- ^ Protect imports with an integrity check without a fallback so that
        --   import resolution fails if the import changes
        | Cache
        -- ^ Protect imports with an integrity check and also add a fallback import
        --   import without an integrity check.  This is useful if you only want to
        --   cache imports when possible but still gracefully degrade to resolving
        --   them if the semantic integrity check has changed.

    -- | Implementation of the @dhall freeze@ subcommand
    freeze
        :: OutputMode
        -> Input
        -> Scope
        -> Intent
        -> CharacterSet
        -> Censor
        -> IO ()
    freeze :: OutputMode
    -> Input -> Scope -> Intent -> CharacterSet -> Censor -> IO ()
    freeze outputMode :: OutputMode
    outputMode input :: Input
    input scope :: Scope
    scope intent :: Intent
    intent characterSet :: CharacterSet
    characterSet censor :: Censor
    censor = do
        let directory :: FilePath
    directory = case Input
    input of
                StandardInput  -> "."
                InputFile file :: FilePath
    file -> FilePath -> FilePath
    System.FilePath.takeDirectory FilePath
    file

        let rewrite :: Expr s Import -> IO (Expr s Import)
    rewrite = FilePath -> Scope -> Intent -> Expr s Import -> IO (Expr s Import)
    forall s.
    FilePath -> Scope -> Intent -> Expr s Import -> IO (Expr s Import)
    freezeExpression FilePath
    directory Scope
    scope Intent
    intent

        case OutputMode
    outputMode of
            Write -> do
                (Header header :: Text
    header, parsedExpression :: Expr Src Import
    parsedExpression) <- do
                    Censor -> Input -> IO (Header, Expr Src Import)
    Util.getExpressionAndHeader Censor
    censor Input
    input

                Expr Src Import
    frozenExpression <- Expr Src Import -> IO (Expr Src Import)
    forall s. Expr s Import -> IO (Expr s Import)
    rewrite Expr Src Import
    parsedExpression

                Input -> (Text, Expr Src Import) -> CharacterSet -> IO ()
    writeExpr Input
    input (Text
    header, Expr Src Import
    frozenExpression) CharacterSet
    characterSet

            Check -> do
                Text
    originalText <- case Input
    input of
                    InputFile file :: FilePath
    file -> FilePath -> IO Text
    Text.IO.readFile FilePath
    file
                    StandardInput  -> IO Text
    Text.IO.getContents

                let name :: FilePath
    name = case Input
    input of
                        InputFile file :: FilePath
    file -> FilePath
    file
                        StandardInput  -> "(input)"

                (Header header :: Text
    header, parsedExpression :: Expr Src Import
    parsedExpression) <- 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
    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))

                Expr Src Import
    frozenExpression <- Expr Src Import -> IO (Expr Src Import)
    forall s. Expr s Import -> IO (Expr s Import)
    rewrite Expr Src Import
    parsedExpression

                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
    frozenExpression
                        Doc Ann -> Doc Ann -> Doc Ann
    forall a. Semigroup a => a -> a -> a
    <> "\n"

                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

                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 command :: Text
    command = "freeze"

                        let modified :: Text
    modified = "frozen"

                        CheckFailed -> IO ()
    forall e a. Exception e => e -> IO a
    Exception.throwIO CheckFailed :: Text -> Text -> CheckFailed
    CheckFailed{..}

    {-| Slightly more pure version of the `freeze` function

        This still requires `IO` to freeze the import, but now the input and output
        expression are passed in explicitly
    -}
    freezeExpression
        :: FilePath
        -- ^ Starting directory
        -> Scope
        -> Intent
        -> Expr s Import
        -> IO (Expr s Import)
    freezeExpression :: FilePath -> Scope -> Intent -> Expr s Import -> IO (Expr s Import)
    freezeExpression directory :: FilePath
    directory scope :: Scope
    scope intent :: Intent
    intent expression :: Expr s Import
    expression = do
        let freezeScope :: FilePath -> Import -> IO Import
    freezeScope =
                case Scope
    scope of
                    AllImports        -> FilePath -> Import -> IO Import
    freezeImport
                    OnlyRemoteImports -> FilePath -> Import -> IO Import
    freezeRemoteImport

        let freezeFunction :: Import -> IO Import
    freezeFunction = FilePath -> Import -> IO Import
    freezeScope FilePath
    directory

        let cache :: Expr s Import -> IO (Expr s Import)
    cache
                -- This case is necessary because `transformOf` is a bottom-up
                -- rewrite rule.   Without this rule, if you were to transform a
                -- file that already has a cached expression, like this:
                --
                --     someImport sha256:… ? someImport
                --
                -- ... then you would get:
                --
                --       (someImport sha256:… ? someImport)
                --     ? (someImport sha256:… ? someImport)
                --
                -- ... and this rule fixes that by collapsing that back to:
                --
                --       (someImport sha256:… ? someImport)
                (ImportAlt
                    (Expr s Import -> Expr s Import
    forall s a. Expr s a -> Expr s a
    Core.shallowDenote -> ImportAlt
                        (Expr s Import -> Expr s Import
    forall s a. Expr s a -> Expr s a
    Core.shallowDenote -> Embed
                            Import{ importHashed :: Import -> ImportHashed
    importHashed = ImportHashed{ hash :: ImportHashed -> Maybe SHA256Digest
    hash = Just _expectedHash :: SHA256Digest
    _expectedHash } }
                        )
                        (Expr s Import -> Expr s Import
    forall s a. Expr s a -> Expr s a
    Core.shallowDenote -> Embed
                            Import{ importHashed :: Import -> ImportHashed
    importHashed = ImportHashed{ hash :: ImportHashed -> Maybe SHA256Digest
    hash = Maybe SHA256Digest
    Nothing } }
                        )
                    )
                    import_ :: Expr s Import
    import_@(Expr s Import -> Expr s Import
    forall s a. Expr s a -> Expr s a
    Core.shallowDenote -> ImportAlt
                        (Expr s Import -> Expr s Import
    forall s a. Expr s a -> Expr s a
    Core.shallowDenote -> Embed
                            Import{ importHashed :: Import -> ImportHashed
    importHashed = ImportHashed{ hash :: ImportHashed -> Maybe SHA256Digest
    hash = Just _actualHash :: SHA256Digest
    _actualHash } }
                        )
                        (Expr s Import -> Expr s Import
    forall s a. Expr s a -> Expr s a
    Core.shallowDenote -> Embed
                            Import{ importHashed :: Import -> ImportHashed
    importHashed = ImportHashed{ hash :: ImportHashed -> Maybe SHA256Digest
    hash = Maybe SHA256Digest
    Nothing } }
                        )
                    )
                ) = do
                    {- Here we could actually compare the `_expectedHash` and
                       `_actualHash` to see if they differ, but we choose not to do
                       so and instead automatically accept the `_actualHash`.  This
                       is done for the same reason that the `freeze*` functions
                       ignore hash mismatches: the user intention when using `dhall
                       freeze` is to update the hash, which they expect to possibly
                       change.
                    -}
                    Expr s Import -> IO (Expr s Import)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Expr s Import
    import_
            cache
                (Embed import_ :: Import
    import_@(Import { importHashed :: Import -> ImportHashed
    importHashed = ImportHashed { hash :: ImportHashed -> Maybe SHA256Digest
    hash = Maybe SHA256Digest
    Nothing } })) = do
                    Import
    frozenImport <- Import -> IO Import
    freezeFunction Import
    import_

                    {- The two imports can be the same if the import is local and
                       `freezeFunction` only freezes remote imports by default
                    -}
                    if Import
    frozenImport Import -> Import -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Import
    import_
                        then Expr s Import -> IO (Expr s Import)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr s Import -> Expr s Import -> Expr s Import
    forall s a. Expr s a -> Expr s a -> Expr s a
    ImportAlt (Import -> Expr s Import
    forall s a. a -> Expr s a
    Embed Import
    frozenImport) (Import -> Expr s Import
    forall s a. a -> Expr s a
    Embed Import
    import_))
                        else Expr s Import -> IO (Expr s Import)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Import -> Expr s Import
    forall s a. a -> Expr s a
    Embed Import
    import_)
            cache
                (Embed import_ :: Import
    import_@(Import { importHashed :: Import -> ImportHashed
    importHashed = ImportHashed { hash :: ImportHashed -> Maybe SHA256Digest
    hash = Just _ } })) = do
                    -- Regenerate the integrity check, just in case it's wrong
                    Import
    frozenImport <- Import -> IO Import
    freezeFunction Import
    import_

                    -- `dhall freeze --cache` also works the other way around, adding an
                    -- unprotected fallback import to imports that are already
                    -- protected
                    let thawedImport :: Import
    thawedImport = Import
    import_
                            { importHashed :: ImportHashed
    importHashed = (Import -> ImportHashed
    importHashed Import
    import_)
                                { hash :: Maybe SHA256Digest
    hash = Maybe SHA256Digest
    forall a. Maybe a
    Nothing
                                }
                            }

                    Expr s Import -> IO (Expr s Import)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr s Import -> Expr s Import -> Expr s Import
    forall s a. Expr s a -> Expr s a -> Expr s a
    ImportAlt (Import -> Expr s Import
    forall s a. a -> Expr s a
    Embed Import
    frozenImport) (Import -> Expr s Import
    forall s a. a -> Expr s a
    Embed Import
    thawedImport))
            cache expression_ :: Expr s Import
    expression_ = do
                Expr s Import -> IO (Expr s Import)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Expr s Import
    expression_

        case Intent
    intent of
            Secure ->
                (Import -> IO Import) -> Expr s Import -> IO (Expr s Import)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Import -> IO Import
    freezeFunction Expr s Import
    expression
            Cache  ->
                LensLike
      (WrappedMonad IO)
      (Expr s Import)
      (Expr s Import)
      (Expr s Import)
      (Expr s Import)
    -> (Expr s Import -> IO (Expr s Import))
    -> Expr s Import
    -> IO (Expr s Import)
    forall (m :: * -> *) a b.
    Monad m =>
    LensLike (WrappedMonad m) a b a b -> (b -> m b) -> a -> m b
    Dhall.Optics.transformMOf LensLike
      (WrappedMonad IO)
      (Expr s Import)
      (Expr s Import)
      (Expr s Import)
      (Expr s Import)
    forall (f :: * -> *) s a.
    Applicative f =>
    (Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
    Core.subExpressions Expr s Import -> IO (Expr s Import)
    forall s. Expr s Import -> IO (Expr s Import)
    cache Expr s Import
    expression