{-# 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 Data.List.NonEmpty (NonEmpty)
import Data.Maybe (fromMaybe)
import Dhall.Pretty (CharacterSet, detectCharacterSet)
import Dhall.Syntax
( Expr (..)
, Import (..)
, ImportHashed (..)
, ImportType (..)
)
import Dhall.Util
( Censor
, CheckFailed (..)
, Header (..)
, Input (..)
, OutputMode (..)
, Transitivity (..)
, handleMultipleChecksFailed
)
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.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
freezeImport
:: FilePath
-> Import
-> IO Import
freezeImport :: FilePath -> Import -> IO Import
freezeImport = IO Manager -> FilePath -> Import -> IO Import
freezeImportWithManager IO Manager
Dhall.Import.defaultNewManager
freezeImportWithManager
:: IO Dhall.Import.Manager
-> FilePath
-> Import
-> IO Import
freezeImportWithManager :: IO Manager -> FilePath -> Import -> IO Import
freezeImportWithManager IO Manager
newManager 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 IO Manager
newManager 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. Expr s X -> Either (TypeError s X) (Expr s X)
Dhall.TypeCheck.typeOf 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 => Expr s a -> Expr t a
Core.normalize Expr Src X
expression)
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
freezeRemoteImport
:: FilePath
-> Import
-> IO Import
freezeRemoteImport :: FilePath -> Import -> IO Import
freezeRemoteImport = IO Manager -> FilePath -> Import -> IO Import
freezeRemoteImportWithManager IO Manager
Dhall.Import.defaultNewManager
freezeRemoteImportWithManager
:: IO Dhall.Import.Manager
-> FilePath
-> Import
-> IO Import
freezeRemoteImportWithManager :: IO Manager -> FilePath -> Import -> IO Import
freezeRemoteImportWithManager IO Manager
newManager FilePath
directory Import
import_ =
case ImportHashed -> ImportType
importType (Import -> ImportHashed
importHashed Import
import_) of
Remote {} -> IO Manager -> FilePath -> Import -> IO Import
freezeImportWithManager IO Manager
newManager FilePath
directory Import
import_
ImportType
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Import
import_
data Scope
= OnlyRemoteImports
| AllImports
data Intent
= Secure
| Cache
freeze
:: OutputMode
-> Transitivity
-> NonEmpty Input
-> Scope
-> Intent
-> Maybe CharacterSet
-> Censor
-> IO ()
freeze :: OutputMode
-> Transitivity
-> NonEmpty Input
-> Scope
-> Intent
-> Maybe CharacterSet
-> Censor
-> IO ()
freeze = IO Manager
-> OutputMode
-> Transitivity
-> NonEmpty Input
-> Scope
-> Intent
-> Maybe CharacterSet
-> Censor
-> IO ()
freezeWithManager IO Manager
Dhall.Import.defaultNewManager
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 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 IO Manager
newManager 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.
IO Manager
-> FilePath
-> Scope
-> Intent
-> Expr s Import
-> IO (Expr s Import)
freezeExpressionWithManager IO Manager
newManager 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
..}
freezeExpression
:: FilePath
-> 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.
IO Manager
-> FilePath
-> Scope
-> Intent
-> Expr s Import
-> IO (Expr s Import)
freezeExpressionWithManager IO Manager
Dhall.Import.defaultNewManager
toMissing :: Import -> Import
toMissing :: Import -> Import
toMissing Import
import_ =
Import
import_ { importHashed :: ImportHashed
importHashed = (Import -> ImportHashed
importHashed Import
import_) { importType :: ImportType
importType = ImportType
Missing } }
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 FilePath
directory Scope
scope Intent
intent Expr s Import
expression = do
let freezeScope :: IO Manager -> FilePath -> Import -> IO Import
freezeScope =
case Scope
scope of
Scope
AllImports -> IO Manager -> FilePath -> Import -> IO Import
freezeImportWithManager
Scope
OnlyRemoteImports -> IO Manager -> FilePath -> Import -> IO Import
freezeRemoteImportWithManager
let freezeFunction :: Import -> IO Import
freezeFunction = IO Manager -> FilePath -> Import -> IO Import
freezeScope IO Manager
newManager FilePath
directory
let cache :: Expr s Import -> IO (Expr s Import)
cache
(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 } }
)
)
) =
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
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
Import
frozenImport <- Import -> IO Import
freezeFunction Import
import_
let frozenMissing :: Import
frozenMissing = Import -> Import
toMissing Import
frozenImport
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_
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 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