{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Language.Rzk.VSCode.Handlers where

import           Control.Exception             (SomeException, evaluate, try)
import           Control.Lens
import           Control.Monad                 (forM_, when)
import           Control.Monad.IO.Class        (MonadIO (..))
import           Data.Default.Class
import           Data.List                     (sort, (\\))
import           Data.Maybe                    (fromMaybe, isNothing)
import qualified Data.Text                     as T
import qualified Data.Yaml                     as Yaml
import           Language.LSP.Diagnostics      (partitionBySource)
import           Language.LSP.Protocol.Lens    (HasDetail (detail),
                                                HasDocumentation (documentation),
                                                HasLabel (label),
                                                HasParams (params),
                                                HasTextDocument (textDocument),
                                                HasUri (uri))
import           Language.LSP.Protocol.Message
import           Language.LSP.Protocol.Types
import           Language.LSP.Server
import           System.FilePath               (makeRelative, (</>))
import           System.FilePath.Glob          (compile, globDir)

import           Language.Rzk.Free.Syntax      (RzkPosition (RzkPosition),
                                                VarIdent (getVarIdent))
import           Language.Rzk.Syntax           (Module, VarIdent' (VarIdent),
                                                parseModuleFile, printTree)
import           Language.Rzk.VSCode.Env
import           Language.Rzk.VSCode.Logging
import           Rzk.Project.Config            (ProjectConfig (include))
import           Rzk.TypeCheck

-- | Given a list of file paths, reads them and parses them as Rzk modules,
--   returning the same list of file paths but with the parsed module (or parse error)
parseFiles :: [FilePath] -> IO [(FilePath, Either String Module)]
parseFiles :: [[Char]] -> IO [([Char], Either [Char] Module)]
parseFiles [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
parseFiles ([Char]
x:[[Char]]
xs) = do
  Either [Char] Module
errOrMod <- [Char] -> IO (Either [Char] Module)
parseModuleFile [Char]
x
  [([Char], Either [Char] Module)]
rest <- [[Char]] -> IO [([Char], Either [Char] Module)]
parseFiles [[Char]]
xs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ([Char]
x, Either [Char] Module
errOrMod) forall a. a -> [a] -> [a]
: [([Char], Either [Char] Module)]
rest

-- | Given the list of possible modules returned by `parseFiles`, this segregates the errors
--   from the successfully parsed modules and returns them in separate lists so the errors
--   can be reported and the modules can be typechecked.
collectErrors :: [(FilePath, Either String Module)] -> ([(FilePath, String)], [(FilePath, Module)])
collectErrors :: [([Char], Either [Char] Module)]
-> ([([Char], [Char])], [([Char], Module)])
collectErrors [] = ([], [])
collectErrors (([Char]
path, Either [Char] Module
result) : [([Char], Either [Char] Module)]
paths) =
  case Either [Char] Module
result of
    Left [Char]
err      -> (([Char]
path, [Char]
err) forall a. a -> [a] -> [a]
: [([Char], [Char])]
errors, [([Char], Module)]
modules)
    Right Module
module_ -> ([([Char], [Char])]
errors, ([Char]
path, Module
module_) forall a. a -> [a] -> [a]
: [([Char], Module)]
modules)
  where
    ([([Char], [Char])]
errors, [([Char], Module)]
modules) = [([Char], Either [Char] Module)]
-> ([([Char], [Char])], [([Char], Module)])
collectErrors [([Char], Either [Char] Module)]
paths

-- | The maximum number of diagnostic messages to send to the client
maxDiagnosticCount :: Int
maxDiagnosticCount :: Int
maxDiagnosticCount = Int
100

filePathToNormalizedUri :: FilePath -> NormalizedUri
filePathToNormalizedUri :: [Char] -> NormalizedUri
filePathToNormalizedUri = Uri -> NormalizedUri
toNormalizedUri forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Uri
filePathToUri


typecheckFromConfigFile :: LSP ()
typecheckFromConfigFile :: LSP ()
typecheckFromConfigFile = do
  forall c (m :: * -> *). MonadLsp c m => [Char] -> m ()
logInfo [Char]
"Looking for rzk.yaml"
  Maybe [Char]
root <- forall config (m :: * -> *). MonadLsp config m => m (Maybe [Char])
getRootPath
  case Maybe [Char]
root of
    Maybe [Char]
Nothing -> do
      forall c (m :: * -> *). MonadLsp c m => [Char] -> m ()
logWarning [Char]
"Workspace has no root path, cannot find rzk.yaml"
      forall (m :: Method 'ServerToClient 'Notification) (f :: * -> *)
       config.
MonadLsp config f =>
SServerMethod m -> MessageParams m -> f ()
sendNotification SMethod 'Method_WindowShowMessage
SMethod_WindowShowMessage (MessageType -> Text -> ShowMessageParams
ShowMessageParams MessageType
MessageType_Warning Text
"Cannot find the workspace root")
    Just [Char]
rootPath -> do
      let rzkYamlPath :: [Char]
rzkYamlPath = [Char]
rootPath [Char] -> [Char] -> [Char]
</> [Char]
"rzk.yaml"
      Either ParseException ProjectConfig
eitherConfig <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => [Char] -> IO (Either ParseException a)
Yaml.decodeFileEither @ProjectConfig [Char]
rzkYamlPath
      case Either ParseException ProjectConfig
eitherConfig of
        Left ParseException
err -> do
          forall c (m :: * -> *). MonadLsp c m => [Char] -> m ()
logError ([Char]
"Invalid or missing rzk.yaml: " forall a. [a] -> [a] -> [a]
++ ParseException -> [Char]
Yaml.prettyPrintParseException ParseException
err)

        Right ProjectConfig
config -> do
          forall c (m :: * -> *). MonadLsp c m => [Char] -> m ()
logDebug [Char]
"Starting typechecking"
          [[[Char]]]
rawPaths <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Pattern] -> [Char] -> IO [[[Char]]]
globDir (forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Pattern
compile (ProjectConfig -> [[Char]]
include ProjectConfig
config)) [Char]
rootPath
          let paths :: [[Char]]
paths = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Ord a => [a] -> [a]
sort [[[Char]]]
rawPaths

          RzkTypecheckCache
cachedModules <- LSP RzkTypecheckCache
getCachedTypecheckedModules
          let cachedPaths :: [[Char]]
cachedPaths = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst RzkTypecheckCache
cachedModules
              modifiedFiles :: [[Char]]
modifiedFiles = [[Char]]
paths forall a. Eq a => [a] -> [a] -> [a]
\\ [[Char]]
cachedPaths

          forall c (m :: * -> *). MonadLsp c m => [Char] -> m ()
logDebug ([Char]
"Found " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
cachedPaths) forall a. [a] -> [a] -> [a]
++ [Char]
" files in the cache")
          forall c (m :: * -> *). MonadLsp c m => [Char] -> m ()
logDebug (forall a. Show a => a -> [Char]
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
modifiedFiles) forall a. [a] -> [a] -> [a]
++ [Char]
" files have been modified")

          ([([Char], [Char])]
parseErrors, [([Char], Module)]
parsedModules) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [([Char], Either [Char] Module)]
-> ([([Char], [Char])], [([Char], Module)])
collectErrors forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]] -> IO [([Char], Either [Char] Module)]
parseFiles [[Char]]
modifiedFiles
          Either
  SomeException
  (Either
     (TypeErrorInScopedContext VarIdent)
     (RzkTypecheckCache, [TypeErrorInScopedContext VarIdent]))
tcResults <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$ forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$
            forall var a.
TypeCheck var a -> Either (TypeErrorInScopedContext var) a
defaultTypeCheck (RzkTypecheckCache
-> [([Char], Module)]
-> TypeCheck
     VarIdent (RzkTypecheckCache, [TypeErrorInScopedContext VarIdent])
typecheckModulesWithLocationIncremental RzkTypecheckCache
cachedModules [([Char], Module)]
parsedModules)

          ([TypeErrorInScopedContext VarIdent]
typeErrors, RzkTypecheckCache
_checkedModules) <- case Either
  SomeException
  (Either
     (TypeErrorInScopedContext VarIdent)
     (RzkTypecheckCache, [TypeErrorInScopedContext VarIdent]))
tcResults of
            Left (SomeException
_ex :: SomeException) -> forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])   -- FIXME: publish diagnostics about an exception during typechecking!
            Right (Left TypeErrorInScopedContext VarIdent
err) -> forall (m :: * -> *) a. Monad m => a -> m a
return ([TypeErrorInScopedContext VarIdent
err], [])    -- sort of impossible
            Right (Right (RzkTypecheckCache
checkedModules, [TypeErrorInScopedContext VarIdent]
errors)) -> do
                -- cache well-typed modules
                forall c (m :: * -> *). MonadLsp c m => [Char] -> m ()
logInfo (forall a. Show a => a -> [Char]
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length RzkTypecheckCache
checkedModules) forall a. [a] -> [a] -> [a]
++ [Char]
" modules successfully typechecked")
                forall c (m :: * -> *). MonadLsp c m => [Char] -> m ()
logInfo (forall a. Show a => a -> [Char]
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [TypeErrorInScopedContext VarIdent]
errors) forall a. [a] -> [a] -> [a]
++ [Char]
" errors found")
                RzkTypecheckCache -> LSP ()
cacheTypecheckedModules RzkTypecheckCache
checkedModules
                forall (m :: * -> *) a. Monad m => a -> m a
return ([TypeErrorInScopedContext VarIdent]
errors, RzkTypecheckCache
checkedModules)

          -- Reset all published diags
          -- TODO: remove this after properly grouping by path below, after which there can be an empty list of errors
          -- TODO: handle clearing diagnostics for files that got removed from the project (rzk.yaml)
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[Char]]
paths forall a b. (a -> b) -> a -> b
$ \[Char]
path -> do
            forall config (m :: * -> *).
MonadLsp config m =>
Int -> NormalizedUri -> Maybe Int32 -> DiagnosticsBySource -> m ()
publishDiagnostics Int
0 ([Char] -> NormalizedUri
filePathToNormalizedUri [Char]
path) forall a. Maybe a
Nothing ([Diagnostic] -> DiagnosticsBySource
partitionBySource [])

          -- Report parse errors to the client
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [([Char], [Char])]
parseErrors forall a b. (a -> b) -> a -> b
$ \([Char]
path, [Char]
err) -> do
            forall config (m :: * -> *).
MonadLsp config m =>
Int -> NormalizedUri -> Maybe Int32 -> DiagnosticsBySource -> m ()
publishDiagnostics Int
maxDiagnosticCount ([Char] -> NormalizedUri
filePathToNormalizedUri [Char]
path) forall a. Maybe a
Nothing ([Diagnostic] -> DiagnosticsBySource
partitionBySource [[Char] -> Diagnostic
diagnosticOfParseError [Char]
err])

          -- TODO: collect all errors for one file in one list

          -- Report typechecking errors to the client
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TypeErrorInScopedContext VarIdent]
typeErrors forall a b. (a -> b) -> a -> b
$ \TypeErrorInScopedContext VarIdent
err -> do
            let errPath :: [Char]
errPath = forall var. TypeErrorInScopedContext var -> [Char]
filepathOfTypeError TypeErrorInScopedContext VarIdent
err
                errDiagnostic :: Diagnostic
errDiagnostic = TypeErrorInScopedContext VarIdent -> Diagnostic
diagnosticOfTypeError TypeErrorInScopedContext VarIdent
err
            forall config (m :: * -> *).
MonadLsp config m =>
Int -> NormalizedUri -> Maybe Int32 -> DiagnosticsBySource -> m ()
publishDiagnostics Int
maxDiagnosticCount ([Char] -> NormalizedUri
filePathToNormalizedUri [Char]
errPath) forall a. Maybe a
Nothing ([Diagnostic] -> DiagnosticsBySource
partitionBySource [Diagnostic
errDiagnostic])
  where
    filepathOfTypeError :: TypeErrorInScopedContext var -> FilePath
    filepathOfTypeError :: forall var. TypeErrorInScopedContext var -> [Char]
filepathOfTypeError (PlainTypeError TypeErrorInContext var
err) =
      case forall var. Context var -> Maybe LocationInfo
location (forall var. TypeErrorInContext var -> Context var
typeErrorContext TypeErrorInContext var
err) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LocationInfo -> Maybe [Char]
locationFilePath of
        Just [Char]
path -> [Char]
path
        Maybe [Char]
_         -> forall a. HasCallStack => [Char] -> a
error [Char]
"the impossible happened! Please contact Abdelrahman immediately!!!"
    filepathOfTypeError (ScopedTypeError Maybe VarIdent
_orig TypeErrorInScopedContext (Inc var)
err) = forall var. TypeErrorInScopedContext var -> [Char]
filepathOfTypeError TypeErrorInScopedContext (Inc var)
err

    diagnosticOfTypeError :: TypeErrorInScopedContext VarIdent -> Diagnostic
    diagnosticOfTypeError :: TypeErrorInScopedContext VarIdent -> Diagnostic
diagnosticOfTypeError TypeErrorInScopedContext VarIdent
err = Range
-> Maybe DiagnosticSeverity
-> Maybe (Int32 |? Text)
-> Maybe CodeDescription
-> Maybe Text
-> Text
-> Maybe [DiagnosticTag]
-> Maybe [DiagnosticRelatedInformation]
-> Maybe Value
-> Diagnostic
Diagnostic
                      (Position -> Position -> Range
Range (UInt -> UInt -> Position
Position UInt
line UInt
0) (UInt -> UInt -> Position
Position UInt
line UInt
99)) -- 99 to reach end of line and be visible until we actually have information about it
                      (forall a. a -> Maybe a
Just DiagnosticSeverity
DiagnosticSeverity_Error)
                      (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> a |? b
InR Text
"type-error") -- diagnostic code
                      forall a. Maybe a
Nothing                   -- diagonstic description
                      (forall a. a -> Maybe a
Just Text
"rzk")              -- A human-readable string describing the source of this diagnostic
                      ([Char] -> Text
T.pack [Char]
msg)
                      forall a. Maybe a
Nothing                   -- tags
                      (forall a. a -> Maybe a
Just [])                 -- related information
                      forall a. Maybe a
Nothing                   -- data that is preserved between different calls
      where
        msg :: [Char]
msg = OutputDirection -> TypeErrorInScopedContext VarIdent -> [Char]
ppTypeErrorInScopedContext' OutputDirection
TopDown TypeErrorInScopedContext VarIdent
err

        extractLineNumber :: TypeErrorInScopedContext var -> Maybe Int
        extractLineNumber :: forall var. TypeErrorInScopedContext var -> Maybe Int
extractLineNumber (PlainTypeError TypeErrorInContext var
e)    = do
          LocationInfo
loc <- forall var. Context var -> Maybe LocationInfo
location (forall var. TypeErrorInContext var -> Context var
typeErrorContext TypeErrorInContext var
e)
          Int
lineNo <- LocationInfo -> Maybe Int
locationLine LocationInfo
loc
          forall (m :: * -> *) a. Monad m => a -> m a
return (Int
lineNo forall a. Num a => a -> a -> a
- Int
1) -- VS Code indexes lines from 0, but locationLine starts with 1
        extractLineNumber (ScopedTypeError Maybe VarIdent
_ TypeErrorInScopedContext (Inc var)
e) = forall var. TypeErrorInScopedContext var -> Maybe Int
extractLineNumber TypeErrorInScopedContext (Inc var)
e

        line :: UInt
line = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Int
0 forall a b. (a -> b) -> a -> b
$ forall var. TypeErrorInScopedContext var -> Maybe Int
extractLineNumber TypeErrorInScopedContext VarIdent
err

    diagnosticOfParseError :: String -> Diagnostic
    diagnosticOfParseError :: [Char] -> Diagnostic
diagnosticOfParseError [Char]
err = Range
-> Maybe DiagnosticSeverity
-> Maybe (Int32 |? Text)
-> Maybe CodeDescription
-> Maybe Text
-> Text
-> Maybe [DiagnosticTag]
-> Maybe [DiagnosticRelatedInformation]
-> Maybe Value
-> Diagnostic
Diagnostic (Position -> Position -> Range
Range (UInt -> UInt -> Position
Position UInt
0 UInt
0) (UInt -> UInt -> Position
Position UInt
0 UInt
0))
                      (forall a. a -> Maybe a
Just DiagnosticSeverity
DiagnosticSeverity_Error)
                      (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> a |? b
InR Text
"parse-error")
                      forall a. Maybe a
Nothing
                      (forall a. a -> Maybe a
Just Text
"rzk")
                      ([Char] -> Text
T.pack [Char]
err)
                      forall a. Maybe a
Nothing
                      (forall a. a -> Maybe a
Just [])
                      forall a. Maybe a
Nothing

instance Default T.Text where def :: Text
def = Text
""
instance Default CompletionItem
instance Default CompletionItemLabelDetails

provideCompletions :: Handler LSP 'Method_TextDocumentCompletion
provideCompletions :: Handler
  (LspT () (ReaderT RzkEnv IO)) 'Method_TextDocumentCompletion
provideCompletions TRequestMessage 'Method_TextDocumentCompletion
req Either ResponseError ([CompletionItem] |? (CompletionList |? Null))
-> LSP ()
res = do
  forall c (m :: * -> *). MonadLsp c m => [Char] -> m ()
logInfo [Char]
"Providing text completions"
  Maybe [Char]
root <- forall config (m :: * -> *). MonadLsp config m => m (Maybe [Char])
getRootPath
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing Maybe [Char]
root) forall a b. (a -> b) -> a -> b
$ forall c (m :: * -> *). MonadLsp c m => [Char] -> m ()
logDebug [Char]
"Not in a workspace. Cannot find root path for relative paths"
  let rootDir :: [Char]
rootDir = forall a. a -> Maybe a -> a
fromMaybe [Char]
"/" Maybe [Char]
root
  RzkTypecheckCache
cachedModules <- LSP RzkTypecheckCache
getCachedTypecheckedModules
  forall c (m :: * -> *). MonadLsp c m => [Char] -> m ()
logDebug ([Char]
"Found " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length RzkTypecheckCache
cachedModules) forall a. [a] -> [a] -> [a]
++ [Char]
" modules in the cache")
  let currentFile :: [Char]
currentFile = forall a. a -> Maybe a -> a
fromMaybe [Char]
"" forall a b. (a -> b) -> a -> b
$ Uri -> Maybe [Char]
uriToFilePath forall a b. (a -> b) -> a -> b
$ TRequestMessage 'Method_TextDocumentCompletion
req forall s a. s -> Getting a s a -> a
^. forall s a. HasParams s a => Lens' s a
params forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasTextDocument s a => Lens' s a
textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUri s a => Lens' s a
uri
  -- Take all the modules up to and including the currently open one
  let modules :: RzkTypecheckCache
modules = forall {a}. (a -> Bool) -> [a] -> [a]
takeWhileInc ((forall a. Eq a => a -> a -> Bool
/= [Char]
currentFile) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) RzkTypecheckCache
cachedModules
        where
          takeWhileInc :: (a -> Bool) -> [a] -> [a]
takeWhileInc a -> Bool
_ [] = []
          takeWhileInc a -> Bool
p (a
x:[a]
xs)
            | a -> Bool
p a
x       = a
x forall a. a -> [a] -> [a]
: (a -> Bool) -> [a] -> [a]
takeWhileInc a -> Bool
p [a]
xs
            | Bool
otherwise = [a
x]

  let items :: [CompletionItem]
items = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char] -> ([Char], [Decl']) -> [CompletionItem]
declsToItems [Char]
rootDir) RzkTypecheckCache
modules
  forall c (m :: * -> *). MonadLsp c m => [Char] -> m ()
logDebug ([Char]
"Sending " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [CompletionItem]
items) forall a. [a] -> [a] -> [a]
++ [Char]
" completion items")
  Either ResponseError ([CompletionItem] |? (CompletionList |? Null))
-> LSP ()
res forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a b. a -> a |? b
InL [CompletionItem]
items
  where
    declsToItems :: FilePath -> (FilePath, [Decl']) -> [CompletionItem]
    declsToItems :: [Char] -> ([Char], [Decl']) -> [CompletionItem]
declsToItems [Char]
root ([Char]
path, [Decl']
decls) = forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char] -> Decl' -> CompletionItem
declToItem [Char]
root [Char]
path) [Decl']
decls
    declToItem :: FilePath -> FilePath -> Decl' -> CompletionItem
    declToItem :: [Char] -> [Char] -> Decl' -> CompletionItem
declToItem [Char]
rootDir [Char]
path (Decl VarIdent
name TermT VarIdent
type' Maybe (TermT VarIdent)
_ Bool
_ [VarIdent]
_) = forall a. Default a => a
def
      forall a b. a -> (a -> b) -> b
& forall s a. HasLabel s a => Lens' s a
label forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Char] -> Text
T.pack (forall a. Print a => a -> [Char]
printTree forall a b. (a -> b) -> a -> b
$ VarIdent -> VarIdent' RzkPosition
getVarIdent VarIdent
name)
      forall a b. a -> (a -> b) -> b
& forall s a. HasDetail s a => Lens' s a
detail forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show TermT VarIdent
type')
      forall a b. a -> (a -> b) -> b
& forall s a. HasDocumentation s a => Lens' s a
documentation forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a b. b -> a |? b
InR (MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MarkupKind_Markdown forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$
          [Char]
"---\nDefined" forall a. [a] -> [a] -> [a]
++
          (if Int
line forall a. Ord a => a -> a -> Bool
> Int
0 then [Char]
" at line " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
line else [Char]
"")
          forall a. [a] -> [a] -> [a]
++ [Char]
" in *" forall a. [a] -> [a] -> [a]
++ [Char] -> [Char] -> [Char]
makeRelative [Char]
rootDir [Char]
path forall a. [a] -> [a] -> [a]
++ [Char]
"*")
      where
        (VarIdent RzkPosition
pos VarIdentToken
_) = VarIdent -> VarIdent' RzkPosition
getVarIdent VarIdent
name
        (RzkPosition Maybe [Char]
_path BNFC'Position
pos') = RzkPosition
pos
        line :: Int
line = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 forall a b. (a, b) -> a
fst BNFC'Position
pos'
        _col :: Int
_col = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 forall a b. (a, b) -> b
snd BNFC'Position
pos'