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

import           Control.Lens                     ((^.))
import           Control.Monad.Except             (ExceptT, MonadError,
                                                   throwError)
import           Control.Monad.IO.Class           (liftIO)
import qualified Data.Array                       as A
import           Data.Foldable                    (foldl')
import           Data.HashMap.Strict              (HashMap)
import qualified Data.HashMap.Strict              as HM
import qualified Data.HashSet                     as HS
import           Data.List                        (uncons)
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           Data.Traversable                 (for)
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, Method_TextDocumentReferences),
                                                   SMethod (SMethod_TextDocumentDefinition, SMethod_TextDocumentReferences))
import           Language.LSP.Protocol.Types
import           Text.Regex.TDFA                  (Regex, caseSensitive,
                                                   defaultCompOpt,
                                                   defaultExecOpt,
                                                   makeRegexOpts, matchAllText)

data Log
    = LogShake Shake.Log
    | LogNotesFound NormalizedFilePath [(Text, [Position])]
    | LogNoteReferencesFound 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)
-- The GetNotesInFile action scans the source file and extracts a map of note
-- definitions (note name -> position) and a map of note references
-- (note name -> [position]).
type instance RuleResult GetNotesInFile = (HM.HashMap Text Position, 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)
-- GetNotes collects all note definition across all files in the
-- project. It returns a map from note name to pair of (filepath, position).
type instance RuleResult GetNotes = HashMap Text (NormalizedFilePath, Position)

data GetNoteReferences = MkGetNoteReferences
    deriving (MatchOffset -> GetNoteReferences -> ShowS
[GetNoteReferences] -> ShowS
GetNoteReferences -> String
(MatchOffset -> GetNoteReferences -> ShowS)
-> (GetNoteReferences -> String)
-> ([GetNoteReferences] -> ShowS)
-> Show GetNoteReferences
forall a.
(MatchOffset -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: MatchOffset -> GetNoteReferences -> ShowS
showsPrec :: MatchOffset -> GetNoteReferences -> ShowS
$cshow :: GetNoteReferences -> String
show :: GetNoteReferences -> String
$cshowList :: [GetNoteReferences] -> ShowS
showList :: [GetNoteReferences] -> ShowS
Show, (forall x. GetNoteReferences -> Rep GetNoteReferences x)
-> (forall x. Rep GetNoteReferences x -> GetNoteReferences)
-> Generic GetNoteReferences
forall x. Rep GetNoteReferences x -> GetNoteReferences
forall x. GetNoteReferences -> Rep GetNoteReferences x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetNoteReferences -> Rep GetNoteReferences x
from :: forall x. GetNoteReferences -> Rep GetNoteReferences x
$cto :: forall x. Rep GetNoteReferences x -> GetNoteReferences
to :: forall x. Rep GetNoteReferences x -> GetNoteReferences
Generic, GetNoteReferences -> GetNoteReferences -> Bool
(GetNoteReferences -> GetNoteReferences -> Bool)
-> (GetNoteReferences -> GetNoteReferences -> Bool)
-> Eq GetNoteReferences
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetNoteReferences -> GetNoteReferences -> Bool
== :: GetNoteReferences -> GetNoteReferences -> Bool
$c/= :: GetNoteReferences -> GetNoteReferences -> Bool
/= :: GetNoteReferences -> GetNoteReferences -> Bool
Eq, Eq GetNoteReferences
Eq GetNoteReferences =>
(GetNoteReferences -> GetNoteReferences -> Ordering)
-> (GetNoteReferences -> GetNoteReferences -> Bool)
-> (GetNoteReferences -> GetNoteReferences -> Bool)
-> (GetNoteReferences -> GetNoteReferences -> Bool)
-> (GetNoteReferences -> GetNoteReferences -> Bool)
-> (GetNoteReferences -> GetNoteReferences -> GetNoteReferences)
-> (GetNoteReferences -> GetNoteReferences -> GetNoteReferences)
-> Ord GetNoteReferences
GetNoteReferences -> GetNoteReferences -> Bool
GetNoteReferences -> GetNoteReferences -> Ordering
GetNoteReferences -> GetNoteReferences -> GetNoteReferences
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 :: GetNoteReferences -> GetNoteReferences -> Ordering
compare :: GetNoteReferences -> GetNoteReferences -> Ordering
$c< :: GetNoteReferences -> GetNoteReferences -> Bool
< :: GetNoteReferences -> GetNoteReferences -> Bool
$c<= :: GetNoteReferences -> GetNoteReferences -> Bool
<= :: GetNoteReferences -> GetNoteReferences -> Bool
$c> :: GetNoteReferences -> GetNoteReferences -> Bool
> :: GetNoteReferences -> GetNoteReferences -> Bool
$c>= :: GetNoteReferences -> GetNoteReferences -> Bool
>= :: GetNoteReferences -> GetNoteReferences -> Bool
$cmax :: GetNoteReferences -> GetNoteReferences -> GetNoteReferences
max :: GetNoteReferences -> GetNoteReferences -> GetNoteReferences
$cmin :: GetNoteReferences -> GetNoteReferences -> GetNoteReferences
min :: GetNoteReferences -> GetNoteReferences -> GetNoteReferences
Ord)
    deriving anyclass (Eq GetNoteReferences
Eq GetNoteReferences =>
(MatchOffset -> GetNoteReferences -> MatchOffset)
-> (GetNoteReferences -> MatchOffset) -> Hashable GetNoteReferences
MatchOffset -> GetNoteReferences -> MatchOffset
GetNoteReferences -> MatchOffset
forall a.
Eq a =>
(MatchOffset -> a -> MatchOffset)
-> (a -> MatchOffset) -> Hashable a
$chashWithSalt :: MatchOffset -> GetNoteReferences -> MatchOffset
hashWithSalt :: MatchOffset -> GetNoteReferences -> MatchOffset
$chash :: GetNoteReferences -> MatchOffset
hash :: GetNoteReferences -> MatchOffset
Hashable, GetNoteReferences -> ()
(GetNoteReferences -> ()) -> NFData GetNoteReferences
forall a. (a -> ()) -> NFData a
$crnf :: GetNoteReferences -> ()
rnf :: GetNoteReferences -> ()
NFData)
-- GetNoteReferences collects all note references across all files in the
-- project. It returns a map from note name to list of (filepath, position).
type instance RuleResult GetNoteReferences = HashMap Text [(NormalizedFilePath, Position)]

instance Pretty Log where
    pretty :: forall ann. Log -> Doc ann
pretty = \case
            LogShake Log
l -> Log -> Doc ann
forall ann. Log -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Log
l
            LogNoteReferencesFound NormalizedFilePath
file [(Text, [Position])]
refs -> Doc ann
"Found note references in " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> NormalizedFilePath -> [(Text, [Position])] -> Doc ann
forall {a} {a} {ann}.
(Show a, Show a) =>
a -> [(Text, [a])] -> Doc ann
prettyNotes NormalizedFilePath
file [(Text, [Position])]
refs
            LogNotesFound NormalizedFilePath
file [(Text, [Position])]
notes -> Doc ann
"Found notes in " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> NormalizedFilePath -> [(Text, [Position])] -> Doc ann
forall {a} {a} {ann}.
(Show a, Show a) =>
a -> [(Text, [a])] -> Doc ann
prettyNotes NormalizedFilePath
file [(Text, [Position])]
notes
        where prettyNotes :: a -> [(Text, [a])] -> Doc ann
prettyNotes a
file [(Text, [a])]
hm = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (a -> String
forall a. Show a => a -> String
show a
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, [a]) -> Text) -> [(Text, [a])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Text
s, [a]
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
<> Text -> [Text] -> Text
intercalate Text
", " ((a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show) [a]
p)) [(Text, [a])]
hm)) 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
        <> mkPluginHandler SMethod_TextDocumentReferences listReferences
    }

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, 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, HashMap Text [Position])))
 -> Rules ())
-> (GetNotesInFile
    -> NormalizedFilePath
    -> Action (Maybe (HashMap Text Position, 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, 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 [Position])
 -> HashMap Text (NormalizedFilePath, Position))
-> Maybe (HashMap Text Position, 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,) (HashMap Text Position
 -> HashMap Text (NormalizedFilePath, Position))
-> ((HashMap Text Position, HashMap Text [Position])
    -> HashMap Text Position)
-> (HashMap Text Position, HashMap Text [Position])
-> HashMap Text (NormalizedFilePath, Position)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Text Position, HashMap Text [Position])
-> HashMap Text Position
forall a b. (a, b) -> a
fst) (Maybe (HashMap Text Position, HashMap Text [Position])
 -> Maybe (HashMap Text (NormalizedFilePath, Position)))
-> Action (Maybe (HashMap Text Position, 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, 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

    Recorder (WithPriority Log)
-> (GetNoteReferences
    -> 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) ((GetNoteReferences
  -> NormalizedFilePath
  -> Action (Maybe (HashMap Text [(NormalizedFilePath, Position)])))
 -> Rules ())
-> (GetNoteReferences
    -> NormalizedFilePath
    -> Action (Maybe (HashMap Text [(NormalizedFilePath, Position)])))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetNoteReferences
MkGetNoteReferences 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)]]
definedReferences <- [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]
-> (NormalizedFilePath
    -> Action (Maybe (HashMap Text [(NormalizedFilePath, Position)])))
-> Action [Maybe (HashMap Text [(NormalizedFilePath, Position)])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (HashSet NormalizedFilePath -> [NormalizedFilePath]
forall a. HashSet a -> [a]
HS.toList HashSet NormalizedFilePath
targets) (\NormalizedFilePath
nfp -> do
                Maybe (HashMap Text [Position])
references <- ((HashMap Text Position, HashMap Text [Position])
 -> HashMap Text [Position])
-> Maybe (HashMap Text Position, HashMap Text [Position])
-> Maybe (HashMap Text [Position])
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HashMap Text Position, HashMap Text [Position])
-> HashMap Text [Position]
forall a b. (a, b) -> b
snd (Maybe (HashMap Text Position, HashMap Text [Position])
 -> Maybe (HashMap Text [Position]))
-> Action (Maybe (HashMap Text Position, HashMap Text [Position]))
-> Action (Maybe (HashMap Text [Position]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetNotesInFile
-> NormalizedFilePath
-> Action (Maybe (HashMap Text Position, HashMap Text [Position]))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetNotesInFile
MkGetNotesInFile NormalizedFilePath
nfp
                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 [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 ((Position -> (NormalizedFilePath, Position))
-> [Position] -> [(NormalizedFilePath, Position)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NormalizedFilePath
nfp,))) Maybe (HashMap Text [Position])
references
            )
        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)]
 -> HashMap Text [(NormalizedFilePath, Position)])
-> HashMap Text [(NormalizedFilePath, Position)]
-> [HashMap Text [(NormalizedFilePath, Position)]]
-> HashMap Text [(NormalizedFilePath, Position)]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (([(NormalizedFilePath, Position)]
 -> [(NormalizedFilePath, Position)]
 -> [(NormalizedFilePath, Position)])
-> HashMap Text [(NormalizedFilePath, Position)]
-> HashMap Text [(NormalizedFilePath, Position)]
-> HashMap Text [(NormalizedFilePath, Position)]
forall k v.
Eq k =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HM.unionWith [(NormalizedFilePath, Position)]
-> [(NormalizedFilePath, Position)]
-> [(NormalizedFilePath, Position)]
forall a. Semigroup a => a -> a -> a
(<>)) HashMap Text [(NormalizedFilePath, Position)]
forall k v. HashMap k v
HM.empty [HashMap Text [(NormalizedFilePath, Position)]]
definedReferences

err :: MonadError PluginError m => Text -> Maybe a -> m a
err :: forall (m :: * -> *) a.
MonadError PluginError m =>
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

getNote :: NormalizedFilePath -> IdeState -> Position -> ExceptT PluginError (HandlerM c) (Maybe Text)
getNote :: forall c.
NormalizedFilePath
-> IdeState
-> Position
-> ExceptT PluginError (HandlerM c) (Maybe Text)
getNote NormalizedFilePath
nfp IdeState
state (Position UInt
l UInt
c) = do
    Rope
contents <-
        Text -> Maybe Rope -> ExceptT PluginError (HandlerM c) Rope
forall (m :: * -> *) a.
MonadError PluginError m =>
Text -> Maybe a -> m a
err Text
"Error getting file contents"
        (Maybe Rope -> ExceptT PluginError (HandlerM c) Rope)
-> ExceptT PluginError (HandlerM c) (Maybe Rope)
-> ExceptT PluginError (HandlerM c) Rope
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Maybe Rope) -> ExceptT PluginError (HandlerM c) (Maybe Rope)
forall a. IO a -> ExceptT PluginError (HandlerM c) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IdeState -> Action (Maybe Rope) -> IO (Maybe Rope)
forall a. String -> IdeState -> Action a -> IO a
runAction String
"notes.getfileContents" IdeState
state (NormalizedFilePath -> Action (Maybe Rope)
getFileContents NormalizedFilePath
nfp))
    Text
line <- Text -> Maybe Text -> ExceptT PluginError (HandlerM c) 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))
    Maybe Text -> ExceptT PluginError (HandlerM c) (Maybe Text)
forall a. a -> ExceptT PluginError (HandlerM c) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> ExceptT PluginError (HandlerM c) (Maybe Text))
-> Maybe Text -> ExceptT PluginError (HandlerM c) (Maybe Text)
forall a b. (a -> b) -> a -> b
$ [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
  where
    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

listReferences :: PluginMethodHandler IdeState Method_TextDocumentReferences
listReferences :: PluginMethodHandler IdeState 'Method_TextDocumentReferences
listReferences IdeState
state PluginId
_ MessageParams 'Method_TextDocumentReferences
param
    | Just NormalizedFilePath
nfp <- NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath NormalizedUri
uriOrig
    = do
        let pos :: Position
pos@(Position UInt
l UInt
_) = MessageParams 'Method_TextDocumentReferences
ReferenceParams
param ReferenceParams
-> Getting Position ReferenceParams Position -> Position
forall s a. s -> Getting a s a -> a
^. Getting Position ReferenceParams Position
forall s a. HasPosition s a => Lens' s a
Lens' ReferenceParams Position
L.position
        Maybe Text
noteOpt <- NormalizedFilePath
-> IdeState
-> Position
-> ExceptT PluginError (HandlerM Config) (Maybe Text)
forall c.
NormalizedFilePath
-> IdeState
-> Position
-> ExceptT PluginError (HandlerM c) (Maybe Text)
getNote NormalizedFilePath
nfp IdeState
state Position
pos
        case Maybe Text
noteOpt of
            Maybe Text
Nothing -> ([Location] |? Null)
-> ExceptT PluginError (HandlerM Config) ([Location] |? Null)
forall a. a -> ExceptT PluginError (HandlerM Config) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Null -> [Location] |? 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.definedNoteReferencess" 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
$ GetNoteReferences
-> NormalizedFilePath
-> ExceptT
     PluginError Action (HashMap Text [(NormalizedFilePath, Position)])
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> ExceptT PluginError Action v
useE GetNoteReferences
MkGetNoteReferences NormalizedFilePath
nfp
                [(NormalizedFilePath, Position)]
poss <- Text
-> Maybe [(NormalizedFilePath, Position)]
-> ExceptT
     PluginError (HandlerM Config) [(NormalizedFilePath, Position)]
forall (m :: * -> *) a.
MonadError PluginError m =>
Text -> Maybe a -> m a
err (Text
"Note reference (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
"] -}`) 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)
                ([Location] |? Null)
-> ExceptT PluginError (HandlerM Config) ([Location] |? Null)
forall a. a -> ExceptT PluginError (HandlerM Config) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Location] |? Null)
 -> ExceptT PluginError (HandlerM Config) ([Location] |? Null))
-> ([Location] |? Null)
-> ExceptT PluginError (HandlerM Config) ([Location] |? Null)
forall a b. (a -> b) -> a -> b
$ [Location] -> [Location] |? Null
forall a b. a -> a |? b
InL (((NormalizedFilePath, Position) -> Maybe Location)
-> [(NormalizedFilePath, Position)] -> [Location]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(NormalizedFilePath
noteFp, pos :: Position
pos@(Position UInt
l' UInt
_)) -> if UInt
l' UInt -> UInt -> Bool
forall a. Eq a => a -> a -> Bool
== UInt
l then Maybe Location
forall a. Maybe a
Nothing else Location -> Maybe Location
forall a. a -> Maybe a
Just (
                        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))) [(NormalizedFilePath, Position)]
poss)
    where
        uriOrig :: NormalizedUri
uriOrig = Uri -> NormalizedUri
toNormalizedUri (Uri -> NormalizedUri) -> Uri -> NormalizedUri
forall a b. (a -> b) -> a -> b
$ MessageParams 'Method_TextDocumentReferences
ReferenceParams
param ReferenceParams -> Getting Uri ReferenceParams Uri -> Uri
forall s a. s -> Getting a s a -> a
^. ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> ReferenceParams -> Const Uri ReferenceParams
forall s a. HasTextDocument s a => Lens' s a
Lens' ReferenceParams TextDocumentIdentifier
L.textDocument ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> ReferenceParams -> Const Uri ReferenceParams)
-> ((Uri -> Const Uri Uri)
    -> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> Getting Uri ReferenceParams 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)
listReferences IdeState
_ PluginId
_ MessageParams 'Method_TextDocumentReferences
_ = PluginError
-> ExceptT
     PluginError
     (HandlerM Config)
     (MessageResult 'Method_TextDocumentReferences)
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_TextDocumentReferences))
-> PluginError
-> ExceptT
     PluginError
     (HandlerM Config)
     (MessageResult 'Method_TextDocumentReferences)
forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInternalError Text
"conversion to normalized file path failed"

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
        Maybe Text
noteOpt <- NormalizedFilePath
-> IdeState
-> Position
-> ExceptT PluginError (HandlerM Config) (Maybe Text)
forall c.
NormalizedFilePath
-> IdeState
-> Position
-> ExceptT PluginError (HandlerM c) (Maybe Text)
getNote NormalizedFilePath
nfp IdeState
state (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)
        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)
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, HM.HashMap Text [Position]))
findNotesInFile :: NormalizedFilePath
-> Recorder (WithPriority Log)
-> Action (Maybe (HashMap Text Position, 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 Rope
contentOpt <- ((FileVersion, Maybe Rope) -> Maybe Rope
forall a b. (a, b) -> b
snd =<<) (Maybe (FileVersion, Maybe Rope) -> Maybe Rope)
-> Action (Maybe (FileVersion, Maybe Rope)) -> Action (Maybe Rope)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetFileContents
-> NormalizedFilePath -> Action (Maybe (FileVersion, Maybe Rope))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetFileContents
GetFileContents NormalizedFilePath
file
    Text
content <- case Maybe Rope
contentOpt of
        Just Rope
x  -> Text -> Action Text
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Action Text) -> Text -> Action Text
forall a b. (a -> b) -> a -> b
$ Rope -> Text
Rope.toText Rope
x
        Maybe Rope
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 noteMatches :: [(Text, (MatchOffset, MatchOffset))]
noteMatches = (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
        notes :: HashMap Text [Position]
notes = [(Text, (MatchOffset, MatchOffset))]
-> Text -> HashMap Text [Position]
toPositions [(Text, (MatchOffset, MatchOffset))]
noteMatches 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]
notes)
    let refMatches :: [(Text, (MatchOffset, MatchOffset))]
refMatches = (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
noteRefRegex Text
content
        refs :: HashMap Text [Position]
refs = [(Text, (MatchOffset, MatchOffset))]
-> Text -> HashMap Text [Position]
toPositions [(Text, (MatchOffset, MatchOffset))]
refMatches 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
LogNoteReferencesFound NormalizedFilePath
file (HashMap Text [Position] -> [(Text, [Position])]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Text [Position]
refs)
    Maybe (HashMap Text Position, HashMap Text [Position])
-> Action (Maybe (HashMap Text Position, HashMap Text [Position]))
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (HashMap Text Position, HashMap Text [Position])
 -> Action (Maybe (HashMap Text Position, HashMap Text [Position])))
-> Maybe (HashMap Text Position, HashMap Text [Position])
-> Action (Maybe (HashMap Text Position, HashMap Text [Position]))
forall a b. (a -> b) -> a -> b
$ (HashMap Text Position, HashMap Text [Position])
-> Maybe (HashMap Text Position, HashMap Text [Position])
forall a. a -> Maybe a
Just (([Position] -> Maybe Position)
-> HashMap Text [Position] -> HashMap Text Position
forall v1 v2 k. (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HM.mapMaybe (((Position, [Position]) -> Position)
-> Maybe (Position, [Position]) -> Maybe Position
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Position, [Position]) -> Position
forall a b. (a, b) -> a
fst (Maybe (Position, [Position]) -> Maybe Position)
-> ([Position] -> Maybe (Position, [Position]))
-> [Position]
-> Maybe Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Position] -> Maybe (Position, [Position])
forall a. [a] -> Maybe (a, [a])
uncons) HashMap Text [Position]
notes, HashMap Text [Position]
refs)
    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, ([Position] -> [Position] -> [Position])
-> Text
-> [Position]
-> HashMap Text [Position]
-> HashMap Text [Position]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HM.insertWith [Position] -> [Position] -> [Position]
forall a. Semigroup a => a -> a -> a
(<>) 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