{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies      #-}
{-# OPTIONS_GHC -Wno-orphans #-}


module Ide.Plugin.SemanticTokens.Utils where

import           Data.ByteString            (ByteString)
import           Data.ByteString.Char8      (unpack)
import qualified Data.Map.Strict            as Map
import           Development.IDE            (Position (..), Range (..))
import           Development.IDE.GHC.Compat
import           Prelude                    hiding (length, span)

deriving instance Show DeclType
deriving instance Show BindType
deriving instance Show RecFieldContext

instance Show ContextInfo where
    show :: ContextInfo -> String
show ContextInfo
x = case ContextInfo
x of
        ContextInfo
Use                -> String
"Use"
        ContextInfo
MatchBind          -> String
"MatchBind"
        IEThing IEType
_          -> String
"IEThing IEType" -- imported
        ContextInfo
TyDecl             -> String
"TyDecl"
        ValBind BindType
bt Scope
_ Maybe Span
sp    -> String
"ValBind of " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> BindType -> String
forall a. Show a => a -> String
show BindType
bt String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Maybe Span -> String
forall a. Show a => a -> String
show Maybe Span
sp
        PatternBind {}     -> String
"PatternBind"
        ClassTyDecl Maybe Span
_      -> String
"ClassTyDecl"
        Decl DeclType
d Maybe Span
_           -> String
"Decl of " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> DeclType -> String
forall a. Show a => a -> String
show DeclType
d
        TyVarBind Scope
_ TyVarScope
_      -> String
"TyVarBind"
        RecField RecFieldContext
c Maybe Span
_       -> String
"RecField of " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> RecFieldContext -> String
forall a. Show a => a -> String
show RecFieldContext
c
        EvidenceVarBind {} -> String
"EvidenceVarBind"
        ContextInfo
EvidenceVarUse     -> String
"EvidenceVarUse"

showCompactRealSrc :: RealSrcSpan -> String
showCompactRealSrc :: Span -> String
showCompactRealSrc Span
x = Int -> String
forall a. Show a => a -> String
show (Span -> Int
srcSpanStartLine Span
x) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Span -> Int
srcSpanStartCol Span
x) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Span -> Int
srcSpanEndCol Span
x)

-- type RefMap a = M.Map Identifier [(Span, IdentifierDetails a)]
showRefMap :: RefMap a -> String
showRefMap :: forall a. RefMap a -> String
showRefMap RefMap a
m = [String] -> String
unlines
    [
       Identifier -> String
showIdentifier Identifier
idn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":"
       String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines [SDoc -> String
showSDocUnsafe (Span -> SDoc
forall a. Outputable a => a -> SDoc
ppr Span
span) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ IdentifierDetails a -> String
forall a. IdentifierDetails a -> String
showIdentifierDetails IdentifierDetails a
v | (Span
span, IdentifierDetails a
v) <- [(Span, IdentifierDetails a)]
spans]
    | (Identifier
idn, [(Span, IdentifierDetails a)]
spans) <- RefMap a -> [(Identifier, [(Span, IdentifierDetails a)])]
forall k a. Map k a -> [(k, a)]
Map.toList RefMap a
m]

showIdentifierDetails :: IdentifierDetails a -> String
showIdentifierDetails :: forall a. IdentifierDetails a -> String
showIdentifierDetails IdentifierDetails a
x = Set ContextInfo -> String
forall a. Show a => a -> String
show (Set ContextInfo -> String) -> Set ContextInfo -> String
forall a b. (a -> b) -> a -> b
$  IdentifierDetails a -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo IdentifierDetails a
x

showIdentifier :: Identifier -> String
showIdentifier :: Identifier -> String
showIdentifier (Left ModuleName
x)  = SDoc -> String
showSDocUnsafe (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
x)
showIdentifier (Right Name
x) = Name -> String
nameStableString Name
x

showLocatedNames :: [LIdP GhcRn] -> String
showLocatedNames :: [LIdP GhcRn] -> String
showLocatedNames [LIdP GhcRn]
xs = [String] -> String
unlines
    [ SDoc -> String
showSDocUnsafe (GenLocated SrcSpanAnnN Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnN Name
locName) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SrcSpan -> String
forall a. Show a => a -> String
show (GenLocated SrcSpanAnnN Name -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc GenLocated SrcSpanAnnN Name
locName)
    | GenLocated SrcSpanAnnN Name
locName <- [LIdP GhcRn]
[GenLocated SrcSpanAnnN Name]
xs]

showClearName :: Name -> String
showClearName :: Name -> String
showClearName Name
name = OccName -> String
occNameString (Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
name) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SDoc -> String
showSDocUnsafe (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Name -> String
showNameType Name
name

showName :: Name -> String
showName :: Name -> String
showName Name
name = SDoc -> String
showSDocUnsafe (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Name -> String
showNameType Name
name

showNameType :: Name -> String
showNameType :: Name -> String
showNameType Name
name
    | Name -> Bool
isWiredInName Name
name  = String
"WiredInName"
    | Name -> Bool
isSystemName Name
name   = String
"SystemName"
    | Name -> Bool
isInternalName Name
name = String
"InternalName"
    | Name -> Bool
isExternalName Name
name = String
"ExternalName"
    | Bool
otherwise           = String
"UnknownName"

bytestringString :: ByteString -> String
bytestringString :: ByteString -> String
bytestringString = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Char -> Int) -> Char -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum) ShowS -> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
unpack

spanNamesString :: [(Span, Name)] -> String
spanNamesString :: [(Span, Name)] -> String
spanNamesString [(Span, Name)]
xs = [String] -> String
unlines
    [ SDoc -> String
showSDocUnsafe (Span -> SDoc
forall a. Outputable a => a -> SDoc
ppr Span
span) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SDoc -> String
showSDocUnsafe (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
    | (Span
span, Name
name) <- [(Span, Name)]
xs]

nameTypesString :: [(Name, Type)] -> String
nameTypesString :: [(Name, Type)] -> String
nameTypesString [(Name, Type)]
xs = [String] -> String
unlines
    [ SDoc -> String
showSDocUnsafe (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
span) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SDoc -> String
showSDocUnsafe (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
name)
    | (Name
span, Type
name) <- [(Name, Type)]
xs]


showSpan :: RealSrcSpan -> String
showSpan :: Span -> String
showSpan Span
x = Int -> String
forall a. Show a => a -> String
show (Span -> Int
srcSpanStartLine Span
x) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Span -> Int
srcSpanStartCol Span
x) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Span -> Int
srcSpanEndCol Span
x)


-- rangeToCodePointRange
mkRange :: (Integral a1, Integral a2) => a1 -> a2 -> a2 -> Range
mkRange :: forall a1 a2. (Integral a1, Integral a2) => a1 -> a2 -> a2 -> Range
mkRange a1
startLine a2
startCol a2
len =
    Position -> Position -> Range
Range (UInt -> UInt -> Position
Position (a1 -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral a1
startLine) (a2 -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral a2
startCol)) (UInt -> UInt -> Position
Position (a1 -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral a1
startLine) (a2 -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a2 -> UInt) -> a2 -> UInt
forall a b. (a -> b) -> a -> b
$ a2
startCol a2 -> a2 -> a2
forall a. Num a => a -> a -> a
+ a2
len))


rangeShortStr :: Range -> String
rangeShortStr :: Range -> String
rangeShortStr (Range (Position UInt
startLine UInt
startColumn) (Position UInt
endLine UInt
endColumn)) =
    UInt -> String
forall a. Show a => a -> String
show UInt
startLine 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
startColumn 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
endLine 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
endColumn