{-# 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 (Int -> UIntConversionException -> ShowS
[UIntConversionException] -> ShowS
UIntConversionException -> String
(Int -> UIntConversionException -> ShowS)
-> (UIntConversionException -> String)
-> ([UIntConversionException] -> ShowS)
-> Show UIntConversionException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UIntConversionException -> ShowS
showsPrec :: Int -> UIntConversionException -> ShowS
$cshow :: UIntConversionException -> String
show :: UIntConversionException -> String
$cshowList :: [UIntConversionException] -> ShowS
showList :: [UIntConversionException] -> ShowS
Show)

instance Exception UIntConversionException

namesAtPoint :: GHC.HieFile -> HieDbCoords -> [GHC.Name]
namesAtPoint :: HieFile -> HieDbCoords -> [Name]
namesAtPoint HieFile
hieFile HieDbCoords
position =
    [Identifier] -> [Name]
identifiersToNames ([Identifier] -> [Name]) -> [Identifier] -> [Name]
forall a b. (a -> b) -> a -> b
$ [[Identifier]] -> [Identifier]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (HieFile
-> HieDbCoords
-> Maybe HieDbCoords
-> (HieAST Int -> [Identifier])
-> [[Identifier]]
forall a.
HieFile
-> HieDbCoords -> Maybe HieDbCoords -> (HieAST Int -> a) -> [a]
pointCommand HieFile
hieFile HieDbCoords
position Maybe HieDbCoords
forall a. Maybe a
Nothing HieAST Int -> [Identifier]
forall a. HieAST a -> [Identifier]
hieAstNodeToIdentifiers)

hieAstNodeToIdentifiers :: GHC.HieAST a -> [GHC.Identifier]
hieAstNodeToIdentifiers :: forall a. HieAST a -> [Identifier]
hieAstNodeToIdentifiers =
    (Set Identifier -> [Identifier]
forall a. Set a -> [a]
Set.toList (Set Identifier -> [Identifier])
-> (Map Identifier (IdentifierDetails a) -> Set Identifier)
-> Map Identifier (IdentifierDetails a)
-> [Identifier]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Identifier (IdentifierDetails a) -> Set Identifier
forall k a. Map k a -> Set k
Map.keysSet) (Map Identifier (IdentifierDetails a) -> [Identifier])
-> (HieAST a -> [Map Identifier (IdentifierDetails a)])
-> HieAST a
-> [Identifier]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (NodeInfo a -> Map Identifier (IdentifierDetails a))
-> [NodeInfo a] -> [Map Identifier (IdentifierDetails a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NodeInfo a -> Map Identifier (IdentifierDetails a)
forall a. NodeInfo a -> NodeIdentifiers a
GHC.nodeIdentifiers ([NodeInfo a] -> [Map Identifier (IdentifierDetails a)])
-> (HieAST a -> [NodeInfo a])
-> HieAST a
-> [Map Identifier (IdentifierDetails a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map NodeOrigin (NodeInfo a) -> [NodeInfo a]
forall k a. Map k a -> [a]
Map.elems (Map NodeOrigin (NodeInfo a) -> [NodeInfo a])
-> (HieAST a -> Map NodeOrigin (NodeInfo a))
-> HieAST a
-> [NodeInfo a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
GHC.getSourcedNodeInfo (SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a))
-> (HieAST a -> SourcedNodeInfo a)
-> HieAST a
-> Map NodeOrigin (NodeInfo a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST a -> SourcedNodeInfo a
forall a. HieAST a -> SourcedNodeInfo a
GHC.sourcedNodeInfo

identifiersToNames :: [GHC.Identifier] -> [GHC.Name]
identifiersToNames :: [Identifier] -> [Name]
identifiersToNames =
    (Identifier -> Maybe Name) -> [Identifier] -> [Name]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Identifier -> Maybe Name
forall a b. Either a b -> Maybe b
hush

hieAstToNames :: GHC.HieAST a -> [GHC.Name]
hieAstToNames :: forall a. HieAST a -> [Name]
hieAstToNames =
    [Identifier] -> [Name]
identifiersToNames ([Identifier] -> [Name])
-> (HieAST a -> [Identifier]) -> HieAST a -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST a -> [Identifier]
forall a. HieAST a -> [Identifier]
hieAstNodeToIdentifiers

hieAstsAtPoint :: GHC.HieFile -> HieDbCoords -> Maybe HieDbCoords -> [GHC.HieAST GHC.TypeIndex]
hieAstsAtPoint :: HieFile -> HieDbCoords -> Maybe HieDbCoords -> [HieAST Int]
hieAstsAtPoint HieFile
hiefile HieDbCoords
start Maybe HieDbCoords
end = HieFile
-> HieDbCoords
-> Maybe HieDbCoords
-> (HieAST Int -> HieAST Int)
-> [HieAST Int]
forall a.
HieFile
-> HieDbCoords -> Maybe HieDbCoords -> (HieAST Int -> a) -> [a]
pointCommand HieFile
hiefile HieDbCoords
start Maybe HieDbCoords
end HieAST Int -> HieAST Int
forall a. a -> a
id

hiedbCoordsToLspPosition :: (Monad m) => HieDbCoords -> ExceptT UIntConversionException m LSP.Position
hiedbCoordsToLspPosition :: forall (m :: * -> *).
Monad m =>
HieDbCoords -> ExceptT UIntConversionException m Position
hiedbCoordsToLspPosition (Int
line, Int
col) = UInt -> UInt -> Position
LSP.Position (UInt -> UInt -> Position)
-> ExceptT UIntConversionException m UInt
-> ExceptT UIntConversionException m (UInt -> Position)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ExceptT UIntConversionException m UInt
forall (m :: * -> *).
Monad m =>
Int -> ExceptT UIntConversionException m UInt
intToUInt (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ExceptT UIntConversionException m (UInt -> Position)
-> ExceptT UIntConversionException m UInt
-> ExceptT UIntConversionException m Position
forall a b.
ExceptT UIntConversionException m (a -> b)
-> ExceptT UIntConversionException m a
-> ExceptT UIntConversionException m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ExceptT UIntConversionException m UInt
forall (m :: * -> *).
Monad m =>
Int -> ExceptT UIntConversionException m UInt
intToUInt (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

lspPositionToHieDbCoords :: LSP.Position -> HieDbCoords
lspPositionToHieDbCoords :: Position -> HieDbCoords
lspPositionToHieDbCoords Position
position = (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
position._line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
position._character Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Use 'fromIntegral' when it is safe to do so
intToUInt :: (Monad m) => Int -> ExceptT UIntConversionException m LSP.UInt
intToUInt :: forall (m :: * -> *).
Monad m =>
Int -> ExceptT UIntConversionException m UInt
intToUInt Int
x =
    if Int
minBoundAsInt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
x Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxBoundAsInt
        then UInt -> ExceptT UIntConversionException m UInt
forall a. a -> ExceptT UIntConversionException m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UInt -> ExceptT UIntConversionException m UInt)
-> UInt -> ExceptT UIntConversionException m UInt
forall a b. (a -> b) -> a -> b
$ Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x
        else UIntConversionException -> ExceptT UIntConversionException m UInt
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE UIntConversionException
UIntConversionException
  where
    minBoundAsInt :: Int
minBoundAsInt = UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt -> Int) -> UInt -> Int
forall a b. (a -> b) -> a -> b
$ forall a. Bounded a => a
minBound @LSP.UInt
    maxBoundAsInt :: Int
maxBoundAsInt = UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt -> Int) -> UInt -> Int
forall a b. (a -> b) -> a -> b
$ forall a. Bounded a => a
maxBound @LSP.UInt