Hover.hs

module Zwirn.Language.LSP.Hover where

import Control.Monad.RWS (gets)
import qualified Data.Text as T
import Zwirn.Language.Compiler
import Zwirn.Language.Environment (AnnotatedExpression (..), lookupFull)
import Zwirn.Language.Location
import Zwirn.Language.Pretty (ppscheme)
import Zwirn.Language.Syntax

-- parses source code
parseAndGetInfoAt :: T.Text -> Position -> CI (Maybe (T.Text, RealSrcLoc))
parseAndGetInfoAt doc pos@(Position l _) = do
  syntax <- getSyntaxLine l doc
  case syntaxGetNodeAt pos =<< syntax of
    Just (Located (SrcLoc p) (TVar x)) -> (\mz -> mz >>= \z -> Just (z, p)) <$> infoMarkdown x
    Just (Located (SrcLoc p) (TNum x)) -> return $ Just (wrapCodeBlock $ x <> " :: Number", p)
    Just (Located (SrcLoc p) (TText x)) -> return $ Just (wrapCodeBlock $ x <> " :: Text", p)
    Just (Located (SrcLoc p) TRest) -> return $ Just (wrapCodeBlock "~ :: a", p)
    Just _ -> return Nothing
    Nothing -> return Nothing

syntaxGetNodeAt :: Position -> Syntax -> Maybe LocTerm
syntaxGetNodeAt p (Command c@(Located _ (ShowCommand t))) = if isContained p c then getNodeAt p t else Nothing
syntaxGetNodeAt p (Command c@(Located _ (TypeCommand t))) = if isContained p c then getNodeAt p t else Nothing
syntaxGetNodeAt _ (Command _) = Nothing
syntaxGetNodeAt p (Exec t) = getNodeAt p t
syntaxGetNodeAt p (Def ldef@(Located _ (Definition _ _ t))) = if isContained p ldef then getNodeAt p t else Nothing
syntaxGetNodeAt p (DynDef ldef@(Located _ (DynamicDefinition _ t))) = if isContained p ldef then getNodeAt p t else Nothing
syntaxGetNodeAt p (MacroDef ldef@(Located _ (MacroDefinition _ t))) = if isContained p ldef then getNodeAt p t else Nothing

getNodeAt :: Position -> LocTerm -> Maybe LocTerm
getNodeAt p lt =
  if isContained p lt
    then
      ( case lt of
          t@(Located _ (TVar _)) -> Just t
          t@(Located _ (TNum _)) -> Just t
          t@(Located _ (TText _)) -> Just t
          t@(Located _ TRest) -> Just t
          (Located _ (TInfix t1 op t2)) -> if isContained p op then Just (fmap TVar op) else findWithPos p [t1, t2] >>= getNodeAt p
          (Located _ (TSectionR op t)) -> if isContained p op then Just (fmap TVar op) else getNodeAt p t
          (Located _ (TSectionL t op)) -> if isContained p op then Just (fmap TVar op) else getNodeAt p t
          (Located _ t) -> findWithPos p (subterms t) >>= getNodeAt p
      )
    else Nothing

infoMarkdown :: T.Text -> CI (Maybe T.Text)
infoMarkdown n = do
  env <- gets intEnv
  case lookupFull n env of
    Just (Annotated _ t (Just d)) -> return $ Just $ wrapCodeBlock (n <> " :: " <> ppscheme t) <> "  \n\n" <> d
    Just (Annotated _ t Nothing) -> return $ Just $ wrapCodeBlock $ n <> " :: " <> ppscheme t
    Nothing -> return Nothing

wrapCodeBlock :: T.Text -> T.Text
wrapCodeBlock t = "``` haskell\n" <> t <> "\n```"