{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Dhall.Freeze
(
freeze
, freezeExpression
, freezeImport
, freezeRemoteImport
, Scope(..)
, Intent(..)
) where
import Data.Monoid ((<>))
import Dhall.Pretty (CharacterSet)
import Dhall.Syntax (Expr(..), Import(..), ImportHashed(..), ImportType(..))
import Dhall.Util
( Censor
, CheckFailed(..)
, Header(..)
, Input(..)
, OutputMode(..)
)
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 :: FilePath -> Import -> IO Import
freezeImport FilePath
directory Import
import_ = do
let unprotectedImport :: Import
unprotectedImport =
Import
import_
{ importHashed :: ImportHashed
importHashed =
(Import -> ImportHashed
importHashed Import
import_)
{ hash :: Maybe SHA256Digest
hash = Maybe SHA256Digest
forall a. Maybe a
Nothing
}
}
let status :: Status
status = FilePath -> Status
Dhall.Import.emptyStatus FilePath
directory
Expr Src Void
expression <- StateT Status IO (Expr Src Void) -> Status -> IO (Expr Src Void)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
State.evalStateT (Expr Src Import -> StateT Status IO (Expr Src Void)
Dhall.Import.loadWith (Import -> Expr Src Import
forall s a. a -> Expr s a
Embed Import
unprotectedImport)) Status
status
case Expr Src Void -> Either (TypeError Src Void) (Expr Src Void)
forall s. Expr s Void -> Either (TypeError s Void) (Expr s Void)
Dhall.TypeCheck.typeOf Expr Src Void
expression of
Left TypeError Src Void
exception -> TypeError Src Void -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO TypeError Src Void
exception
Right Expr Src Void
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
let normalizedExpression :: Expr s Void
normalizedExpression = Expr s Void -> Expr s Void
forall s a. Expr s a -> Expr s a
Core.alphaNormalize (Expr Src Void -> Expr s Void
forall a s t. Eq a => Expr s a -> Expr t a
Core.normalize Expr Src Void
expression)
Expr Void Void -> IO ()
Dhall.Import.writeExpressionToSemanticCache (Expr Src Void -> Expr Void Void
forall s a t. Expr s a -> Expr t a
Core.denote Expr Src Void
expression)
let expressionHash :: SHA256Digest
expressionHash = Expr Void Void -> SHA256Digest
Dhall.Import.hashExpression Expr Void Void
forall s. Expr s Void
normalizedExpression
let newImportHashed :: ImportHashed
newImportHashed = (Import -> ImportHashed
importHashed Import
import_) { hash :: Maybe SHA256Digest
hash = SHA256Digest -> Maybe SHA256Digest
forall a. a -> Maybe a
Just SHA256Digest
expressionHash }
let newImport :: Import
newImport = Import
import_ { importHashed :: ImportHashed
importHashed = ImportHashed
newImportHashed }
Import -> IO Import
forall (m :: * -> *) a. Monad m => a -> m a
return Import
newImport
freezeRemoteImport
:: FilePath
-> Import
-> IO Import
freezeRemoteImport :: FilePath -> Import -> IO Import
freezeRemoteImport FilePath
directory Import
import_ = do
case ImportHashed -> ImportType
importType (Import -> ImportHashed
importHashed Import
import_) of
Remote {} -> FilePath -> Import -> IO Import
freezeImport FilePath
directory Import
import_
ImportType
_ -> Import -> IO Import
forall (m :: * -> *) a. Monad m => a -> m a
return Import
import_
data Scope
= OnlyRemoteImports
| AllImports
data Intent
= Secure
| Cache
freeze
:: OutputMode
-> Input
-> Scope
-> Intent
-> CharacterSet
-> Censor
-> IO ()
freeze :: OutputMode
-> Input -> Scope -> Intent -> CharacterSet -> Censor -> IO ()
freeze OutputMode
outputMode Input
input Scope
scope Intent
intent CharacterSet
characterSet Censor
censor = do
let directory :: FilePath
directory = case Input
input of
Input
StandardInput -> FilePath
"."
InputFile FilePath
file -> FilePath -> FilePath
System.FilePath.takeDirectory FilePath
file
let rewrite :: Expr s Import -> IO (Expr s Import)
rewrite = FilePath -> Scope -> Intent -> Expr s Import -> IO (Expr s Import)
forall s.
FilePath -> Scope -> Intent -> Expr s Import -> IO (Expr s Import)
freezeExpression FilePath
directory Scope
scope Intent
intent
Text
originalText <- case Input
input of
InputFile FilePath
file -> FilePath -> IO Text
Text.IO.readFile FilePath
file
Input
StandardInput -> IO Text
Text.IO.getContents
(Header Text
header, Expr Src Import
parsedExpression) <- Censor -> Text -> IO (Header, Expr Src Import)
Util.getExpressionAndHeaderFromStdinText Censor
censor Text
originalText
Expr Src Import
frozenExpression <- Expr Src Import -> IO (Expr Src Import)
forall s. Expr s Import -> IO (Expr s Import)
rewrite Expr Src Import
parsedExpression
let doc :: Doc Ann
doc = Text -> Doc Ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty Text
header
Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> CharacterSet -> Expr Src Import -> Doc Ann
forall a. Pretty a => CharacterSet -> Expr Src a -> Doc Ann
Dhall.Pretty.prettyCharacterSet CharacterSet
characterSet Expr Src Import
frozenExpression
Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Doc Ann
"\n"
let stream :: SimpleDocStream Ann
stream = Doc Ann -> SimpleDocStream Ann
forall ann. Doc ann -> SimpleDocStream ann
Dhall.Pretty.layout Doc Ann
doc
let modifiedText :: Text
modifiedText = SimpleDocStream Ann -> Text
forall ann. SimpleDocStream ann -> Text
Pretty.Text.renderStrict SimpleDocStream Ann
stream
case OutputMode
outputMode of
OutputMode
Write -> do
let unAnnotated :: SimpleDocStream xxx
unAnnotated = SimpleDocStream Ann -> SimpleDocStream xxx
forall ann xxx. SimpleDocStream ann -> SimpleDocStream xxx
Pretty.unAnnotateS SimpleDocStream Ann
stream
case Input
input of
InputFile FilePath
file ->
if Text
originalText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
modifiedText
then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else
FilePath -> Text -> IO ()
AtomicWrite.LazyText.atomicWriteFile
FilePath
file
(SimpleDocStream Any -> Text
forall ann. SimpleDocStream ann -> Text
Pretty.Text.renderLazy SimpleDocStream Any
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 (Ann -> AnsiStyle)
-> SimpleDocStream Ann -> SimpleDocStream AnsiStyle
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 SimpleDocStream AnsiStyle
forall xxx. SimpleDocStream xxx
unAnnotated
OutputMode
Check -> do
if Text
originalText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
modifiedText
then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
let command :: Text
command = Text
"freeze"
let modified :: Text
modified = Text
"frozen"
CheckFailed -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO CheckFailed :: Text -> Text -> CheckFailed
CheckFailed{Text
modified :: Text
command :: Text
modified :: Text
command :: Text
..}
freezeExpression
:: FilePath
-> Scope
-> Intent
-> Expr s Import
-> IO (Expr s Import)
freezeExpression :: FilePath -> Scope -> Intent -> Expr s Import -> IO (Expr s Import)
freezeExpression FilePath
directory Scope
scope Intent
intent Expr s Import
expression = do
let freezeScope :: FilePath -> Import -> IO Import
freezeScope =
case Scope
scope of
Scope
AllImports -> FilePath -> Import -> IO Import
freezeImport
Scope
OnlyRemoteImports -> FilePath -> Import -> IO Import
freezeRemoteImport
let freezeFunction :: Import -> IO Import
freezeFunction = FilePath -> Import -> IO Import
freezeScope FilePath
directory
let cache :: Expr s Import -> IO (Expr s Import)
cache
(ImportAlt
(Expr s Import -> Expr s Import
forall s a. Expr s a -> Expr s a
Core.shallowDenote -> ImportAlt
(Expr s Import -> Expr s Import
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 } }
)
(Expr s Import -> Expr s Import
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_@(Expr s Import -> Expr s Import
forall s a. Expr s a -> Expr s a
Core.shallowDenote -> ImportAlt
(Expr s Import -> Expr s Import
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 } }
)
(Expr s Import -> Expr s Import
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 } }
)
)
) = do
Expr s Import -> IO (Expr s Import)
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_
if Import
frozenImport Import -> Import -> Bool
forall a. Eq a => a -> a -> Bool
/= Import
import_
then Expr s Import -> IO (Expr s Import)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr s Import -> Expr s Import -> Expr s Import
forall s a. Expr s a -> Expr s a -> Expr s a
ImportAlt (Import -> Expr s Import
forall s a. a -> Expr s a
Embed Import
frozenImport) (Import -> Expr s Import
forall s a. a -> Expr s a
Embed Import
import_))
else Expr s Import -> IO (Expr s Import)
forall (m :: * -> *) a. Monad m => a -> m a
return (Import -> Expr s Import
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 thawedImport :: Import
thawedImport = Import
import_
{ importHashed :: ImportHashed
importHashed = (Import -> ImportHashed
importHashed Import
import_)
{ hash :: Maybe SHA256Digest
hash = Maybe SHA256Digest
forall a. Maybe a
Nothing
}
}
Expr s Import -> IO (Expr s Import)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr s Import -> Expr s Import -> Expr s Import
forall s a. Expr s a -> Expr s a -> Expr s a
ImportAlt (Import -> Expr s Import
forall s a. a -> Expr s a
Embed Import
frozenImport) (Import -> Expr s Import
forall s a. a -> Expr s a
Embed Import
thawedImport))
cache Expr s Import
expression_ = do
Expr s Import -> IO (Expr s Import)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr s Import
expression_
case Intent
intent of
Intent
Secure ->
(Import -> IO Import) -> Expr s Import -> IO (Expr s Import)
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 ->
LensLike
(WrappedMonad IO)
(Expr s Import)
(Expr s Import)
(Expr s Import)
(Expr s Import)
-> (Expr s Import -> IO (Expr s Import))
-> Expr s Import
-> IO (Expr s Import)
forall (m :: * -> *) a b.
Monad m =>
LensLike (WrappedMonad m) a b a b -> (b -> m b) -> a -> m b
Dhall.Optics.transformMOf LensLike
(WrappedMonad IO)
(Expr s Import)
(Expr s Import)
(Expr s Import)
(Expr s Import)
forall (f :: * -> *) s a.
Applicative f =>
(Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
Core.subExpressions Expr s Import -> IO (Expr s Import)
forall s. Expr s Import -> IO (Expr s Import)
cache Expr s Import
expression