HIE.hs

{-# LANGUAGE TypeApplications #-}

module StaticLS.HIE (
    hieAstNodeToIdentifiers,
    identifiersToNames,
    hieAstToNames,
    hieAstsAtPoint,
    hiedbCoordsToLspPosition,
    lspPositionToHieDbCoords,
    namesAtPoint,
)
where

import Control.Error.Util (hush)
import Control.Exception (Exception)
import Control.Monad (join, (<=<))
import Control.Monad.Trans.Except (ExceptT, throwE)
import qualified Data.Map as Map
import Data.Maybe (mapMaybe)
import qualified Data.Set as Set
import qualified GHC
import qualified GHC.Iface.Ext.Types as GHC
import HieDb (pointCommand)
import qualified Language.LSP.Protocol.Types as LSP

-- | Note HieDbCoords are 1 indexed
type HieDbCoords = (Int, Int)

data UIntConversionException = UIntConversionException
    deriving (Show)

instance Exception UIntConversionException

namesAtPoint :: GHC.HieFile -> HieDbCoords -> [GHC.Name]
namesAtPoint hieFile position =
    identifiersToNames $ join (pointCommand hieFile position Nothing hieAstNodeToIdentifiers)

hieAstNodeToIdentifiers :: GHC.HieAST a -> [GHC.Identifier]
hieAstNodeToIdentifiers =
    (Set.toList . Map.keysSet) <=< fmap GHC.nodeIdentifiers . Map.elems . GHC.getSourcedNodeInfo . GHC.sourcedNodeInfo

identifiersToNames :: [GHC.Identifier] -> [GHC.Name]
identifiersToNames =
    mapMaybe hush

hieAstToNames :: GHC.HieAST a -> [GHC.Name]
hieAstToNames =
    identifiersToNames . hieAstNodeToIdentifiers

hieAstsAtPoint :: GHC.HieFile -> HieDbCoords -> Maybe HieDbCoords -> [GHC.HieAST GHC.TypeIndex]
hieAstsAtPoint hiefile start end = pointCommand hiefile start end id

hiedbCoordsToLspPosition :: (Monad m) => HieDbCoords -> ExceptT UIntConversionException m LSP.Position
hiedbCoordsToLspPosition (line, col) = LSP.Position <$> intToUInt (line - 1) <*> intToUInt (col - 1)

lspPositionToHieDbCoords :: LSP.Position -> HieDbCoords
lspPositionToHieDbCoords position = (fromIntegral position._line + 1, fromIntegral position._character + 1)

-- | Use 'fromIntegral' when it is safe to do so
intToUInt :: (Monad m) => Int -> ExceptT UIntConversionException m LSP.UInt
intToUInt x =
    if minBoundAsInt <= x && x <= maxBoundAsInt
        then pure $ fromIntegral x
        else throwE UIntConversionException
  where
    minBoundAsInt = fromIntegral $ minBound @LSP.UInt
    maxBoundAsInt = fromIntegral $ maxBound @LSP.UInt