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

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

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

      -- * Freeze with custom evaluation settings
    , freezeWithSettings
    , freezeExpressionWithSettings
    , freezeImportWithSettings
    , freezeRemoteImportWithSettings

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

      -- * Deprecated functions
    , freezeWithManager
    , freezeExpressionWithManager
    , freezeImportWithManager
    , freezeRemoteImportWithManager
    ) where

import Data.Foldable       (for_)
import Data.List.NonEmpty  (NonEmpty)
import Data.Maybe          (fromMaybe)
import Dhall               (EvaluateSettings)
import Dhall.Pretty        (CharacterSet, detectCharacterSet)
import Dhall.Syntax
    ( Expr (..)
    , Import (..)
    , ImportHashed (..)
    , ImportType (..)
    )
import Dhall.Util
    ( Censor
    , CheckFailed (..)
    , Header (..)
    , Input (..)
    , OutputMode (..)
    , Transitivity (..)
    , handleMultipleChecksFailed
    )
import Lens.Family         (set, view)
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 Dhall
import qualified Dhall.Core                         as Core
import qualified Dhall.Import
import qualified Dhall.Optics
import qualified Dhall.Pretty
import qualified Dhall.TypeCheck
import qualified Dhall.Util                         as Util
import qualified Prettyprinter                      as Pretty
import qualified Prettyprinter.Render.Terminal      as Pretty
import qualified Prettyprinter.Render.Text          as Pretty.Text
import qualified System.AtomicWrite.Writer.LazyText as AtomicWrite.LazyText
import qualified System.FilePath
import qualified System.IO

-- | 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.

-- | 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 = EvaluateSettings -> FilePath -> Import -> IO Import
freezeImportWithSettings EvaluateSettings
Dhall.defaultEvaluateSettings

-- | See 'freezeImport'.
freezeImportWithManager
    :: IO Dhall.Import.Manager
    -> FilePath
    -> Import
    -> IO Import
freezeImportWithManager :: IO Manager -> FilePath -> Import -> IO Import
freezeImportWithManager IO Manager
newManager = EvaluateSettings -> FilePath -> Import -> IO Import
freezeImportWithSettings (forall s t a b. ASetter s t a b -> b -> s -> t
set forall (f :: * -> *) s.
(Functor f, HasEvaluateSettings s) =>
LensLike' f s (IO Manager)
Dhall.newManager IO Manager
newManager EvaluateSettings
Dhall.defaultEvaluateSettings)
{-# DEPRECATED freezeImportWithManager "Use freezeImportWithSettings directly" #-}

-- | 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 = EvaluateSettings -> FilePath -> Import -> IO Import
freezeRemoteImportWithSettings EvaluateSettings
Dhall.defaultEvaluateSettings

-- | See 'freezeRemoteImport'.
freezeRemoteImportWithManager
    :: IO Dhall.Import.Manager
    -> FilePath
    -> Import
    -> IO Import
freezeRemoteImportWithManager :: IO Manager -> FilePath -> Import -> IO Import
freezeRemoteImportWithManager IO Manager
newManager = EvaluateSettings -> FilePath -> Import -> IO Import
freezeRemoteImportWithSettings (forall s t a b. ASetter s t a b -> b -> s -> t
set forall (f :: * -> *) s.
(Functor f, HasEvaluateSettings s) =>
LensLike' f s (IO Manager)
Dhall.newManager IO Manager
newManager EvaluateSettings
Dhall.defaultEvaluateSettings)
{-# DEPRECATED freezeRemoteImportWithManager "Use freezeRemoteImportWithSettings directly" #-}

-- | Implementation of the @dhall freeze@ subcommand
freeze
    :: OutputMode
    -> Transitivity
    -> NonEmpty Input
    -> Scope
    -> Intent
    -> Maybe CharacterSet
    -> Censor
    -> IO ()
freeze :: OutputMode
-> Transitivity
-> NonEmpty Input
-> Scope
-> Intent
-> Maybe CharacterSet
-> Censor
-> IO ()
freeze = EvaluateSettings
-> OutputMode
-> Transitivity
-> NonEmpty Input
-> Scope
-> Intent
-> Maybe CharacterSet
-> Censor
-> IO ()
freezeWithSettings EvaluateSettings
Dhall.defaultEvaluateSettings

-- | See 'freeze'.
freezeWithManager
    :: IO Dhall.Import.Manager
    -> OutputMode
    -> Transitivity
    -> NonEmpty Input
    -> Scope
    -> Intent
    -> Maybe CharacterSet
    -> Censor
    -> IO ()
freezeWithManager :: IO Manager
-> OutputMode
-> Transitivity
-> NonEmpty Input
-> Scope
-> Intent
-> Maybe CharacterSet
-> Censor
-> IO ()
freezeWithManager IO Manager
newManager = EvaluateSettings
-> OutputMode
-> Transitivity
-> NonEmpty Input
-> Scope
-> Intent
-> Maybe CharacterSet
-> Censor
-> IO ()
freezeWithSettings (forall s t a b. ASetter s t a b -> b -> s -> t
set forall (f :: * -> *) s.
(Functor f, HasEvaluateSettings s) =>
LensLike' f s (IO Manager)
Dhall.newManager IO Manager
newManager EvaluateSettings
Dhall.defaultEvaluateSettings)
{-# DEPRECATED freezeWithManager "Use freezeWithSettings directly" #-}

{-| 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 :: forall s.
FilePath -> Scope -> Intent -> Expr s Import -> IO (Expr s Import)
freezeExpression = forall s.
EvaluateSettings
-> FilePath
-> Scope
-> Intent
-> Expr s Import
-> IO (Expr s Import)
freezeExpressionWithSettings EvaluateSettings
Dhall.defaultEvaluateSettings

-- | See 'freezeExpression'.
freezeExpressionWithManager
    :: IO Dhall.Import.Manager
    -> FilePath
    -> Scope
    -> Intent
    -> Expr s Import
    -> IO (Expr s Import)
freezeExpressionWithManager :: forall s.
IO Manager
-> FilePath
-> Scope
-> Intent
-> Expr s Import
-> IO (Expr s Import)
freezeExpressionWithManager IO Manager
newManager = forall s.
EvaluateSettings
-> FilePath
-> Scope
-> Intent
-> Expr s Import
-> IO (Expr s Import)
freezeExpressionWithSettings (forall s t a b. ASetter s t a b -> b -> s -> t
set forall (f :: * -> *) s.
(Functor f, HasEvaluateSettings s) =>
LensLike' f s (IO Manager)
Dhall.newManager IO Manager
newManager EvaluateSettings
Dhall.defaultEvaluateSettings)
{-# DEPRECATED freezeExpressionWithManager "Use freezeExpressionWithSettings directly" #-}

--------------------------------------------------------------------------------
-- Versions that take EvaluateSettings
--------------------------------------------------------------------------------

-- | See 'freezeImport'.
freezeImportWithSettings
    :: EvaluateSettings
    -> FilePath
    -> Import
    -> IO Import
freezeImportWithSettings :: EvaluateSettings -> FilePath -> Import -> IO Import
freezeImportWithSettings EvaluateSettings
settings FilePath
directory Import
import_ = do
    let unprotectedImport :: Import
unprotectedImport =
            Import
import_
                { importHashed :: ImportHashed
importHashed =
                    (Import -> ImportHashed
importHashed Import
import_)
                        { hash :: Maybe SHA256Digest
hash = forall a. Maybe a
Nothing
                        }
                }

    let status :: Status
status = IO Manager -> FilePath -> Status
Dhall.Import.emptyStatusWithManager (forall a s t b. FoldLike a s t a b -> s -> a
view forall (f :: * -> *) s.
(Functor f, HasEvaluateSettings s) =>
LensLike' f s (IO Manager)
Dhall.newManager EvaluateSettings
settings) FilePath
directory

    Expr Src X
expression <- forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
State.evalStateT (Expr Src Import -> StateT Status IO (Expr Src X)
Dhall.Import.loadWith (forall s a. a -> Expr s a
Embed Import
unprotectedImport)) Status
status

    case forall s.
Context (Expr s X) -> Expr s X -> Either (TypeError s X) (Expr s X)
Dhall.TypeCheck.typeWith (forall a s t b. FoldLike a s t a b -> s -> a
view forall (f :: * -> *) s.
(Functor f, HasEvaluateSettings s) =>
LensLike' f s (Context (Expr Src X))
Dhall.startingContext EvaluateSettings
settings) Expr Src X
expression of
        Left  TypeError Src X
exception -> forall e a. Exception e => e -> IO a
Exception.throwIO TypeError Src X
exception
        Right Expr Src X
_         -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

    let normalizedExpression :: Expr s X
normalizedExpression = forall s a. Expr s a -> Expr s a
Core.alphaNormalize (forall a s t.
Eq a =>
Maybe (ReifiedNormalizer a) -> Expr s a -> Expr t a
Core.normalizeWith (forall a s t b. FoldLike a s t a b -> s -> a
view forall (f :: * -> *) s.
(Functor f, HasEvaluateSettings s) =>
LensLike' f s (Maybe (ReifiedNormalizer X))
Dhall.normalizer EvaluateSettings
settings) Expr Src X
expression)

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

    let expressionHash :: SHA256Digest
expressionHash = Expr X X -> SHA256Digest
Dhall.Import.hashExpression forall {s}. Expr s X
normalizedExpression

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

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

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

-- | See 'freezeRemoteImport'.
freezeRemoteImportWithSettings
    :: EvaluateSettings
    -> FilePath
    -> Import
    -> IO Import
freezeRemoteImportWithSettings :: EvaluateSettings -> FilePath -> Import -> IO Import
freezeRemoteImportWithSettings EvaluateSettings
settings FilePath
directory Import
import_ =
    case ImportHashed -> ImportType
importType (Import -> ImportHashed
importHashed Import
import_) of
        Remote {} -> EvaluateSettings -> FilePath -> Import -> IO Import
freezeImportWithSettings EvaluateSettings
settings FilePath
directory Import
import_
        ImportType
_         -> forall (m :: * -> *) a. Monad m => a -> m a
return Import
import_

-- | See 'freezeRemoteImport'.
freezeNonMissingImportWithSettings
    :: EvaluateSettings
    -> FilePath
    -> Import
    -> IO Import
freezeNonMissingImportWithSettings :: EvaluateSettings -> FilePath -> Import -> IO Import
freezeNonMissingImportWithSettings EvaluateSettings
settings FilePath
directory Import
import_ =
    case ImportHashed -> ImportType
importType (Import -> ImportHashed
importHashed Import
import_) of
        ImportType
Missing -> forall (m :: * -> *) a. Monad m => a -> m a
return Import
import_
        ImportType
_ -> EvaluateSettings -> FilePath -> Import -> IO Import
freezeImportWithSettings EvaluateSettings
settings FilePath
directory Import
import_

-- | See 'freeze'.
freezeWithSettings
    :: EvaluateSettings
    -> OutputMode
    -> Transitivity
    -> NonEmpty Input
    -> Scope
    -> Intent
    -> Maybe CharacterSet
    -> Censor
    -> IO ()
freezeWithSettings :: EvaluateSettings
-> OutputMode
-> Transitivity
-> NonEmpty Input
-> Scope
-> Intent
-> Maybe CharacterSet
-> Censor
-> IO ()
freezeWithSettings EvaluateSettings
settings OutputMode
outputMode Transitivity
transitivity0 NonEmpty Input
inputs Scope
scope Intent
intent Maybe CharacterSet
chosenCharacterSet Censor
censor =
    forall (t :: * -> *) a.
(Foldable t, Traversable t) =>
Text -> Text -> (a -> IO (Either CheckFailed ())) -> t a -> IO ()
handleMultipleChecksFailed Text
"freeze" Text
"frozen" Input -> IO (Either CheckFailed ())
go NonEmpty Input
inputs
  where
    go :: Input -> IO (Either CheckFailed ())
go Input
input = do
        let directory :: FilePath
directory = case Input
input of
                Input
StandardInput ->
                    FilePath
"."
                InputFile FilePath
file ->
                    FilePath -> FilePath
System.FilePath.takeDirectory FilePath
file

        let status :: Status
status = IO Manager -> FilePath -> Status
Dhall.Import.emptyStatusWithManager (forall a s t b. FoldLike a s t a b -> s -> a
view forall (f :: * -> *) s.
(Functor f, HasEvaluateSettings s) =>
LensLike' f s (IO Manager)
Dhall.newManager EvaluateSettings
settings) FilePath
directory

        (FilePath
inputName, Text
originalText, Transitivity
transitivity) <- case Input
input of
            InputFile FilePath
file -> do
                Text
text <- FilePath -> IO Text
Text.IO.readFile FilePath
file

                forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
file, Text
text, Transitivity
transitivity0)

            Input
StandardInput -> do
                Text
text <- IO Text
Text.IO.getContents

                forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
"(input)", Text
text, Transitivity
NonTransitive)

        (Header Text
header, Expr Src Import
parsedExpression) <- Censor -> FilePath -> Text -> IO (Header, Expr Src Import)
Util.getExpressionAndHeaderFromStdinText Censor
censor FilePath
inputName Text
originalText

        let characterSet :: CharacterSet
characterSet = forall a. a -> Maybe a -> a
fromMaybe (forall a. Expr Src a -> CharacterSet
detectCharacterSet Expr Src Import
parsedExpression) Maybe CharacterSet
chosenCharacterSet

        case Transitivity
transitivity of
            Transitivity
Transitive ->
                forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Expr Src Import
parsedExpression forall a b. (a -> b) -> a -> b
$ \Import
import_ -> do
                    Maybe FilePath
maybeFilepath <- Status -> Import -> IO (Maybe FilePath)
Dhall.Import.dependencyToFile Status
status Import
import_

                    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe FilePath
maybeFilepath forall a b. (a -> b) -> a -> b
$ \FilePath
filepath ->
                        Input -> IO (Either CheckFailed ())
go (FilePath -> Input
InputFile FilePath
filepath)

            Transitivity
NonTransitive ->
                forall (m :: * -> *) a. Monad m => a -> m a
return ()

        Expr Src Import
frozenExpression <- forall s.
EvaluateSettings
-> FilePath
-> Scope
-> Intent
-> Expr s Import
-> IO (Expr s Import)
freezeExpressionWithSettings EvaluateSettings
settings FilePath
directory Scope
scope Intent
intent Expr Src Import
parsedExpression

        let doc :: Doc Ann
doc =  forall a ann. Pretty a => a -> Doc ann
Pretty.pretty Text
header
                forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => CharacterSet -> Expr Src a -> Doc Ann
Dhall.Pretty.prettyCharacterSet CharacterSet
characterSet Expr Src Import
frozenExpression
                forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n"

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

        let modifiedText :: Text
modifiedText = forall ann. SimpleDocStream ann -> Text
Pretty.Text.renderStrict SimpleDocStream Ann
stream

        case OutputMode
outputMode of
            OutputMode
Write -> do
                let unAnnotated :: SimpleDocStream xxx
unAnnotated = forall ann xxx. SimpleDocStream ann -> SimpleDocStream xxx
Pretty.unAnnotateS SimpleDocStream Ann
stream

                case Input
input of
                    InputFile FilePath
file ->
                        if Text
originalText forall a. Eq a => a -> a -> Bool
== Text
modifiedText
                            then forall (m :: * -> *) a. Monad m => a -> m a
return ()
                            else
                                FilePath -> Text -> IO ()
AtomicWrite.LazyText.atomicWriteFile
                                    FilePath
file
                                    (forall ann. SimpleDocStream ann -> Text
Pretty.Text.renderLazy forall {xxx}. SimpleDocStream xxx
unAnnotated)

                    Input
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 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 forall {xxx}. SimpleDocStream xxx
unAnnotated

                forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right ())

            OutputMode
Check ->
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                    if Text
originalText forall a. Eq a => a -> a -> Bool
== Text
modifiedText
                        then forall a b. b -> Either a b
Right ()
                        else forall a b. a -> Either a b
Left CheckFailed{Input
input :: Input
input :: Input
..}

-- | See 'freezeExpression'.
freezeExpressionWithSettings
    :: EvaluateSettings
    -> FilePath
    -> Scope
    -> Intent
    -> Expr s Import
    -> IO (Expr s Import)
freezeExpressionWithSettings :: forall s.
EvaluateSettings
-> FilePath
-> Scope
-> Intent
-> Expr s Import
-> IO (Expr s Import)
freezeExpressionWithSettings EvaluateSettings
settings FilePath
directory Scope
scope Intent
intent Expr s Import
expression = do
    let freezeScope :: EvaluateSettings -> FilePath -> Import -> IO Import
freezeScope =
            case Scope
scope of
                Scope
AllImports        -> EvaluateSettings -> FilePath -> Import -> IO Import
freezeNonMissingImportWithSettings
                Scope
OnlyRemoteImports -> EvaluateSettings -> FilePath -> Import -> IO Import
freezeRemoteImportWithSettings

    let freezeFunction :: Import -> IO Import
freezeFunction = EvaluateSettings -> FilePath -> Import -> IO Import
freezeScope EvaluateSettings
settings 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
                (forall s a. Expr s a -> Expr s a
Core.shallowDenote -> ImportAlt
                    (forall s a. Expr s a -> Expr s a
Core.shallowDenote -> Embed
                        Import{ importHashed :: Import -> ImportHashed
importHashed = ImportHashed{ hash :: ImportHashed -> Maybe SHA256Digest
hash = Just SHA256Digest
_expectedHash } }
                    )
                    (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_@(forall s a. Expr s a -> Expr s a
Core.shallowDenote -> ImportAlt
                    (forall s a. Expr s a -> Expr s a
Core.shallowDenote -> Embed
                        Import{ importHashed :: Import -> ImportHashed
importHashed = ImportHashed{ hash :: ImportHashed -> Maybe SHA256Digest
hash = Just SHA256Digest
_actualHash } }
                    )
                    (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 } }
                    )
                )
            ) =
                {- 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.
                -}
                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_

                let frozenMissing :: Import
frozenMissing = Import -> Import
toMissing Import
frozenImport

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

                let frozenMissing :: Import
frozenMissing = Import -> Import
toMissing Import
frozenImport

                -- `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 = forall a. Maybe a
Nothing
                            }
                        }

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

    let uncache :: Expr s Import -> Expr s Import
uncache
            (ImportAlt
                (forall s a. Expr s a -> Expr s a
Core.shallowDenote -> Embed
                    Import{ importHashed :: Import -> ImportHashed
importHashed = ImportHashed { hash :: ImportHashed -> Maybe SHA256Digest
hash = Just SHA256Digest
expectedHash, importType :: ImportHashed -> ImportType
importType = ImportType
Missing } }
                )
                (forall s a. Expr s a -> Expr s a
Core.shallowDenote -> Embed
                    import_ :: Import
import_@Import{ importHashed :: Import -> ImportHashed
importHashed = ImportHashed{ hash :: ImportHashed -> Maybe SHA256Digest
hash = Maybe SHA256Digest
Nothing } }
                )
            ) = forall s a. a -> Expr s a
Embed
                (Import
import_
                    { importHashed :: ImportHashed
importHashed = (Import -> ImportHashed
importHashed Import
import_)
                        { hash :: Maybe SHA256Digest
hash = forall a. a -> Maybe a
Just SHA256Digest
expectedHash
                        }
                    }
                )
        uncache Expr s Import
expression_ = Expr s Import
expression_

    let simplify :: Expr s a -> Expr s a
simplify (ImportAlt (forall s a. Expr s a -> Expr s a
Core.shallowDenote -> Embed a
import1) (forall s a. Expr s a -> Expr s a
Core.shallowDenote -> Embed a
import2))
            | a
import1 forall a. Eq a => a -> a -> Bool
== a
import2 = forall s a. a -> Expr s a
Embed a
import1
        simplify Expr s a
expression_ = Expr s a
expression_

    forall a b. ASetter a b a b -> (b -> b) -> a -> b
Dhall.Optics.transformOf forall (f :: * -> *) s a.
Applicative f =>
(Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
Core.subExpressions forall {a} {s}. Eq a => Expr s a -> Expr s a
simplify forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Intent
intent of
        Intent
Secure ->
            forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Import -> IO Import
freezeFunction (forall a b. ASetter a b a b -> (b -> b) -> a -> b
Dhall.Optics.transformOf forall (f :: * -> *) s a.
Applicative f =>
(Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
Core.subExpressions forall {s}. Expr s Import -> Expr s Import
uncache Expr s Import
expression)
        Intent
Cache  ->
            forall (m :: * -> *) a b.
Monad m =>
LensLike (WrappedMonad m) a b a b -> (b -> m b) -> a -> m b
Dhall.Optics.transformMOf forall (f :: * -> *) s a.
Applicative f =>
(Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
Core.subExpressions forall {s}. Expr s Import -> IO (Expr s Import)
cache Expr s Import
expression

-- https://github.com/dhall-lang/dhall-haskell/issues/2347
toMissing :: Import -> Import
toMissing :: Import -> Import
toMissing Import
import_ =
    Import
import_ { importHashed :: ImportHashed
importHashed = (Import -> ImportHashed
importHashed Import
import_) { importType :: ImportType
importType = ImportType
Missing } }