{-# LANGUAGE StandaloneDeriving #-}
{-# 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                        as Map
import           Development.IDE                 (Position (..), Range (..))
import           Development.IDE.GHC.Compat
import           Ide.Plugin.SemanticTokens.Types
import           Prelude                         hiding (span)

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

instance Show ContextInfo where
    show x = case x of
        Use                -> "Use"
        MatchBind          -> "MatchBind"
        IEThing _          -> "IEThing IEType" -- imported
        TyDecl             -> "TyDecl"
        ValBind bt _ sp    -> "ValBind of " <> show bt <> show sp
        PatternBind {}     -> "PatternBind"
        ClassTyDecl _      -> "ClassTyDecl"
        Decl d _           -> "Decl of " <> show d
        TyVarBind _ _      -> "TyVarBind"
        RecField c _       -> "RecField of " <> show c
        EvidenceVarBind {} -> "EvidenceVarBind"
        EvidenceVarUse     -> "EvidenceVarUse"

showCompactRealSrc :: RealSrcSpan -> String
showCompactRealSrc x = show (srcSpanStartLine x) <> ":" <> show (srcSpanStartCol x) <> "-" <> show (srcSpanEndCol x)

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

showIdentifierDetails :: IdentifierDetails a -> String
showIdentifierDetails x = show $  identInfo x

showIdentifier :: Identifier -> String
showIdentifier (Left x)  = showSDocUnsafe (ppr x)
showIdentifier (Right x) = nameStableString x

showLocatedNames :: [LIdP GhcRn] -> String
showLocatedNames xs = unlines
    [ showSDocUnsafe (ppr locName) ++ " " ++ show (getLoc locName)
    | locName <- xs]

showClearName :: Name -> String
showClearName name = occNameString (occName name) <> ":" <> showSDocUnsafe (ppr name) <> ":" <> showNameType name

showName :: Name -> String
showName name = showSDocUnsafe (ppr name) <> ":" <> showNameType name

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

bytestringString :: ByteString -> String
bytestringString = map (toEnum . fromEnum) . unpack

spanNamesString :: [(Span, Name)] -> String
spanNamesString xs = unlines
    [ showSDocUnsafe (ppr span) ++ " " ++ showSDocUnsafe (ppr name)
    | (span, name) <- xs]

nameTypesString :: [(Name, Type)] -> String
nameTypesString xs = unlines
    [ showSDocUnsafe (ppr span) ++ " " ++ showSDocUnsafe (ppr name)
    | (span, name) <- xs]


nameMapString :: NameSemanticMap -> [Name] -> String
nameMapString nsm  names = unlines
    [ showSDocUnsafe (ppr name) ++ " " ++ show tokenType
    | name <- names
    , let tokenType = lookupNameEnv nsm name
    ]


showSpan :: RealSrcSpan -> String
showSpan x = show (srcSpanStartLine x) <> ":" <> show (srcSpanStartCol x) <> "-" <> show (srcSpanEndCol x)


-- rangeToCodePointRange
mkRange :: (Integral a1, Integral a2) => a1 -> a2 -> a2 -> Range
mkRange startLine startCol len =
    Range (Position (fromIntegral startLine) (fromIntegral startCol)) (Position (fromIntegral startLine) (fromIntegral $ startCol + len))