Skip to content

Commit f9f0641

Browse files
mmhatmmhat
authored
Freeze expressions using EvaluateSettings (#2478)
This generalizes the previous custom freeze functions and makes it easier to extend with new settings in the future
1 parent 49b9b3e commit f9f0641

File tree

1 file changed

+140
-82
lines changed

1 file changed

+140
-82
lines changed

‎dhall/src/Dhall/Freeze.hs‎

Lines changed: 140 additions & 82 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE OverloadedStrings #-}
2+
{-# LANGUAGE RankNTypes #-}
23
{-# LANGUAGE RecordWildCards #-}
34
{-# LANGUAGE ViewPatterns #-}
45

@@ -7,22 +8,31 @@
78
module Dhall.Freeze
89
( -- * Freeze
910
freeze
10-
, freezeWithManager
1111
, freezeExpression
12-
, freezeExpressionWithManager
1312
, freezeImport
14-
, freezeImportWithManager
1513
, freezeRemoteImport
16-
, freezeRemoteImportWithManager
14+
15+
-- * Freeze with custom evaluation settings
16+
, freezeWithSettings
17+
, freezeExpressionWithSettings
18+
, freezeImportWithSettings
19+
, freezeRemoteImportWithSettings
1720

1821
-- * Types
1922
, Scope(..)
2023
, Intent(..)
24+
25+
-- * Deprecated functions
26+
, freezeWithManager
27+
, freezeExpressionWithManager
28+
, freezeImportWithManager
29+
, freezeRemoteImportWithManager
2130
) where
2231

2332
import Data.Foldable (for_)
2433
import Data.List.NonEmpty (NonEmpty)
2534
import Data.Maybe (fromMaybe)
35+
import Dhall (EvaluateSettings)
2636
import Dhall.Pretty (CharacterSet, detectCharacterSet)
2737
import Dhall.Syntax
2838
( Expr (..)
@@ -39,11 +49,13 @@ import Dhall.Util
3949
, Transitivity (..)
4050
, handleMultipleChecksFailed
4151
)
52+
import Lens.Family (set, view)
4253
import System.Console.ANSI (hSupportsANSI)
4354

4455
import qualified Control.Exception as Exception
4556
import qualified Control.Monad.Trans.State.Strict as State
4657
import qualified Data.Text.IO as Text.IO
58+
import qualified Dhall
4759
import qualified Dhall.Core as Core
4860
import qualified Dhall.Import
4961
import qualified Dhall.Optics
@@ -57,21 +69,120 @@ import qualified System.AtomicWrite.Writer.LazyText as AtomicWrite.LazyText
5769
import qualified System.FilePath
5870
import qualified System.IO
5971

72+
-- | Specifies which imports to freeze
73+
data Scope
74+
= OnlyRemoteImports
75+
-- ^ Freeze only remote imports (i.e. URLs)
76+
| AllImports
77+
-- ^ Freeze all imports (including paths and environment variables)
78+
79+
-- | Specifies why we are adding semantic integrity checks
80+
data Intent
81+
= Secure
82+
-- ^ Protect imports with an integrity check without a fallback so that
83+
-- import resolution fails if the import changes
84+
| Cache
85+
-- ^ Protect imports with an integrity check and also add a fallback import
86+
-- import without an integrity check. This is useful if you only want to
87+
-- cache imports when possible but still gracefully degrade to resolving
88+
-- them if the semantic integrity check has changed.
89+
6090
-- | Retrieve an `Import` and update the hash to match the latest contents
6191
freezeImport
6292
:: FilePath
6393
-- ^ Current working directory
6494
-> Import
6595
-> IO Import
66-
freezeImport = freezeImportWithManager Dhall.Import.defaultNewManager
96+
freezeImport = freezeImportWithSettings Dhall.defaultEvaluateSettings
6797

6898
-- | See 'freezeImport'.
6999
freezeImportWithManager
70100
:: IO Dhall.Import.Manager
71101
-> FilePath
72102
-> Import
73103
-> IO Import
74-
freezeImportWithManager newManager directory import_ = do
104+
freezeImportWithManager newManager = freezeImportWithSettings (set Dhall.newManager newManager Dhall.defaultEvaluateSettings)
105+
{-# DEPRECATED freezeImportWithManager "Use freezeImportWithSettings directly" #-}
106+
107+
-- | Freeze an import only if the import is a `Remote` import
108+
freezeRemoteImport
109+
:: FilePath
110+
-- ^ Current working directory
111+
-> Import
112+
-> IO Import
113+
freezeRemoteImport = freezeRemoteImportWithSettings Dhall.defaultEvaluateSettings
114+
115+
-- | See 'freezeRemoteImport'.
116+
freezeRemoteImportWithManager
117+
:: IO Dhall.Import.Manager
118+
-> FilePath
119+
-> Import
120+
-> IO Import
121+
freezeRemoteImportWithManager newManager = freezeRemoteImportWithSettings (set Dhall.newManager newManager Dhall.defaultEvaluateSettings)
122+
{-# DEPRECATED freezeRemoteImportWithManager "Use freezeRemoteImportWithSettings directly" #-}
123+
124+
-- | Implementation of the @dhall freeze@ subcommand
125+
freeze
126+
:: OutputMode
127+
-> Transitivity
128+
-> NonEmpty Input
129+
-> Scope
130+
-> Intent
131+
-> Maybe CharacterSet
132+
-> Censor
133+
-> IO ()
134+
freeze = freezeWithSettings Dhall.defaultEvaluateSettings
135+
136+
-- | See 'freeze'.
137+
freezeWithManager
138+
:: IO Dhall.Import.Manager
139+
-> OutputMode
140+
-> Transitivity
141+
-> NonEmpty Input
142+
-> Scope
143+
-> Intent
144+
-> Maybe CharacterSet
145+
-> Censor
146+
-> IO ()
147+
freezeWithManager newManager = freezeWithSettings (set Dhall.newManager newManager Dhall.defaultEvaluateSettings)
148+
{-# DEPRECATED freezeWithManager "Use freezeWithSettings directly" #-}
149+
150+
{-| Slightly more pure version of the `freeze` function
151+
152+
This still requires `IO` to freeze the import, but now the input and output
153+
expression are passed in explicitly
154+
-}
155+
freezeExpression
156+
:: FilePath
157+
-- ^ Starting directory
158+
-> Scope
159+
-> Intent
160+
-> Expr s Import
161+
-> IO (Expr s Import)
162+
freezeExpression = freezeExpressionWithSettings Dhall.defaultEvaluateSettings
163+
164+
-- | See 'freezeExpression'.
165+
freezeExpressionWithManager
166+
:: IO Dhall.Import.Manager
167+
-> FilePath
168+
-> Scope
169+
-> Intent
170+
-> Expr s Import
171+
-> IO (Expr s Import)
172+
freezeExpressionWithManager newManager = freezeExpressionWithSettings (set Dhall.newManager newManager Dhall.defaultEvaluateSettings)
173+
{-# DEPRECATED freezeExpressionWithManager "Use freezeExpressionWithSettings directly" #-}
174+
175+
--------------------------------------------------------------------------------
176+
-- Versions that take EvaluateSettings
177+
--------------------------------------------------------------------------------
178+
179+
-- | See 'freezeImport'.
180+
freezeImportWithSettings
181+
:: EvaluateSettings
182+
-> FilePath
183+
-> Import
184+
-> IO Import
185+
freezeImportWithSettings settings directory import_ = do
75186
let unprotectedImport =
76187
import_
77188
{ importHashed =
@@ -80,15 +191,15 @@ freezeImportWithManager newManager directory import_ = do
80191
}
81192
}
82193

83-
let status = Dhall.Import.emptyStatusWithManager newManager directory
194+
let status = Dhall.Import.emptyStatusWithManager (view Dhall.newManager settings) directory
84195

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

87-
case Dhall.TypeCheck.typeOf expression of
198+
case Dhall.TypeCheck.typeWith (view Dhall.startingContext settings) expression of
88199
Left exception -> Exception.throwIO exception
89200
Right _ -> return ()
90201

91-
let normalizedExpression = Core.alphaNormalize (Core.normalize expression)
202+
let normalizedExpression = Core.alphaNormalize (Core.normalizeWith (view Dhall.normalizer settings) expression)
92203

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

102213
return newImport
103214

104-
-- | Freeze an import only if the import is a `Remote` import
105-
freezeRemoteImport
106-
:: FilePath
107-
-- ^ Current working directory
108-
-> Import
109-
-> IO Import
110-
freezeRemoteImport = freezeRemoteImportWithManager Dhall.Import.defaultNewManager
111-
112215
-- | See 'freezeRemoteImport'.
113-
freezeRemoteImportWithManager
114-
:: IO Dhall.Import.Manager
216+
freezeRemoteImportWithSettings
217+
:: EvaluateSettings
115218
-> FilePath
116219
-> Import
117220
-> IO Import
118-
freezeRemoteImportWithManager newManager directory import_ =
221+
freezeRemoteImportWithSettings settings directory import_ =
119222
case importType (importHashed import_) of
120-
Remote {} -> freezeImportWithManager newManager directory import_
223+
Remote {} -> freezeImportWithSettings settings directory import_
121224
_ -> return import_
122225

123-
-- | Specifies which imports to freeze
124-
data Scope
125-
= OnlyRemoteImports
126-
-- ^ Freeze only remote imports (i.e. URLs)
127-
| AllImports
128-
-- ^ Freeze all imports (including paths and environment variables)
129-
130-
-- | Specifies why we are adding semantic integrity checks
131-
data Intent
132-
= Secure
133-
-- ^ Protect imports with an integrity check without a fallback so that
134-
-- import resolution fails if the import changes
135-
| Cache
136-
-- ^ Protect imports with an integrity check and also add a fallback import
137-
-- import without an integrity check. This is useful if you only want to
138-
-- cache imports when possible but still gracefully degrade to resolving
139-
-- them if the semantic integrity check has changed.
140-
141-
-- | Implementation of the @dhall freeze@ subcommand
142-
freeze
143-
:: OutputMode
144-
-> Transitivity
145-
-> NonEmpty Input
146-
-> Scope
147-
-> Intent
148-
-> Maybe CharacterSet
149-
-> Censor
150-
-> IO ()
151-
freeze = freezeWithManager Dhall.Import.defaultNewManager
152-
153226
-- | See 'freeze'.
154-
freezeWithManager
155-
:: IO Dhall.Import.Manager
227+
freezeWithSettings
228+
:: EvaluateSettings
156229
-> OutputMode
157230
-> Transitivity
158231
-> NonEmpty Input
@@ -161,7 +234,7 @@ freezeWithManager
161234
-> Maybe CharacterSet
162235
-> Censor
163236
-> IO ()
164-
freezeWithManager newManager outputMode transitivity0 inputs scope intent chosenCharacterSet censor =
237+
freezeWithSettings settings outputMode transitivity0 inputs scope intent chosenCharacterSet censor =
165238
handleMultipleChecksFailed "freeze" "frozen" go inputs
166239
where
167240
go input = do
@@ -171,7 +244,7 @@ freezeWithManager newManager outputMode transitivity0 inputs scope intent chosen
171244
InputFile file ->
172245
System.FilePath.takeDirectory file
173246

174-
let status = Dhall.Import.emptyStatusWithManager newManager directory
247+
let status = Dhall.Import.emptyStatusWithManager (view Dhall.newManager settings) directory
175248

176249
(inputName, originalText, transitivity) <- case input of
177250
InputFile file -> do
@@ -199,7 +272,7 @@ freezeWithManager newManager outputMode transitivity0 inputs scope intent chosen
199272
NonTransitive ->
200273
return ()
201274

202-
frozenExpression <- freezeExpressionWithManager newManager directory scope intent parsedExpression
275+
frozenExpression <- freezeExpressionWithSettings settings directory scope intent parsedExpression
203276

204277
let doc = Pretty.pretty header
205278
<> Dhall.Pretty.prettyCharacterSet characterSet frozenExpression
@@ -238,41 +311,21 @@ freezeWithManager newManager outputMode transitivity0 inputs scope intent chosen
238311
then Right ()
239312
else Left CheckFailed{..}
240313

241-
{-| Slightly more pure version of the `freeze` function
242-
243-
This still requires `IO` to freeze the import, but now the input and output
244-
expression are passed in explicitly
245-
-}
246-
freezeExpression
247-
:: FilePath
248-
-- ^ Starting directory
249-
-> Scope
250-
-> Intent
251-
-> Expr s Import
252-
-> IO (Expr s Import)
253-
freezeExpression = freezeExpressionWithManager Dhall.Import.defaultNewManager
254-
255-
-- https://github.com/dhall-lang/dhall-haskell/issues/2347
256-
toMissing :: Import -> Import
257-
toMissing import_ =
258-
import_ { importHashed = (importHashed import_) { importType = Missing } }
259-
260-
261314
-- | See 'freezeExpression'.
262-
freezeExpressionWithManager
263-
:: IO Dhall.Import.Manager
315+
freezeExpressionWithSettings
316+
:: EvaluateSettings
264317
-> FilePath
265318
-> Scope
266319
-> Intent
267320
-> Expr s Import
268321
-> IO (Expr s Import)
269-
freezeExpressionWithManager newManager directory scope intent expression = do
322+
freezeExpressionWithSettings settings directory scope intent expression = do
270323
let freezeScope =
271324
case scope of
272-
AllImports -> freezeImportWithManager
273-
OnlyRemoteImports -> freezeRemoteImportWithManager
325+
AllImports -> freezeImportWithSettings
326+
OnlyRemoteImports -> freezeRemoteImportWithSettings
274327

275-
let freezeFunction = freezeScope newManager directory
328+
let freezeFunction = freezeScope settings directory
276329

277330
let cache
278331
-- This case is necessary because `transformOf` is a bottom-up
@@ -353,3 +406,8 @@ freezeExpressionWithManager newManager directory scope intent expression = do
353406
traverse freezeFunction expression
354407
Cache ->
355408
Dhall.Optics.transformMOf Core.subExpressions cache expression
409+
410+
-- https://github.com/dhall-lang/dhall-haskell/issues/2347
411+
toMissing :: Import -> Import
412+
toMissing import_ =
413+
import_ { importHashed = (importHashed import_) { importType = Missing } }

0 commit comments

Comments
 (0)