{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Dhall.Freeze
(
freeze
, freezeWithManager
, freezeExpression
, freezeExpressionWithManager
, freezeImport
, freezeImportWithManager
, freezeRemoteImport
, freezeRemoteImportWithManager
, Scope(..)
, Intent(..)
) where
import Data.Foldable (for_)
import Dhall.Pretty (CharacterSet)
import Dhall.Syntax
( Expr (..)
, Import (..)
, ImportHashed (..)
, ImportType (..)
)
import Dhall.Util
( Censor
, CheckFailed (..)
, Header (..)
, OutputMode (..)
, PossiblyTransitiveInput (..)
, Transitivity (..)
)
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.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
freezeImport
:: FilePath
-> Import
-> IO Import
freezeImport = freezeImportWithManager Dhall.Import.defaultNewManager
freezeImportWithManager
:: IO Dhall.Import.Manager
-> FilePath
-> Import
-> IO Import
freezeImportWithManager newManager directory import_ = do
let unprotectedImport =
import_
{ importHashed =
(importHashed import_)
{ hash = Nothing
}
}
let status = Dhall.Import.emptyStatusWithManager newManager directory
expression <- State.evalStateT (Dhall.Import.loadWith (Embed unprotectedImport)) status
case Dhall.TypeCheck.typeOf expression of
Left exception -> Exception.throwIO exception
Right _ -> return ()
let normalizedExpression = Core.alphaNormalize (Core.normalize expression)
Dhall.Import.writeExpressionToSemanticCache (Core.denote expression)
let expressionHash = Dhall.Import.hashExpression normalizedExpression
let newImportHashed = (importHashed import_) { hash = Just expressionHash }
let newImport = import_ { importHashed = newImportHashed }
return newImport
freezeRemoteImport
:: FilePath
-> Import
-> IO Import
freezeRemoteImport = freezeRemoteImportWithManager Dhall.Import.defaultNewManager
freezeRemoteImportWithManager
:: IO Dhall.Import.Manager
-> FilePath
-> Import
-> IO Import
freezeRemoteImportWithManager newManager directory import_ =
case importType (importHashed import_) of
Remote {} -> freezeImportWithManager newManager directory import_
_ -> return import_
data Scope
= OnlyRemoteImports
| AllImports
data Intent
= Secure
| Cache
freeze
:: OutputMode
-> PossiblyTransitiveInput
-> Scope
-> Intent
-> CharacterSet
-> Censor
-> IO ()
freeze = freezeWithManager Dhall.Import.defaultNewManager
freezeWithManager
:: IO Dhall.Import.Manager
-> OutputMode
-> PossiblyTransitiveInput
-> Scope
-> Intent
-> CharacterSet
-> Censor
-> IO ()
freezeWithManager newManager outputMode input0 scope intent characterSet censor = go input0
where
go input = do
let directory = case input of
NonTransitiveStandardInput ->
"."
PossiblyTransitiveInputFile file _ ->
System.FilePath.takeDirectory file
let status = Dhall.Import.emptyStatusWithManager newManager directory
(originalText, transitivity) <- case input of
PossiblyTransitiveInputFile file transitivity -> do
text <- Text.IO.readFile file
return (text, transitivity)
NonTransitiveStandardInput -> do
text <- Text.IO.getContents
return (text, NonTransitive)
(Header header, parsedExpression) <- Util.getExpressionAndHeaderFromStdinText censor originalText
case transitivity of
Transitive ->
for_ parsedExpression $ \import_ -> do
maybeFilepath <- Dhall.Import.dependencyToFile status import_
for_ maybeFilepath $ \filepath ->
go (PossiblyTransitiveInputFile filepath Transitive)
NonTransitive ->
return ()
frozenExpression <- freezeExpressionWithManager newManager directory scope intent parsedExpression
let doc = Pretty.pretty header
<> Dhall.Pretty.prettyCharacterSet characterSet frozenExpression
<> "\n"
let stream = Dhall.Pretty.layout doc
let modifiedText = Pretty.Text.renderStrict stream
case outputMode of
Write -> do
let unAnnotated = Pretty.unAnnotateS stream
case input of
PossiblyTransitiveInputFile file _ ->
if originalText == modifiedText
then return ()
else
AtomicWrite.LazyText.atomicWriteFile
file
(Pretty.Text.renderLazy unAnnotated)
NonTransitiveStandardInput -> do
supportsANSI <- System.Console.ANSI.hSupportsANSI System.IO.stdout
if supportsANSI
then
Pretty.renderIO System.IO.stdout (Dhall.Pretty.annToAnsiStyle <$> stream)
else
Pretty.renderIO System.IO.stdout unAnnotated
Check ->
if originalText == modifiedText
then return ()
else do
let command = "freeze"
let modified = "frozen"
Exception.throwIO CheckFailed{..}
freezeExpression
:: FilePath
-> Scope
-> Intent
-> Expr s Import
-> IO (Expr s Import)
freezeExpression = freezeExpressionWithManager Dhall.Import.defaultNewManager
freezeExpressionWithManager
:: IO Dhall.Import.Manager
-> FilePath
-> Scope
-> Intent
-> Expr s Import
-> IO (Expr s Import)
freezeExpressionWithManager newManager directory scope intent expression = do
let freezeScope =
case scope of
AllImports -> freezeImportWithManager
OnlyRemoteImports -> freezeRemoteImportWithManager
let freezeFunction = freezeScope newManager directory
let cache
(ImportAlt
(Core.shallowDenote -> ImportAlt
(Core.shallowDenote -> Embed
Import{ importHashed = ImportHashed{ hash = Just _expectedHash } }
)
(Core.shallowDenote -> Embed
Import{ importHashed = ImportHashed{ hash = Nothing } }
)
)
import_@(Core.shallowDenote -> ImportAlt
(Core.shallowDenote -> Embed
Import{ importHashed = ImportHashed{ hash = Just _actualHash } }
)
(Core.shallowDenote -> Embed
Import{ importHashed = ImportHashed{ hash = Nothing } }
)
)
) =
return import_
cache
(Embed import_@(Import { importHashed = ImportHashed { hash = Nothing } })) = do
frozenImport <- freezeFunction import_
if frozenImport /= import_
then return (ImportAlt (Embed frozenImport) (Embed import_))
else return (Embed import_)
cache
(Embed import_@(Import { importHashed = ImportHashed { hash = Just _ } })) = do
frozenImport <- freezeFunction import_
let thawedImport = import_
{ importHashed = (importHashed import_)
{ hash = Nothing
}
}
return (ImportAlt (Embed frozenImport) (Embed thawedImport))
cache expression_ =
return expression_
case intent of
Secure ->
traverse freezeFunction expression
Cache ->
Dhall.Optics.transformMOf Core.subExpressions cache expression