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 fileid expr cache = do
loaded <- load fileid expr cache
case loaded of
Left err -> return (Left err)
Right (cache', expr') -> case typecheck expr' of
Left err -> return (Left err)
Right (wt,_) ->
return (Right (cache', hashNormalToCode (normalize wt)))
stripHash :: Import -> Import
stripHash (Import (ImportHashed _ importType) mode) =
Import (ImportHashed Nothing importType) mode
getImportHashPosition :: Src -> Maybe Range
getImportHashPosition src@(Src left _ text) = do
Src left' right' _ <- getImportHash src
let p0 = positionFromMegaparsec left
let p1 = positionFromMegaparsec left'
off1 = positionToOffset text (subtractPosition p0 p1)
Range _ left'' = rangeFromDhall (Src left left' (Text.take off1 text))
let Range _ right'' = rangeFromDhall (Src left right' text)
return (Range left'' right'')
getAllImportsWithHashPositions :: Expr Src Import -> [(Import, Range)]
getAllImportsWithHashPositions expr =
[ (i, range) |
Note src (Embed i) <- universeOf subExpressions expr,
Just range <- [getImportHashPosition src] ]