{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE DerivingVia       #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData        #-}
{-# LANGUAGE TypeFamilies      #-}

module Ide.Plugin.SemanticTokens.Types where

import           Control.DeepSeq               (NFData (rnf), rwhnf)
import qualified Data.Array                    as A
import           Data.Default                  (Default (def))
import           Data.Generics                 (Typeable)
import           Development.IDE               (Pretty (pretty), RuleResult)
import qualified Development.IDE.Core.Shake    as Shake
import           Development.IDE.GHC.Compat    hiding (loc)
import           Development.IDE.Graph.Classes (Hashable)
import           GHC.Generics                  (Generic)
import           Language.LSP.Protocol.Types
-- import template haskell
import           Data.Text                     (Text)
import           Language.Haskell.TH.Syntax    (Lift)


-- !!!! order of declarations matters deriving enum and ord
-- since token may come from different source and we want to keep the most specific one
-- and we might want to merge them.
data HsSemanticTokenType
  = TVariable -- none function variable
  | TFunction -- function
  | TDataConstructor -- Data constructor
  | TTypeVariable -- Type variable
  | TClassMethod -- Class method
  | TPatternSynonym -- Pattern synonym
  | TTypeConstructor -- Type (Type constructor)
  | TClass -- Type class
  | TTypeSynonym -- Type synonym
  | TTypeFamily -- type family
  | TRecordField -- from match bind
  | TOperator-- operator
  | TModule -- module name
  deriving (HsSemanticTokenType -> HsSemanticTokenType -> Bool
(HsSemanticTokenType -> HsSemanticTokenType -> Bool)
-> (HsSemanticTokenType -> HsSemanticTokenType -> Bool)
-> Eq HsSemanticTokenType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HsSemanticTokenType -> HsSemanticTokenType -> Bool
== :: HsSemanticTokenType -> HsSemanticTokenType -> Bool
$c/= :: HsSemanticTokenType -> HsSemanticTokenType -> Bool
/= :: HsSemanticTokenType -> HsSemanticTokenType -> Bool
Eq, Eq HsSemanticTokenType
Eq HsSemanticTokenType =>
(HsSemanticTokenType -> HsSemanticTokenType -> Ordering)
-> (HsSemanticTokenType -> HsSemanticTokenType -> Bool)
-> (HsSemanticTokenType -> HsSemanticTokenType -> Bool)
-> (HsSemanticTokenType -> HsSemanticTokenType -> Bool)
-> (HsSemanticTokenType -> HsSemanticTokenType -> Bool)
-> (HsSemanticTokenType
    -> HsSemanticTokenType -> HsSemanticTokenType)
-> (HsSemanticTokenType
    -> HsSemanticTokenType -> HsSemanticTokenType)
-> Ord HsSemanticTokenType
HsSemanticTokenType -> HsSemanticTokenType -> Bool
HsSemanticTokenType -> HsSemanticTokenType -> Ordering
HsSemanticTokenType -> HsSemanticTokenType -> HsSemanticTokenType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: HsSemanticTokenType -> HsSemanticTokenType -> Ordering
compare :: HsSemanticTokenType -> HsSemanticTokenType -> Ordering
$c< :: HsSemanticTokenType -> HsSemanticTokenType -> Bool
< :: HsSemanticTokenType -> HsSemanticTokenType -> Bool
$c<= :: HsSemanticTokenType -> HsSemanticTokenType -> Bool
<= :: HsSemanticTokenType -> HsSemanticTokenType -> Bool
$c> :: HsSemanticTokenType -> HsSemanticTokenType -> Bool
> :: HsSemanticTokenType -> HsSemanticTokenType -> Bool
$c>= :: HsSemanticTokenType -> HsSemanticTokenType -> Bool
>= :: HsSemanticTokenType -> HsSemanticTokenType -> Bool
$cmax :: HsSemanticTokenType -> HsSemanticTokenType -> HsSemanticTokenType
max :: HsSemanticTokenType -> HsSemanticTokenType -> HsSemanticTokenType
$cmin :: HsSemanticTokenType -> HsSemanticTokenType -> HsSemanticTokenType
min :: HsSemanticTokenType -> HsSemanticTokenType -> HsSemanticTokenType
Ord, Int -> HsSemanticTokenType -> ShowS
[HsSemanticTokenType] -> ShowS
HsSemanticTokenType -> String
(Int -> HsSemanticTokenType -> ShowS)
-> (HsSemanticTokenType -> String)
-> ([HsSemanticTokenType] -> ShowS)
-> Show HsSemanticTokenType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HsSemanticTokenType -> ShowS
showsPrec :: Int -> HsSemanticTokenType -> ShowS
$cshow :: HsSemanticTokenType -> String
show :: HsSemanticTokenType -> String
$cshowList :: [HsSemanticTokenType] -> ShowS
showList :: [HsSemanticTokenType] -> ShowS
Show, Int -> HsSemanticTokenType
HsSemanticTokenType -> Int
HsSemanticTokenType -> [HsSemanticTokenType]
HsSemanticTokenType -> HsSemanticTokenType
HsSemanticTokenType -> HsSemanticTokenType -> [HsSemanticTokenType]
HsSemanticTokenType
-> HsSemanticTokenType
-> HsSemanticTokenType
-> [HsSemanticTokenType]
(HsSemanticTokenType -> HsSemanticTokenType)
-> (HsSemanticTokenType -> HsSemanticTokenType)
-> (Int -> HsSemanticTokenType)
-> (HsSemanticTokenType -> Int)
-> (HsSemanticTokenType -> [HsSemanticTokenType])
-> (HsSemanticTokenType
    -> HsSemanticTokenType -> [HsSemanticTokenType])
-> (HsSemanticTokenType
    -> HsSemanticTokenType -> [HsSemanticTokenType])
-> (HsSemanticTokenType
    -> HsSemanticTokenType
    -> HsSemanticTokenType
    -> [HsSemanticTokenType])
-> Enum HsSemanticTokenType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: HsSemanticTokenType -> HsSemanticTokenType
succ :: HsSemanticTokenType -> HsSemanticTokenType
$cpred :: HsSemanticTokenType -> HsSemanticTokenType
pred :: HsSemanticTokenType -> HsSemanticTokenType
$ctoEnum :: Int -> HsSemanticTokenType
toEnum :: Int -> HsSemanticTokenType
$cfromEnum :: HsSemanticTokenType -> Int
fromEnum :: HsSemanticTokenType -> Int
$cenumFrom :: HsSemanticTokenType -> [HsSemanticTokenType]
enumFrom :: HsSemanticTokenType -> [HsSemanticTokenType]
$cenumFromThen :: HsSemanticTokenType -> HsSemanticTokenType -> [HsSemanticTokenType]
enumFromThen :: HsSemanticTokenType -> HsSemanticTokenType -> [HsSemanticTokenType]
$cenumFromTo :: HsSemanticTokenType -> HsSemanticTokenType -> [HsSemanticTokenType]
enumFromTo :: HsSemanticTokenType -> HsSemanticTokenType -> [HsSemanticTokenType]
$cenumFromThenTo :: HsSemanticTokenType
-> HsSemanticTokenType
-> HsSemanticTokenType
-> [HsSemanticTokenType]
enumFromThenTo :: HsSemanticTokenType
-> HsSemanticTokenType
-> HsSemanticTokenType
-> [HsSemanticTokenType]
Enum, HsSemanticTokenType
HsSemanticTokenType
-> HsSemanticTokenType -> Bounded HsSemanticTokenType
forall a. a -> a -> Bounded a
$cminBound :: HsSemanticTokenType
minBound :: HsSemanticTokenType
$cmaxBound :: HsSemanticTokenType
maxBound :: HsSemanticTokenType
Bounded, (forall x. HsSemanticTokenType -> Rep HsSemanticTokenType x)
-> (forall x. Rep HsSemanticTokenType x -> HsSemanticTokenType)
-> Generic HsSemanticTokenType
forall x. Rep HsSemanticTokenType x -> HsSemanticTokenType
forall x. HsSemanticTokenType -> Rep HsSemanticTokenType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HsSemanticTokenType -> Rep HsSemanticTokenType x
from :: forall x. HsSemanticTokenType -> Rep HsSemanticTokenType x
$cto :: forall x. Rep HsSemanticTokenType x -> HsSemanticTokenType
to :: forall x. Rep HsSemanticTokenType x -> HsSemanticTokenType
Generic, (forall (m :: * -> *). Quote m => HsSemanticTokenType -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    HsSemanticTokenType -> Code m HsSemanticTokenType)
-> Lift HsSemanticTokenType
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => HsSemanticTokenType -> m Exp
forall (m :: * -> *).
Quote m =>
HsSemanticTokenType -> Code m HsSemanticTokenType
$clift :: forall (m :: * -> *). Quote m => HsSemanticTokenType -> m Exp
lift :: forall (m :: * -> *). Quote m => HsSemanticTokenType -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
HsSemanticTokenType -> Code m HsSemanticTokenType
liftTyped :: forall (m :: * -> *).
Quote m =>
HsSemanticTokenType -> Code m HsSemanticTokenType
Lift)

-- type SemanticTokensConfig = SemanticTokensConfig_ Identity
instance Default SemanticTokensConfig where
  def :: SemanticTokensConfig
def = STC
      { stFunction :: SemanticTokenTypes
stFunction = SemanticTokenTypes
SemanticTokenTypes_Function
      , stVariable :: SemanticTokenTypes
stVariable = SemanticTokenTypes
SemanticTokenTypes_Variable
      , stDataConstructor :: SemanticTokenTypes
stDataConstructor = SemanticTokenTypes
SemanticTokenTypes_EnumMember
      , stTypeVariable :: SemanticTokenTypes
stTypeVariable = SemanticTokenTypes
SemanticTokenTypes_TypeParameter
      , stClassMethod :: SemanticTokenTypes
stClassMethod = SemanticTokenTypes
SemanticTokenTypes_Method
      -- pattern syn is like a limited version of macro of constructing a term
      , stPatternSynonym :: SemanticTokenTypes
stPatternSynonym = SemanticTokenTypes
SemanticTokenTypes_Macro
        -- normal data type is a tagged union type look like enum type
        -- and a record is a product type like struct
        -- but we don't distinguish them yet
      , stTypeConstructor :: SemanticTokenTypes
stTypeConstructor = SemanticTokenTypes
SemanticTokenTypes_Enum
      , stClass :: SemanticTokenTypes
stClass = SemanticTokenTypes
SemanticTokenTypes_Class
      , stTypeSynonym :: SemanticTokenTypes
stTypeSynonym = SemanticTokenTypes
SemanticTokenTypes_Type
      , stTypeFamily :: SemanticTokenTypes
stTypeFamily = SemanticTokenTypes
SemanticTokenTypes_Interface
      , stRecordField :: SemanticTokenTypes
stRecordField = SemanticTokenTypes
SemanticTokenTypes_Property
      , stModule :: SemanticTokenTypes
stModule = SemanticTokenTypes
SemanticTokenTypes_Namespace
      , stOperator :: SemanticTokenTypes
stOperator = SemanticTokenTypes
SemanticTokenTypes_Operator
      }
-- | SemanticTokensConfig_ is a configuration for the semantic tokens plugin.
-- it contains map between the hs semantic token type and default token type.
data SemanticTokensConfig = STC
  { SemanticTokensConfig -> SemanticTokenTypes
stFunction        :: !SemanticTokenTypes
  , SemanticTokensConfig -> SemanticTokenTypes
stVariable        :: !SemanticTokenTypes
  , SemanticTokensConfig -> SemanticTokenTypes
stDataConstructor :: !SemanticTokenTypes
  , SemanticTokensConfig -> SemanticTokenTypes
stTypeVariable    :: !SemanticTokenTypes
  , SemanticTokensConfig -> SemanticTokenTypes
stClassMethod     :: !SemanticTokenTypes
  , SemanticTokensConfig -> SemanticTokenTypes
stPatternSynonym  :: !SemanticTokenTypes
  , SemanticTokensConfig -> SemanticTokenTypes
stTypeConstructor :: !SemanticTokenTypes
  , SemanticTokensConfig -> SemanticTokenTypes
stClass           :: !SemanticTokenTypes
  , SemanticTokensConfig -> SemanticTokenTypes
stTypeSynonym     :: !SemanticTokenTypes
  , SemanticTokensConfig -> SemanticTokenTypes
stTypeFamily      :: !SemanticTokenTypes
  , SemanticTokensConfig -> SemanticTokenTypes
stRecordField     :: !SemanticTokenTypes
  , SemanticTokensConfig -> SemanticTokenTypes
stModule          :: !SemanticTokenTypes
  , SemanticTokensConfig -> SemanticTokenTypes
stOperator        :: !SemanticTokenTypes
  } deriving ((forall x. SemanticTokensConfig -> Rep SemanticTokensConfig x)
-> (forall x. Rep SemanticTokensConfig x -> SemanticTokensConfig)
-> Generic SemanticTokensConfig
forall x. Rep SemanticTokensConfig x -> SemanticTokensConfig
forall x. SemanticTokensConfig -> Rep SemanticTokensConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SemanticTokensConfig -> Rep SemanticTokensConfig x
from :: forall x. SemanticTokensConfig -> Rep SemanticTokensConfig x
$cto :: forall x. Rep SemanticTokensConfig x -> SemanticTokensConfig
to :: forall x. Rep SemanticTokensConfig x -> SemanticTokensConfig
Generic, Int -> SemanticTokensConfig -> ShowS
[SemanticTokensConfig] -> ShowS
SemanticTokensConfig -> String
(Int -> SemanticTokensConfig -> ShowS)
-> (SemanticTokensConfig -> String)
-> ([SemanticTokensConfig] -> ShowS)
-> Show SemanticTokensConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SemanticTokensConfig -> ShowS
showsPrec :: Int -> SemanticTokensConfig -> ShowS
$cshow :: SemanticTokensConfig -> String
show :: SemanticTokensConfig -> String
$cshowList :: [SemanticTokensConfig] -> ShowS
showList :: [SemanticTokensConfig] -> ShowS
Show)


instance Semigroup HsSemanticTokenType where
  -- one in higher enum is more specific
  HsSemanticTokenType
a <> :: HsSemanticTokenType -> HsSemanticTokenType -> HsSemanticTokenType
<> HsSemanticTokenType
b = HsSemanticTokenType -> HsSemanticTokenType -> HsSemanticTokenType
forall a. Ord a => a -> a -> a
max HsSemanticTokenType
a HsSemanticTokenType
b

data SemanticTokenOriginal tokenType = SemanticTokenOriginal
  { forall tokenType. SemanticTokenOriginal tokenType -> tokenType
_tokenType :: tokenType,
    forall tokenType. SemanticTokenOriginal tokenType -> Loc
_loc       :: Loc,
    forall tokenType. SemanticTokenOriginal tokenType -> String
_name      :: String
  }
  deriving (SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType -> Bool
(SemanticTokenOriginal tokenType
 -> SemanticTokenOriginal tokenType -> Bool)
-> (SemanticTokenOriginal tokenType
    -> SemanticTokenOriginal tokenType -> Bool)
-> Eq (SemanticTokenOriginal tokenType)
forall tokenType.
Eq tokenType =>
SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall tokenType.
Eq tokenType =>
SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType -> Bool
== :: SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType -> Bool
$c/= :: forall tokenType.
Eq tokenType =>
SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType -> Bool
/= :: SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType -> Bool
Eq, Eq (SemanticTokenOriginal tokenType)
Eq (SemanticTokenOriginal tokenType) =>
(SemanticTokenOriginal tokenType
 -> SemanticTokenOriginal tokenType -> Ordering)
-> (SemanticTokenOriginal tokenType
    -> SemanticTokenOriginal tokenType -> Bool)
-> (SemanticTokenOriginal tokenType
    -> SemanticTokenOriginal tokenType -> Bool)
-> (SemanticTokenOriginal tokenType
    -> SemanticTokenOriginal tokenType -> Bool)
-> (SemanticTokenOriginal tokenType
    -> SemanticTokenOriginal tokenType -> Bool)
-> (SemanticTokenOriginal tokenType
    -> SemanticTokenOriginal tokenType
    -> SemanticTokenOriginal tokenType)
-> (SemanticTokenOriginal tokenType
    -> SemanticTokenOriginal tokenType
    -> SemanticTokenOriginal tokenType)
-> Ord (SemanticTokenOriginal tokenType)
SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType -> Bool
SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType -> Ordering
SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall tokenType.
Ord tokenType =>
Eq (SemanticTokenOriginal tokenType)
forall tokenType.
Ord tokenType =>
SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType -> Bool
forall tokenType.
Ord tokenType =>
SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType -> Ordering
forall tokenType.
Ord tokenType =>
SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType
$ccompare :: forall tokenType.
Ord tokenType =>
SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType -> Ordering
compare :: SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType -> Ordering
$c< :: forall tokenType.
Ord tokenType =>
SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType -> Bool
< :: SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType -> Bool
$c<= :: forall tokenType.
Ord tokenType =>
SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType -> Bool
<= :: SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType -> Bool
$c> :: forall tokenType.
Ord tokenType =>
SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType -> Bool
> :: SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType -> Bool
$c>= :: forall tokenType.
Ord tokenType =>
SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType -> Bool
>= :: SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType -> Bool
$cmax :: forall tokenType.
Ord tokenType =>
SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType
max :: SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType
$cmin :: forall tokenType.
Ord tokenType =>
SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType
min :: SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType
-> SemanticTokenOriginal tokenType
Ord)

--
instance (Show tokenType) => Show (SemanticTokenOriginal tokenType) where
  show :: SemanticTokenOriginal tokenType -> String
show (SemanticTokenOriginal tokenType
tk Loc
loc String
name) = Loc -> String
forall a. Show a => a -> String
show Loc
loc String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> tokenType -> String
forall a. Show a => a -> String
show tokenType
tk String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> String
show String
name

data Loc = Loc
  { Loc -> UInt
_line      :: UInt,
    Loc -> UInt
_startChar :: UInt,
    Loc -> UInt
_len       :: UInt
  }
  deriving (Loc -> Loc -> Bool
(Loc -> Loc -> Bool) -> (Loc -> Loc -> Bool) -> Eq Loc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Loc -> Loc -> Bool
== :: Loc -> Loc -> Bool
$c/= :: Loc -> Loc -> Bool
/= :: Loc -> Loc -> Bool
Eq, Eq Loc
Eq Loc =>
(Loc -> Loc -> Ordering)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Loc)
-> (Loc -> Loc -> Loc)
-> Ord Loc
Loc -> Loc -> Bool
Loc -> Loc -> Ordering
Loc -> Loc -> Loc
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Loc -> Loc -> Ordering
compare :: Loc -> Loc -> Ordering
$c< :: Loc -> Loc -> Bool
< :: Loc -> Loc -> Bool
$c<= :: Loc -> Loc -> Bool
<= :: Loc -> Loc -> Bool
$c> :: Loc -> Loc -> Bool
> :: Loc -> Loc -> Bool
$c>= :: Loc -> Loc -> Bool
>= :: Loc -> Loc -> Bool
$cmax :: Loc -> Loc -> Loc
max :: Loc -> Loc -> Loc
$cmin :: Loc -> Loc -> Loc
min :: Loc -> Loc -> Loc
Ord)

instance Show Loc where
  show :: Loc -> String
show (Loc UInt
line UInt
startChar UInt
len) = UInt -> String
forall a. Show a => a -> String
show UInt
line String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UInt -> String
forall a. Show a => a -> String
show UInt
startChar String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UInt -> String
forall a. Show a => a -> String
show (UInt
startChar UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+ UInt
len)

data GetSemanticTokens = GetSemanticTokens
  deriving (GetSemanticTokens -> GetSemanticTokens -> Bool
(GetSemanticTokens -> GetSemanticTokens -> Bool)
-> (GetSemanticTokens -> GetSemanticTokens -> Bool)
-> Eq GetSemanticTokens
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetSemanticTokens -> GetSemanticTokens -> Bool
== :: GetSemanticTokens -> GetSemanticTokens -> Bool
$c/= :: GetSemanticTokens -> GetSemanticTokens -> Bool
/= :: GetSemanticTokens -> GetSemanticTokens -> Bool
Eq, Int -> GetSemanticTokens -> ShowS
[GetSemanticTokens] -> ShowS
GetSemanticTokens -> String
(Int -> GetSemanticTokens -> ShowS)
-> (GetSemanticTokens -> String)
-> ([GetSemanticTokens] -> ShowS)
-> Show GetSemanticTokens
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetSemanticTokens -> ShowS
showsPrec :: Int -> GetSemanticTokens -> ShowS
$cshow :: GetSemanticTokens -> String
show :: GetSemanticTokens -> String
$cshowList :: [GetSemanticTokens] -> ShowS
showList :: [GetSemanticTokens] -> ShowS
Show, Typeable, (forall x. GetSemanticTokens -> Rep GetSemanticTokens x)
-> (forall x. Rep GetSemanticTokens x -> GetSemanticTokens)
-> Generic GetSemanticTokens
forall x. Rep GetSemanticTokens x -> GetSemanticTokens
forall x. GetSemanticTokens -> Rep GetSemanticTokens x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetSemanticTokens -> Rep GetSemanticTokens x
from :: forall x. GetSemanticTokens -> Rep GetSemanticTokens x
$cto :: forall x. Rep GetSemanticTokens x -> GetSemanticTokens
to :: forall x. Rep GetSemanticTokens x -> GetSemanticTokens
Generic)

instance Hashable GetSemanticTokens

instance NFData GetSemanticTokens

type RangeSemanticTokenTypeList = [(Range, HsSemanticTokenType)]

newtype RangeHsSemanticTokenTypes = RangeHsSemanticTokenTypes {RangeHsSemanticTokenTypes -> RangeSemanticTokenTypeList
rangeSemanticList :: RangeSemanticTokenTypeList}

instance NFData RangeHsSemanticTokenTypes where
  rnf :: RangeHsSemanticTokenTypes -> ()
  rnf :: RangeHsSemanticTokenTypes -> ()
rnf (RangeHsSemanticTokenTypes RangeSemanticTokenTypeList
a) = RangeSemanticTokenTypeList -> ()
forall a. a -> ()
rwhnf RangeSemanticTokenTypeList
a

instance Show RangeHsSemanticTokenTypes where
  show :: RangeHsSemanticTokenTypes -> String
show (RangeHsSemanticTokenTypes RangeSemanticTokenTypeList
xs) = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((Range, HsSemanticTokenType) -> String)
-> RangeSemanticTokenTypeList -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Range, HsSemanticTokenType) -> String
showRangeToken RangeSemanticTokenTypeList
xs

showRangeToken :: (Range, HsSemanticTokenType) -> String
showRangeToken :: (Range, HsSemanticTokenType) -> String
showRangeToken (Range
ran, HsSemanticTokenType
tk) = Range -> String
showRange Range
ran String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> HsSemanticTokenType -> String
forall a. Show a => a -> String
show HsSemanticTokenType
tk
showRange :: Range -> String
showRange :: Range -> String
showRange (Range (Position UInt
l1 UInt
c1) (Position UInt
l2 UInt
c2)) = UInt -> String
forall a. Show a => a -> String
show UInt
l1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UInt -> String
forall a. Show a => a -> String
show UInt
c1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UInt -> String
forall a. Show a => a -> String
show UInt
l2 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UInt -> String
forall a. Show a => a -> String
show UInt
c2

type instance RuleResult GetSemanticTokens = RangeHsSemanticTokenTypes

data HieFunMaskKind kind where
  HieFreshFun :: HieFunMaskKind Type
  HieFromDiskFun :: A.Array TypeIndex Bool -> HieFunMaskKind TypeIndex

data SemanticLog
  = LogShake Shake.Log
  | LogNoAST FilePath
  | LogConfig SemanticTokensConfig
  | LogMsg String
  | LogNoVF
  | LogSemanticTokensDeltaMisMatch Text (Maybe Text)
  deriving (Int -> SemanticLog -> ShowS
[SemanticLog] -> ShowS
SemanticLog -> String
(Int -> SemanticLog -> ShowS)
-> (SemanticLog -> String)
-> ([SemanticLog] -> ShowS)
-> Show SemanticLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SemanticLog -> ShowS
showsPrec :: Int -> SemanticLog -> ShowS
$cshow :: SemanticLog -> String
show :: SemanticLog -> String
$cshowList :: [SemanticLog] -> ShowS
showList :: [SemanticLog] -> ShowS
Show)

instance Pretty SemanticLog where
  pretty :: forall ann. SemanticLog -> Doc ann
pretty SemanticLog
theLog = case SemanticLog
theLog of
    LogShake Log
shakeLog -> Log -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Log -> Doc ann
pretty Log
shakeLog
    LogNoAST String
path     -> Doc ann
"no HieAst exist for file" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
path
    SemanticLog
LogNoVF           -> Doc ann
"no VirtualSourceFile exist for file"
    LogConfig SemanticTokensConfig
config  -> Doc ann
"SemanticTokensConfig_: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (SemanticTokensConfig -> String
forall a. Show a => a -> String
show SemanticTokensConfig
config)
    LogMsg String
msg        -> Doc ann
"SemanticLog Debug Message: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
msg
    LogSemanticTokensDeltaMisMatch Text
previousIdFromRequest Maybe Text
previousIdFromCache
                      -> Doc ann
"SemanticTokensDeltaMisMatch: previousIdFromRequest: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
previousIdFromRequest
                      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" previousIdFromCache: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Doc ann
forall ann. Maybe Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe Text
previousIdFromCache


type SemanticTokenId = Text