module Dhall.LSP.Backend.Freezing (
computeSemanticHash,
getAllImportsWithHashPositions,
getImportHashPosition,
stripHash
) where
import Control.Lens (universeOf)
import Data.Text (Text)
import Dhall.Core
( Expr (..)
, Import (..)
, ImportHashed (..)
, subExpressions
)
import Dhall.LSP.Backend.Dhall
( Cache
, DhallError
, FileIdentifier
, hashNormalToCode
, load
, normalize
, typecheck
)
import Dhall.LSP.Backend.Diagnostics
( Range (..)
, positionFromMegaparsec
, positionToOffset
, rangeFromDhall
, subtractPosition
)
import Dhall.LSP.Backend.Parsing (getImportHash)
import Dhall.Parser (Src (..))
import qualified Data.Text as Text
computeSemanticHash :: FileIdentifier -> Expr Src Import -> Cache ->
IO (Either DhallError (Cache, Text))
computeSemanticHash :: FileIdentifier
-> Expr Src Import -> Cache -> IO (Either DhallError (Cache, Text))
computeSemanticHash FileIdentifier
fileid Expr Src Import
expr Cache
cache = do
Either DhallError (Cache, Expr Src Void)
loaded <- FileIdentifier
-> Expr Src Import
-> Cache
-> IO (Either DhallError (Cache, Expr Src Void))
load FileIdentifier
fileid Expr Src Import
expr Cache
cache
case Either DhallError (Cache, Expr Src Void)
loaded of
Left DhallError
err -> Either DhallError (Cache, Text)
-> IO (Either DhallError (Cache, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (DhallError -> Either DhallError (Cache, Text)
forall a b. a -> Either a b
Left DhallError
err)
Right (Cache
cache', Expr Src Void
expr') -> case Expr Src Void -> Either DhallError (WellTyped, WellTyped)
typecheck Expr Src Void
expr' of
Left DhallError
err -> Either DhallError (Cache, Text)
-> IO (Either DhallError (Cache, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (DhallError -> Either DhallError (Cache, Text)
forall a b. a -> Either a b
Left DhallError
err)
Right (WellTyped
wt,WellTyped
_) ->
Either DhallError (Cache, Text)
-> IO (Either DhallError (Cache, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Cache, Text) -> Either DhallError (Cache, Text)
forall a b. b -> Either a b
Right (Cache
cache', Normal -> Text
hashNormalToCode (WellTyped -> Normal
normalize WellTyped
wt)))
stripHash :: Import -> Import
stripHash :: Import -> Import
stripHash (Import (ImportHashed Maybe SHA256Digest
_ ImportType
importType) ImportMode
mode) =
ImportHashed -> ImportMode -> Import
Import (Maybe SHA256Digest -> ImportType -> ImportHashed
ImportHashed Maybe SHA256Digest
forall a. Maybe a
Nothing ImportType
importType) ImportMode
mode
getImportHashPosition :: Src -> Maybe Range
getImportHashPosition :: Src -> Maybe Range
getImportHashPosition src :: Src
src@(Src SourcePos
left SourcePos
_ Text
text) = do
Src SourcePos
left' SourcePos
right' Text
_ <- Src -> Maybe Src
getImportHash Src
src
let p0 :: Position
p0 = SourcePos -> Position
positionFromMegaparsec SourcePos
left
let p1 :: Position
p1 = SourcePos -> Position
positionFromMegaparsec SourcePos
left'
off1 :: Int
off1 = Text -> Position -> Int
positionToOffset Text
text (Position -> Position -> Position
subtractPosition Position
p0 Position
p1)
Range Position
_ Position
left'' = Src -> Range
rangeFromDhall (SourcePos -> SourcePos -> Text -> Src
Src SourcePos
left SourcePos
left' (Int -> Text -> Text
Text.take Int
off1 Text
text))
let Range Position
_ Position
right'' = Src -> Range
rangeFromDhall (SourcePos -> SourcePos -> Text -> Src
Src SourcePos
left SourcePos
right' Text
text)
Range -> Maybe Range
forall (m :: * -> *) a. Monad m => a -> m a
return (Position -> Position -> Range
Range Position
left'' Position
right'')
getAllImportsWithHashPositions :: Expr Src Import -> [(Import, Range)]
getAllImportsWithHashPositions :: Expr Src Import -> [(Import, Range)]
getAllImportsWithHashPositions Expr Src Import
expr =
[ (Import
i, Range
range) |
Note Src
src (Embed Import
i) <- Getting [Expr Src Import] (Expr Src Import) (Expr Src Import)
-> Expr Src Import -> [Expr Src Import]
forall a. Getting [a] a a -> a -> [a]
universeOf Getting [Expr Src Import] (Expr Src Import) (Expr Src Import)
forall (f :: * -> *) s a.
Applicative f =>
(Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
subExpressions Expr Src Import
expr,
Just Range
range <- [Src -> Maybe Range
getImportHashPosition Src
src] ]