module Ide.Plugin.Notes (descriptor, Log) where

import           Control.Lens                     ((^.))
import           Control.Monad.Except             (throwError)
import           Control.Monad.IO.Class           (liftIO)
import           Control.Monad.Trans              (lift)
import qualified Data.Array                       as A
import           Data.HashMap.Strict              (HashMap)
import qualified Data.HashMap.Strict              as HM
import qualified Data.HashSet                     as HS
import           Data.Maybe                       (catMaybes, listToMaybe,
                                                   mapMaybe)
import           Data.Text                        (Text, intercalate)
import qualified Data.Text                        as T
import qualified Data.Text.Utf16.Rope.Mixed       as Rope
import           Development.IDE                  hiding (line)
import           Development.IDE.Core.PluginUtils (runActionE, useE)
import           Development.IDE.Core.Shake       (toKnownFiles)
import qualified Development.IDE.Core.Shake       as Shake
import           Development.IDE.Graph.Classes    (Hashable, NFData)
import           GHC.Generics                     (Generic)
import           Ide.Plugin.Error                 (PluginError (..))
import           Ide.Types
import qualified Language.LSP.Protocol.Lens       as L
import           Language.LSP.Protocol.Message    (Method (Method_TextDocumentDefinition),
                                                   SMethod (SMethod_TextDocumentDefinition))
import           Language.LSP.Protocol.Types
import           Language.LSP.VFS                 (VirtualFile (..))
import           Text.Regex.TDFA                  (Regex, caseSensitive,
                                                   defaultCompOpt,
                                                   defaultExecOpt,
                                                   makeRegexOpts, matchAllText)

data Log
    = LogShake Shake.Log
    | LogNotesFound NormalizedFilePath [(Text, Position)]
    deriving MatchOffset -> Log -> ShowS
[Log] -> ShowS
Log -> String
(MatchOffset -> Log -> ShowS)
-> (Log -> String) -> ([Log] -> ShowS) -> Show Log
forall a.
(MatchOffset -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: MatchOffset -> Log -> ShowS
showsPrec :: MatchOffset -> Log -> ShowS
$cshow :: Log -> String
show :: Log -> String
$cshowList :: [Log] -> ShowS
showList :: [Log] -> ShowS
Show

data GetNotesInFile = MkGetNotesInFile
    deriving (MatchOffset -> GetNotesInFile -> ShowS
[GetNotesInFile] -> ShowS
GetNotesInFile -> String
(MatchOffset -> GetNotesInFile -> ShowS)
-> (GetNotesInFile -> String)
-> ([GetNotesInFile] -> ShowS)
-> Show GetNotesInFile
forall a.
(MatchOffset -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: MatchOffset -> GetNotesInFile -> ShowS
showsPrec :: MatchOffset -> GetNotesInFile -> ShowS
$cshow :: GetNotesInFile -> String
show :: GetNotesInFile -> String
$cshowList :: [GetNotesInFile] -> ShowS
showList :: [GetNotesInFile] -> ShowS
Show, (forall x. GetNotesInFile -> Rep GetNotesInFile x)
-> (forall x. Rep GetNotesInFile x -> GetNotesInFile)
-> Generic GetNotesInFile
forall x. Rep GetNotesInFile x -> GetNotesInFile
forall x. GetNotesInFile -> Rep GetNotesInFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetNotesInFile -> Rep GetNotesInFile x
from :: forall x. GetNotesInFile -> Rep GetNotesInFile x
$cto :: forall x. Rep GetNotesInFile x -> GetNotesInFile
to :: forall x. Rep GetNotesInFile x -> GetNotesInFile
Generic, GetNotesInFile -> GetNotesInFile -> Bool
(GetNotesInFile -> GetNotesInFile -> Bool)
-> (GetNotesInFile -> GetNotesInFile -> Bool) -> Eq GetNotesInFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetNotesInFile -> GetNotesInFile -> Bool
== :: GetNotesInFile -> GetNotesInFile -> Bool
$c/= :: GetNotesInFile -> GetNotesInFile -> Bool
/= :: GetNotesInFile -> GetNotesInFile -> Bool
Eq, Eq GetNotesInFile
Eq GetNotesInFile =>
(GetNotesInFile -> GetNotesInFile -> Ordering)
-> (GetNotesInFile -> GetNotesInFile -> Bool)
-> (GetNotesInFile -> GetNotesInFile -> Bool)
-> (GetNotesInFile -> GetNotesInFile -> Bool)
-> (GetNotesInFile -> GetNotesInFile -> Bool)
-> (GetNotesInFile -> GetNotesInFile -> GetNotesInFile)
-> (GetNotesInFile -> GetNotesInFile -> GetNotesInFile)
-> Ord GetNotesInFile
GetNotesInFile -> GetNotesInFile -> Bool
GetNotesInFile -> GetNotesInFile -> Ordering
GetNotesInFile -> GetNotesInFile -> GetNotesInFile
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 :: GetNotesInFile -> GetNotesInFile -> Ordering
compare :: GetNotesInFile -> GetNotesInFile -> Ordering
$c< :: GetNotesInFile -> GetNotesInFile -> Bool
< :: GetNotesInFile -> GetNotesInFile -> Bool
$c<= :: GetNotesInFile -> GetNotesInFile -> Bool
<= :: GetNotesInFile -> GetNotesInFile -> Bool
$c> :: GetNotesInFile -> GetNotesInFile -> Bool
> :: GetNotesInFile -> GetNotesInFile -> Bool
$c>= :: GetNotesInFile -> GetNotesInFile -> Bool
>= :: GetNotesInFile -> GetNotesInFile -> Bool
$cmax :: GetNotesInFile -> GetNotesInFile -> GetNotesInFile
max :: GetNotesInFile -> GetNotesInFile -> GetNotesInFile
$cmin :: GetNotesInFile -> GetNotesInFile -> GetNotesInFile
min :: GetNotesInFile -> GetNotesInFile -> GetNotesInFile
Ord)
    deriving anyclass (Eq GetNotesInFile
Eq GetNotesInFile =>
(MatchOffset -> GetNotesInFile -> MatchOffset)
-> (GetNotesInFile -> MatchOffset) -> Hashable GetNotesInFile
MatchOffset -> GetNotesInFile -> MatchOffset
GetNotesInFile -> MatchOffset
forall a.
Eq a =>
(MatchOffset -> a -> MatchOffset)
-> (a -> MatchOffset) -> Hashable a
$chashWithSalt :: MatchOffset -> GetNotesInFile -> MatchOffset
hashWithSalt :: MatchOffset -> GetNotesInFile -> MatchOffset
$chash :: GetNotesInFile -> MatchOffset
hash :: GetNotesInFile -> MatchOffset
Hashable, GetNotesInFile -> ()
(GetNotesInFile -> ()) -> NFData GetNotesInFile
forall a. (a -> ()) -> NFData a
$crnf :: GetNotesInFile -> ()
rnf :: GetNotesInFile -> ()
NFData)
type instance RuleResult GetNotesInFile = HM.HashMap Text Position

data GetNotes = MkGetNotes
    deriving (MatchOffset -> GetNotes -> ShowS
[GetNotes] -> ShowS
GetNotes -> String
(MatchOffset -> GetNotes -> ShowS)
-> (GetNotes -> String) -> ([GetNotes] -> ShowS) -> Show GetNotes
forall a.
(MatchOffset -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: MatchOffset -> GetNotes -> ShowS
showsPrec :: MatchOffset -> GetNotes -> ShowS
$cshow :: GetNotes -> String
show :: GetNotes -> String
$cshowList :: [GetNotes] -> ShowS
showList :: [GetNotes] -> ShowS
Show, (forall x. GetNotes -> Rep GetNotes x)
-> (forall x. Rep GetNotes x -> GetNotes) -> Generic GetNotes
forall x. Rep GetNotes x -> GetNotes
forall x. GetNotes -> Rep GetNotes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetNotes -> Rep GetNotes x
from :: forall x. GetNotes -> Rep GetNotes x
$cto :: forall x. Rep GetNotes x -> GetNotes
to :: forall x. Rep GetNotes x -> GetNotes
Generic, GetNotes -> GetNotes -> Bool
(GetNotes -> GetNotes -> Bool)
-> (GetNotes -> GetNotes -> Bool) -> Eq GetNotes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetNotes -> GetNotes -> Bool
== :: GetNotes -> GetNotes -> Bool
$c/= :: GetNotes -> GetNotes -> Bool
/= :: GetNotes -> GetNotes -> Bool
Eq, Eq GetNotes
Eq GetNotes =>
(GetNotes -> GetNotes -> Ordering)
-> (GetNotes -> GetNotes -> Bool)
-> (GetNotes -> GetNotes -> Bool)
-> (GetNotes -> GetNotes -> Bool)
-> (GetNotes -> GetNotes -> Bool)
-> (GetNotes -> GetNotes -> GetNotes)
-> (GetNotes -> GetNotes -> GetNotes)
-> Ord GetNotes
GetNotes -> GetNotes -> Bool
GetNotes -> GetNotes -> Ordering
GetNotes -> GetNotes -> GetNotes
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 :: GetNotes -> GetNotes -> Ordering
compare :: GetNotes -> GetNotes -> Ordering
$c< :: GetNotes -> GetNotes -> Bool
< :: GetNotes -> GetNotes -> Bool
$c<= :: GetNotes -> GetNotes -> Bool
<= :: GetNotes -> GetNotes -> Bool
$c> :: GetNotes -> GetNotes -> Bool
> :: GetNotes -> GetNotes -> Bool
$c>= :: GetNotes -> GetNotes -> Bool
>= :: GetNotes -> GetNotes -> Bool
$cmax :: GetNotes -> GetNotes -> GetNotes
max :: GetNotes -> GetNotes -> GetNotes
$cmin :: GetNotes -> GetNotes -> GetNotes
min :: GetNotes -> GetNotes -> GetNotes
Ord)
    deriving anyclass (Eq GetNotes
Eq GetNotes =>
(MatchOffset -> GetNotes -> MatchOffset)
-> (GetNotes -> MatchOffset) -> Hashable GetNotes
MatchOffset -> GetNotes -> MatchOffset
GetNotes -> MatchOffset
forall a.
Eq a =>
(MatchOffset -> a -> MatchOffset)
-> (a -> MatchOffset) -> Hashable a
$chashWithSalt :: MatchOffset -> GetNotes -> MatchOffset
hashWithSalt :: MatchOffset -> GetNotes -> MatchOffset
$chash :: GetNotes -> MatchOffset
hash :: GetNotes -> MatchOffset
Hashable, GetNotes -> ()
(GetNotes -> ()) -> NFData GetNotes
forall a. (a -> ()) -> NFData a
$crnf :: GetNotes -> ()
rnf :: GetNotes -> ()
NFData)
type instance RuleResult GetNotes = HashMap Text (NormalizedFilePath, Position)

instance Pretty Log where
    pretty :: forall ann. Log -> Doc ann
pretty = \case
        LogShake Log
l -> Log -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Log -> Doc ann
pretty Log
l
        LogNotesFound NormalizedFilePath
file [(Text, Position)]
notes ->
            Doc ann
"Found notes in " 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 (NormalizedFilePath -> String
forall a. Show a => a -> String
show NormalizedFilePath
file) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
": ["
            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 -> [Text] -> Text
intercalate Text
", " (((Text, Position) -> Text) -> [(Text, Position)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Text
s, Position
p) -> Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Position -> String
forall a. Show a => a -> String
show Position
p)) [(Text, Position)]
notes)) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"]"

{-
The first time the user requests a jump-to-definition on a note reference, the
project is indexed and searched for all note definitions. Their location and
title is then saved in the HLS database to be retrieved for all future requests.
-}
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
descriptor :: Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
descriptor Recorder (WithPriority Log)
recorder PluginId
plId = (PluginId -> Text -> PluginDescriptor IdeState
forall ideState. PluginId -> Text -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId Text
"Provides goto definition support for GHC-style notes")
    { Ide.Types.pluginRules = findNotesRules recorder
    , Ide.Types.pluginHandlers = mkPluginHandler SMethod_TextDocumentDefinition jumpToNote
    }

findNotesRules :: Recorder (WithPriority Log) -> Rules ()
findNotesRules :: Recorder (WithPriority Log) -> Rules ()
findNotesRules Recorder (WithPriority Log)
recorder = do
    Recorder (WithPriority Log)
-> (GetNotesInFile
    -> NormalizedFilePath -> Action (Maybe (HashMap Text Position)))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (Maybe v)) -> Rules ()
defineNoDiagnostics ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((GetNotesInFile
  -> NormalizedFilePath -> Action (Maybe (HashMap Text Position)))
 -> Rules ())
-> (GetNotesInFile
    -> NormalizedFilePath -> Action (Maybe (HashMap Text Position)))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetNotesInFile
MkGetNotesInFile NormalizedFilePath
nfp -> do
        NormalizedFilePath
-> Recorder (WithPriority Log)
-> Action (Maybe (HashMap Text Position))
findNotesInFile NormalizedFilePath
nfp Recorder (WithPriority Log)
recorder

    Recorder (WithPriority Log)
-> (GetNotes
    -> NormalizedFilePath
    -> Action (Maybe (HashMap Text (NormalizedFilePath, Position))))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (Maybe v)) -> Rules ()
defineNoDiagnostics ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((GetNotes
  -> NormalizedFilePath
  -> Action (Maybe (HashMap Text (NormalizedFilePath, Position))))
 -> Rules ())
-> (GetNotes
    -> NormalizedFilePath
    -> Action (Maybe (HashMap Text (NormalizedFilePath, Position))))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetNotes
MkGetNotes NormalizedFilePath
_ -> do
        HashSet NormalizedFilePath
targets <- KnownTargets -> HashSet NormalizedFilePath
toKnownFiles (KnownTargets -> HashSet NormalizedFilePath)
-> Action KnownTargets -> Action (HashSet NormalizedFilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetKnownTargets -> Action KnownTargets
forall k v. IdeRule k v => k -> Action v
useNoFile_ GetKnownTargets
GetKnownTargets
        [HashMap Text (NormalizedFilePath, Position)]
definedNotes <- [Maybe (HashMap Text (NormalizedFilePath, Position))]
-> [HashMap Text (NormalizedFilePath, Position)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (HashMap Text (NormalizedFilePath, Position))]
 -> [HashMap Text (NormalizedFilePath, Position)])
-> Action [Maybe (HashMap Text (NormalizedFilePath, Position))]
-> Action [HashMap Text (NormalizedFilePath, Position)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NormalizedFilePath
 -> Action (Maybe (HashMap Text (NormalizedFilePath, Position))))
-> [NormalizedFilePath]
-> Action [Maybe (HashMap Text (NormalizedFilePath, Position))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\NormalizedFilePath
nfp -> (HashMap Text Position
 -> HashMap Text (NormalizedFilePath, Position))
-> Maybe (HashMap Text Position)
-> Maybe (HashMap Text (NormalizedFilePath, Position))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Position -> (NormalizedFilePath, Position))
-> HashMap Text Position
-> HashMap Text (NormalizedFilePath, Position)
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map (NormalizedFilePath
nfp,)) (Maybe (HashMap Text Position)
 -> Maybe (HashMap Text (NormalizedFilePath, Position)))
-> Action (Maybe (HashMap Text Position))
-> Action (Maybe (HashMap Text (NormalizedFilePath, Position)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetNotesInFile
-> NormalizedFilePath -> Action (Maybe (HashMap Text Position))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetNotesInFile
MkGetNotesInFile NormalizedFilePath
nfp) (HashSet NormalizedFilePath -> [NormalizedFilePath]
forall a. HashSet a -> [a]
HS.toList HashSet NormalizedFilePath
targets)
        Maybe (HashMap Text (NormalizedFilePath, Position))
-> Action (Maybe (HashMap Text (NormalizedFilePath, Position)))
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (HashMap Text (NormalizedFilePath, Position))
 -> Action (Maybe (HashMap Text (NormalizedFilePath, Position))))
-> Maybe (HashMap Text (NormalizedFilePath, Position))
-> Action (Maybe (HashMap Text (NormalizedFilePath, Position)))
forall a b. (a -> b) -> a -> b
$ HashMap Text (NormalizedFilePath, Position)
-> Maybe (HashMap Text (NormalizedFilePath, Position))
forall a. a -> Maybe a
Just (HashMap Text (NormalizedFilePath, Position)
 -> Maybe (HashMap Text (NormalizedFilePath, Position)))
-> HashMap Text (NormalizedFilePath, Position)
-> Maybe (HashMap Text (NormalizedFilePath, Position))
forall a b. (a -> b) -> a -> b
$ [HashMap Text (NormalizedFilePath, Position)]
-> HashMap Text (NormalizedFilePath, Position)
forall k v. Eq k => [HashMap k v] -> HashMap k v
HM.unions [HashMap Text (NormalizedFilePath, Position)]
definedNotes

jumpToNote :: PluginMethodHandler IdeState Method_TextDocumentDefinition
jumpToNote :: PluginMethodHandler IdeState 'Method_TextDocumentDefinition
jumpToNote IdeState
state PluginId
_ MessageParams 'Method_TextDocumentDefinition
param
    | Just NormalizedFilePath
nfp <- NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath NormalizedUri
uriOrig
    = do
        let Position UInt
l UInt
c = MessageParams 'Method_TextDocumentDefinition
DefinitionParams
param DefinitionParams
-> Getting Position DefinitionParams Position -> Position
forall s a. s -> Getting a s a -> a
^. Getting Position DefinitionParams Position
forall s a. HasPosition s a => Lens' s a
Lens' DefinitionParams Position
L.position
        Rope
contents <- (VirtualFile -> Rope)
-> ExceptT PluginError (HandlerM Config) VirtualFile
-> ExceptT PluginError (HandlerM Config) Rope
forall a b.
(a -> b)
-> ExceptT PluginError (HandlerM Config) a
-> ExceptT PluginError (HandlerM Config) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VirtualFile -> Rope
_file_text (ExceptT PluginError (HandlerM Config) VirtualFile
 -> ExceptT PluginError (HandlerM Config) Rope)
-> (Maybe VirtualFile
    -> ExceptT PluginError (HandlerM Config) VirtualFile)
-> Maybe VirtualFile
-> ExceptT PluginError (HandlerM Config) Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Maybe VirtualFile
-> ExceptT PluginError (HandlerM Config) VirtualFile
forall {m :: * -> *} {a}.
MonadError PluginError m =>
Text -> Maybe a -> m a
err Text
"Error getting file contents"
            (Maybe VirtualFile -> ExceptT PluginError (HandlerM Config) Rope)
-> ExceptT PluginError (HandlerM Config) (Maybe VirtualFile)
-> ExceptT PluginError (HandlerM Config) Rope
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HandlerM Config (Maybe VirtualFile)
-> ExceptT PluginError (HandlerM Config) (Maybe VirtualFile)
forall (m :: * -> *) a. Monad m => m a -> ExceptT PluginError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (NormalizedUri -> HandlerM Config (Maybe VirtualFile)
forall config. NormalizedUri -> HandlerM config (Maybe VirtualFile)
pluginGetVirtualFile NormalizedUri
uriOrig)
        Text
line <- Text -> Maybe Text -> ExceptT PluginError (HandlerM Config) Text
forall {m :: * -> *} {a}.
MonadError PluginError m =>
Text -> Maybe a -> m a
err Text
"Line not found in file" ([Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Rope -> [Text]
Rope.lines (Rope -> [Text]) -> Rope -> [Text]
forall a b. (a -> b) -> a -> b
$ (Rope, Rope) -> Rope
forall a b. (a, b) -> a
fst
            (Word -> Rope -> (Rope, Rope)
Rope.splitAtLine Word
1 (Rope -> (Rope, Rope)) -> Rope -> (Rope, Rope)
forall a b. (a -> b) -> a -> b
$ (Rope, Rope) -> Rope
forall a b. (a, b) -> b
snd ((Rope, Rope) -> Rope) -> (Rope, Rope) -> Rope
forall a b. (a -> b) -> a -> b
$ Word -> Rope -> (Rope, Rope)
Rope.splitAtLine (UInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
l) Rope
contents))
        let noteOpt :: Maybe Text
noteOpt = [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Array MatchOffset (Text, (MatchOffset, MatchOffset))
 -> Maybe Text)
-> [Array MatchOffset (Text, (MatchOffset, MatchOffset))] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (MatchOffset
-> Array MatchOffset (Text, (MatchOffset, MatchOffset))
-> Maybe Text
forall {i} {a} {a}.
(Ix i, Num i, Num a, Ord a) =>
a -> Array i (a, (a, a)) -> Maybe a
atPos (MatchOffset
 -> Array MatchOffset (Text, (MatchOffset, MatchOffset))
 -> Maybe Text)
-> MatchOffset
-> Array MatchOffset (Text, (MatchOffset, MatchOffset))
-> Maybe Text
forall a b. (a -> b) -> a -> b
$ UInt -> MatchOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
c) ([Array MatchOffset (Text, (MatchOffset, MatchOffset))] -> [Text])
-> [Array MatchOffset (Text, (MatchOffset, MatchOffset))] -> [Text]
forall a b. (a -> b) -> a -> b
$ Regex
-> Text -> [Array MatchOffset (Text, (MatchOffset, MatchOffset))]
forall regex source.
RegexLike regex source =>
regex -> source -> [MatchText source]
matchAllText Regex
noteRefRegex Text
line
        case Maybe Text
noteOpt of
            Maybe Text
Nothing -> (Definition |? ([DefinitionLink] |? Null))
-> ExceptT
     PluginError
     (HandlerM Config)
     (Definition |? ([DefinitionLink] |? Null))
forall a. a -> ExceptT PluginError (HandlerM Config) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([DefinitionLink] |? Null)
-> Definition |? ([DefinitionLink] |? Null)
forall a b. b -> a |? b
InR (Null -> [DefinitionLink] |? Null
forall a b. b -> a |? b
InR Null
Null))
            Just Text
note -> do
                HashMap Text (NormalizedFilePath, Position)
notes <- String
-> IdeState
-> ExceptT
     PluginError Action (HashMap Text (NormalizedFilePath, Position))
-> ExceptT
     PluginError
     (HandlerM Config)
     (HashMap Text (NormalizedFilePath, Position))
forall (m :: * -> *) e a.
MonadIO m =>
String -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE String
"notes.definedNotes" IdeState
state (ExceptT
   PluginError Action (HashMap Text (NormalizedFilePath, Position))
 -> ExceptT
      PluginError
      (HandlerM Config)
      (HashMap Text (NormalizedFilePath, Position)))
-> ExceptT
     PluginError Action (HashMap Text (NormalizedFilePath, Position))
-> ExceptT
     PluginError
     (HandlerM Config)
     (HashMap Text (NormalizedFilePath, Position))
forall a b. (a -> b) -> a -> b
$ GetNotes
-> NormalizedFilePath
-> ExceptT
     PluginError Action (HashMap Text (NormalizedFilePath, Position))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> ExceptT PluginError Action v
useE GetNotes
MkGetNotes NormalizedFilePath
nfp
                (NormalizedFilePath
noteFp, Position
pos) <- Text
-> Maybe (NormalizedFilePath, Position)
-> ExceptT
     PluginError (HandlerM Config) (NormalizedFilePath, Position)
forall {m :: * -> *} {a}.
MonadError PluginError m =>
Text -> Maybe a -> m a
err (Text
"Note definition (a comment of the form `{- Note [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
note Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]\\n~~~ ... -}`) not found") (Text
-> HashMap Text (NormalizedFilePath, Position)
-> Maybe (NormalizedFilePath, Position)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
note HashMap Text (NormalizedFilePath, Position)
notes)
                (Definition |? ([DefinitionLink] |? Null))
-> ExceptT
     PluginError
     (HandlerM Config)
     (Definition |? ([DefinitionLink] |? Null))
forall a. a -> ExceptT PluginError (HandlerM Config) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Definition |? ([DefinitionLink] |? Null))
 -> ExceptT
      PluginError
      (HandlerM Config)
      (Definition |? ([DefinitionLink] |? Null)))
-> (Definition |? ([DefinitionLink] |? Null))
-> ExceptT
     PluginError
     (HandlerM Config)
     (Definition |? ([DefinitionLink] |? Null))
forall a b. (a -> b) -> a -> b
$ Definition -> Definition |? ([DefinitionLink] |? Null)
forall a b. a -> a |? b
InL ((Location |? [Location]) -> Definition
Definition (Location -> Location |? [Location]
forall a b. a -> a |? b
InL
                        (Uri -> Range -> Location
Location (NormalizedUri -> Uri
fromNormalizedUri (NormalizedUri -> Uri) -> NormalizedUri -> Uri
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> NormalizedUri
normalizedFilePathToUri NormalizedFilePath
noteFp) (Position -> Position -> Range
Range Position
pos Position
pos))
                    ))
    where
        uriOrig :: NormalizedUri
uriOrig = Uri -> NormalizedUri
toNormalizedUri (Uri -> NormalizedUri) -> Uri -> NormalizedUri
forall a b. (a -> b) -> a -> b
$ MessageParams 'Method_TextDocumentDefinition
DefinitionParams
param DefinitionParams -> Getting Uri DefinitionParams Uri -> Uri
forall s a. s -> Getting a s a -> a
^. ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> DefinitionParams -> Const Uri DefinitionParams
forall s a. HasTextDocument s a => Lens' s a
Lens' DefinitionParams TextDocumentIdentifier
L.textDocument ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> DefinitionParams -> Const Uri DefinitionParams)
-> ((Uri -> Const Uri Uri)
    -> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> Getting Uri DefinitionParams Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const Uri Uri)
-> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
L.uri)
        err :: Text -> Maybe a -> m a
err Text
s = m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PluginError -> m a
forall a. PluginError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError -> m a) -> PluginError -> m a
forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInternalError Text
s) a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        atPos :: a -> Array i (a, (a, a)) -> Maybe a
atPos a
c Array i (a, (a, a))
arr = case Array i (a, (a, a))
arr Array i (a, (a, a)) -> i -> (a, (a, a))
forall i e. Ix i => Array i e -> i -> e
A.! i
0 of
            -- We check if the line we are currently at contains a note
            -- reference. However, we need to know if the cursor is within the
            -- match or somewhere else. The second entry of the array contains
            -- the title of the note as extracted by the regex.
            (a
_, (a
c', a
len)) -> if a
c' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
c Bool -> Bool -> Bool
&& a
c a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
c' a -> a -> a
forall a. Num a => a -> a -> a
+ a
len
                then a -> Maybe a
forall a. a -> Maybe a
Just ((a, (a, a)) -> a
forall a b. (a, b) -> a
fst (Array i (a, (a, a))
arr Array i (a, (a, a)) -> i -> (a, (a, a))
forall i e. Ix i => Array i e -> i -> e
A.! i
1)) else Maybe a
forall a. Maybe a
Nothing
jumpToNote IdeState
_ PluginId
_ MessageParams 'Method_TextDocumentDefinition
_ = PluginError
-> ExceptT
     PluginError
     (HandlerM Config)
     (MessageResult 'Method_TextDocumentDefinition)
forall a. PluginError -> ExceptT PluginError (HandlerM Config) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PluginError
 -> ExceptT
      PluginError
      (HandlerM Config)
      (MessageResult 'Method_TextDocumentDefinition))
-> PluginError
-> ExceptT
     PluginError
     (HandlerM Config)
     (MessageResult 'Method_TextDocumentDefinition)
forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInternalError Text
"conversion to normalized file path failed"

findNotesInFile :: NormalizedFilePath -> Recorder (WithPriority Log) -> Action (Maybe (HM.HashMap Text Position))
findNotesInFile :: NormalizedFilePath
-> Recorder (WithPriority Log)
-> Action (Maybe (HashMap Text Position))
findNotesInFile NormalizedFilePath
file Recorder (WithPriority Log)
recorder = do
    -- GetFileContents only returns a value if the file is open in the editor of
    -- the user. If not, we need to read it from disk.
    Maybe Text
contentOpt <- ((FileVersion, Maybe Text) -> Maybe Text
forall a b. (a, b) -> b
snd =<<) (Maybe (FileVersion, Maybe Text) -> Maybe Text)
-> Action (Maybe (FileVersion, Maybe Text)) -> Action (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetFileContents
-> NormalizedFilePath -> Action (Maybe (FileVersion, Maybe Text))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetFileContents
GetFileContents NormalizedFilePath
file
    Text
content <- case Maybe Text
contentOpt of
        Just Text
x  -> Text -> Action Text
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
x
        Maybe Text
Nothing -> IO Text -> Action Text
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> Action Text) -> IO Text -> Action Text
forall a b. (a -> b) -> a -> b
$ String -> IO Text
readFileUtf8 (String -> IO Text) -> String -> IO Text
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
file
    let matches :: [(Text, (MatchOffset, MatchOffset))]
matches = (Array MatchOffset (Text, (MatchOffset, MatchOffset))
-> MatchOffset -> (Text, (MatchOffset, MatchOffset))
forall i e. Ix i => Array i e -> i -> e
A.! MatchOffset
1) (Array MatchOffset (Text, (MatchOffset, MatchOffset))
 -> (Text, (MatchOffset, MatchOffset)))
-> [Array MatchOffset (Text, (MatchOffset, MatchOffset))]
-> [(Text, (MatchOffset, MatchOffset))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Regex
-> Text -> [Array MatchOffset (Text, (MatchOffset, MatchOffset))]
forall regex source.
RegexLike regex source =>
regex -> source -> [MatchText source]
matchAllText Regex
noteRegex Text
content
        m :: HashMap Text Position
m = [(Text, (MatchOffset, MatchOffset))]
-> Text -> HashMap Text Position
toPositions [(Text, (MatchOffset, MatchOffset))]
matches Text
content
    Recorder (WithPriority Log) -> Priority -> Log -> Action ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Debug (Log -> Action ()) -> Log -> Action ()
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> [(Text, Position)] -> Log
LogNotesFound NormalizedFilePath
file (HashMap Text Position -> [(Text, Position)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Text Position
m)
    Maybe (HashMap Text Position)
-> Action (Maybe (HashMap Text Position))
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (HashMap Text Position)
 -> Action (Maybe (HashMap Text Position)))
-> Maybe (HashMap Text Position)
-> Action (Maybe (HashMap Text Position))
forall a b. (a -> b) -> a -> b
$ HashMap Text Position -> Maybe (HashMap Text Position)
forall a. a -> Maybe a
Just HashMap Text Position
m
    where
        uint :: MatchOffset -> UInt
uint = Integer -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> UInt)
-> (MatchOffset -> Integer) -> MatchOffset -> UInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchOffset -> Integer
forall a. Integral a => a -> Integer
toInteger
        -- the regex library returns the character index of the match. However
        -- to return the position from HLS we need it as a (line, character)
        -- tuple. To convert between the two we count the newline characters and
        -- reset the current character index every time. For every regex match,
        -- once we have counted up to their character index, we save the current
        -- line and character values instead.
        toPositions :: [(Text, (MatchOffset, MatchOffset))]
-> Text -> HashMap Text Position
toPositions [(Text, (MatchOffset, MatchOffset))]
matches = ([(Text, (MatchOffset, MatchOffset))], HashMap Text Position)
-> HashMap Text Position
forall a b. (a, b) -> b
snd (([(Text, (MatchOffset, MatchOffset))], HashMap Text Position)
 -> HashMap Text Position)
-> (Text
    -> ([(Text, (MatchOffset, MatchOffset))], HashMap Text Position))
-> Text
-> HashMap Text Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([(Text, (MatchOffset, MatchOffset))], HashMap Text Position),
 (MatchOffset, MatchOffset, MatchOffset))
-> ([(Text, (MatchOffset, MatchOffset))], HashMap Text Position)
forall a b. (a, b) -> a
fst ((([(Text, (MatchOffset, MatchOffset))], HashMap Text Position),
  (MatchOffset, MatchOffset, MatchOffset))
 -> ([(Text, (MatchOffset, MatchOffset))], HashMap Text Position))
-> (Text
    -> (([(Text, (MatchOffset, MatchOffset))], HashMap Text Position),
        (MatchOffset, MatchOffset, MatchOffset)))
-> Text
-> ([(Text, (MatchOffset, MatchOffset))], HashMap Text Position)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((([(Text, (MatchOffset, MatchOffset))], HashMap Text Position),
  (MatchOffset, MatchOffset, MatchOffset))
 -> Char
 -> (([(Text, (MatchOffset, MatchOffset))], HashMap Text Position),
     (MatchOffset, MatchOffset, MatchOffset)))
-> (([(Text, (MatchOffset, MatchOffset))], HashMap Text Position),
    (MatchOffset, MatchOffset, MatchOffset))
-> Text
-> (([(Text, (MatchOffset, MatchOffset))], HashMap Text Position),
    (MatchOffset, MatchOffset, MatchOffset))
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' (\case
            (([], HashMap Text Position
m), (MatchOffset, MatchOffset, MatchOffset)
_) -> (([(Text, (MatchOffset, MatchOffset))], HashMap Text Position),
 (MatchOffset, MatchOffset, MatchOffset))
-> Char
-> (([(Text, (MatchOffset, MatchOffset))], HashMap Text Position),
    (MatchOffset, MatchOffset, MatchOffset))
forall a b. a -> b -> a
const (([], HashMap Text Position
m), (MatchOffset
0, MatchOffset
0, MatchOffset
0))
            ((x :: (Text, (MatchOffset, MatchOffset))
x@(Text
name, (MatchOffset
char, MatchOffset
_)):[(Text, (MatchOffset, MatchOffset))]
xs, HashMap Text Position
m), (MatchOffset
n, MatchOffset
nc, MatchOffset
c)) -> \Char
char' ->
                let !c' :: MatchOffset
c' = MatchOffset
c MatchOffset -> MatchOffset -> MatchOffset
forall a. Num a => a -> a -> a
+ MatchOffset
1
                    (!MatchOffset
n', !MatchOffset
nc') = if Char
char' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' then (MatchOffset
n MatchOffset -> MatchOffset -> MatchOffset
forall a. Num a => a -> a -> a
+ MatchOffset
1, MatchOffset
c') else (MatchOffset
n, MatchOffset
nc)
                    p :: ([(Text, (MatchOffset, MatchOffset))], HashMap Text Position)
p@(![(Text, (MatchOffset, MatchOffset))]
_, !HashMap Text Position
_) = if MatchOffset
char MatchOffset -> MatchOffset -> Bool
forall a. Eq a => a -> a -> Bool
== MatchOffset
c then
                            ([(Text, (MatchOffset, MatchOffset))]
xs, Text -> Position -> HashMap Text Position -> HashMap Text Position
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
name (UInt -> UInt -> Position
Position (MatchOffset -> UInt
uint MatchOffset
n') (MatchOffset -> UInt
uint (MatchOffset
char MatchOffset -> MatchOffset -> MatchOffset
forall a. Num a => a -> a -> a
- MatchOffset
nc'))) HashMap Text Position
m)
                        else ((Text, (MatchOffset, MatchOffset))
x(Text, (MatchOffset, MatchOffset))
-> [(Text, (MatchOffset, MatchOffset))]
-> [(Text, (MatchOffset, MatchOffset))]
forall a. a -> [a] -> [a]
:[(Text, (MatchOffset, MatchOffset))]
xs, HashMap Text Position
m)
                in (([(Text, (MatchOffset, MatchOffset))], HashMap Text Position)
p, (MatchOffset
n', MatchOffset
nc', MatchOffset
c'))
            ) (([(Text, (MatchOffset, MatchOffset))]
matches, HashMap Text Position
forall k v. HashMap k v
HM.empty), (MatchOffset
0, MatchOffset
0, MatchOffset
0))

noteRefRegex, noteRegex :: Regex
(Regex
noteRefRegex, Regex
noteRegex) =
    ( String -> Regex
mkReg (String
"note \\[(.+)\\]" :: String)
    , String -> Regex
mkReg (String
"note \\[([[:print:]]+)\\][[:blank:]]*\r?\n[[:blank:]]*(--)?[[:blank:]]*~~~" :: String)
    )
    where
        mkReg :: String -> Regex
mkReg = CompOption -> ExecOption -> String -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts (CompOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
defaultCompOpt { caseSensitive = False }) ExecOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
defaultExecOpt