Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Freeze expressions providing a custom context and normalizer #2478

Merged
merged 2 commits into from
Jan 5, 2023
Merged

Freeze expressions providing a custom context and normalizer #2478

Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
d1092b3
Added functions to freeze expressions providing a custom context and …
mmhat Dec 29, 2022
4c90ea7
Use EvaluateSettings in customizable Dhall.Freeze functions
mmhat Jan 4, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
222 changes: 140 additions & 82 deletions dhall/src/Dhall/Freeze.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}

Expand All @@ -7,22 +8,31 @@
module Dhall.Freeze
( -- * Freeze
freeze
, freezeWithManager
, freezeExpression
, freezeExpressionWithManager
, freezeImport
, freezeImportWithManager
, freezeRemoteImport
, freezeRemoteImportWithManager

-- * 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 (..)
Expand All @@ -39,11 +49,13 @@ import Dhall.Util
, 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
Expand All @@ -57,21 +69,120 @@ 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 = freezeImportWithManager Dhall.Import.defaultNewManager
freezeImport = freezeImportWithSettings Dhall.defaultEvaluateSettings

-- | See 'freezeImport'.
freezeImportWithManager
:: IO Dhall.Import.Manager
-> FilePath
-> Import
-> IO Import
freezeImportWithManager newManager directory import_ = do
freezeImportWithManager newManager = freezeImportWithSettings (set Dhall.newManager newManager 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 = freezeRemoteImportWithSettings Dhall.defaultEvaluateSettings

-- | See 'freezeRemoteImport'.
freezeRemoteImportWithManager
:: IO Dhall.Import.Manager
-> FilePath
-> Import
-> IO Import
freezeRemoteImportWithManager newManager = freezeRemoteImportWithSettings (set Dhall.newManager newManager 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 = freezeWithSettings Dhall.defaultEvaluateSettings

-- | See 'freeze'.
freezeWithManager
:: IO Dhall.Import.Manager
-> OutputMode
-> Transitivity
-> NonEmpty Input
-> Scope
-> Intent
-> Maybe CharacterSet
-> Censor
-> IO ()
freezeWithManager newManager = freezeWithSettings (set Dhall.newManager newManager 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 = freezeExpressionWithSettings Dhall.defaultEvaluateSettings

-- | See 'freezeExpression'.
freezeExpressionWithManager
:: IO Dhall.Import.Manager
-> FilePath
-> Scope
-> Intent
-> Expr s Import
-> IO (Expr s Import)
freezeExpressionWithManager newManager = freezeExpressionWithSettings (set Dhall.newManager newManager Dhall.defaultEvaluateSettings)
{-# DEPRECATED freezeExpressionWithManager "Use freezeExpressionWithSettings directly" #-}

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

-- | See 'freezeImport'.
freezeImportWithSettings
:: EvaluateSettings
-> FilePath
-> Import
-> IO Import
freezeImportWithSettings settings directory import_ = do
let unprotectedImport =
import_
{ importHashed =
Expand All @@ -80,15 +191,15 @@ freezeImportWithManager newManager directory import_ = do
}
}

let status = Dhall.Import.emptyStatusWithManager newManager directory
let status = Dhall.Import.emptyStatusWithManager (view Dhall.newManager settings) directory

expression <- State.evalStateT (Dhall.Import.loadWith (Embed unprotectedImport)) status

case Dhall.TypeCheck.typeOf expression of
case Dhall.TypeCheck.typeWith (view Dhall.startingContext settings) expression of
Left exception -> Exception.throwIO exception
Right _ -> return ()

let normalizedExpression = Core.alphaNormalize (Core.normalize expression)
let normalizedExpression = Core.alphaNormalize (Core.normalizeWith (view Dhall.normalizer settings) expression)

-- make sure the frozen import is present in the semantic cache
Dhall.Import.writeExpressionToSemanticCache (Core.denote expression)
Expand All @@ -101,58 +212,20 @@ freezeImportWithManager newManager directory import_ = do

return newImport

-- | Freeze an import only if the import is a `Remote` import
freezeRemoteImport
:: FilePath
-- ^ Current working directory
-> Import
-> IO Import
freezeRemoteImport = freezeRemoteImportWithManager Dhall.Import.defaultNewManager

-- | See 'freezeRemoteImport'.
freezeRemoteImportWithManager
:: IO Dhall.Import.Manager
freezeRemoteImportWithSettings
:: EvaluateSettings
-> FilePath
-> Import
-> IO Import
freezeRemoteImportWithManager newManager directory import_ =
freezeRemoteImportWithSettings settings directory import_ =
case importType (importHashed import_) of
Remote {} -> freezeImportWithManager newManager directory import_
Remote {} -> freezeImportWithSettings settings directory import_
_ -> return import_

-- | 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
-> Transitivity
-> NonEmpty Input
-> Scope
-> Intent
-> Maybe CharacterSet
-> Censor
-> IO ()
freeze = freezeWithManager Dhall.Import.defaultNewManager

-- | See 'freeze'.
freezeWithManager
:: IO Dhall.Import.Manager
freezeWithSettings
:: EvaluateSettings
-> OutputMode
-> Transitivity
-> NonEmpty Input
Expand All @@ -161,7 +234,7 @@ freezeWithManager
-> Maybe CharacterSet
-> Censor
-> IO ()
freezeWithManager newManager outputMode transitivity0 inputs scope intent chosenCharacterSet censor =
freezeWithSettings settings outputMode transitivity0 inputs scope intent chosenCharacterSet censor =
handleMultipleChecksFailed "freeze" "frozen" go inputs
where
go input = do
Expand All @@ -171,7 +244,7 @@ freezeWithManager newManager outputMode transitivity0 inputs scope intent chosen
InputFile file ->
System.FilePath.takeDirectory file

let status = Dhall.Import.emptyStatusWithManager newManager directory
let status = Dhall.Import.emptyStatusWithManager (view Dhall.newManager settings) directory

(inputName, originalText, transitivity) <- case input of
InputFile file -> do
Expand Down Expand Up @@ -199,7 +272,7 @@ freezeWithManager newManager outputMode transitivity0 inputs scope intent chosen
NonTransitive ->
return ()

frozenExpression <- freezeExpressionWithManager newManager directory scope intent parsedExpression
frozenExpression <- freezeExpressionWithSettings settings directory scope intent parsedExpression

let doc = Pretty.pretty header
<> Dhall.Pretty.prettyCharacterSet characterSet frozenExpression
Expand Down Expand Up @@ -238,41 +311,21 @@ freezeWithManager newManager outputMode transitivity0 inputs scope intent chosen
then Right ()
else Left 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 = freezeExpressionWithManager Dhall.Import.defaultNewManager

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


-- | See 'freezeExpression'.
freezeExpressionWithManager
:: IO Dhall.Import.Manager
freezeExpressionWithSettings
:: EvaluateSettings
-> FilePath
-> Scope
-> Intent
-> Expr s Import
-> IO (Expr s Import)
freezeExpressionWithManager newManager directory scope intent expression = do
freezeExpressionWithSettings settings directory scope intent expression = do
let freezeScope =
case scope of
AllImports -> freezeImportWithManager
OnlyRemoteImports -> freezeRemoteImportWithManager
AllImports -> freezeImportWithSettings
OnlyRemoteImports -> freezeRemoteImportWithSettings

let freezeFunction = freezeScope newManager directory
let freezeFunction = freezeScope settings directory

let cache
-- This case is necessary because `transformOf` is a bottom-up
Expand Down Expand Up @@ -353,3 +406,8 @@ freezeExpressionWithManager newManager directory scope intent expression = do
traverse freezeFunction expression
Cache ->
Dhall.Optics.transformMOf Core.subExpressions cache expression

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