github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-01 17:59:10 +03:00
Code Issues Projects Releases Wiki Activity

Define a custom TaggableBy instance for Syntax.Context.

Browse Source
This commit is contained in:
Rob Rix 2019-09-18 12:50:41 -04:00
parent 05c1a724ab
commit 975d894339
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
1 changed files with 7 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/Tags/Taggable.hs
View File

@ -141,9 +141,10 @@ subtractLocation a b = subtractRange (locationByteRange a) (locationByteRange b)
-- Instances
type family TaggableInstance (t :: * -> *) :: Strategy where
TaggableInstance (Sum _) = 'Custom
TaggableInstance (TermF _ _) = 'Custom
TaggableInstance _ = 'Default
TaggableInstance (Sum _) = 'Custom
TaggableInstance (TermF _ _) = 'Custom
TaggableInstance Syntax.Context = 'Custom
TaggableInstance _ = 'Default
instance TaggableBy 'Default t
@ -167,6 +168,9 @@ instance (Taggable a) => Taggable (TermF a Location) where
snippet ann t = snippet ann (termFOut t)
symbolName t = symbolName (termFOut t)
instance TaggableBy 'Custom Syntax.Context where
snippet' ann (Syntax.Context _ (Term (In subj _))) = Just (subtractLocation ann subj)
instance Taggable Syntax.Context where
snippet ann (Syntax.Context _ (Term (In subj _))) = Just (subtractLocation ann subj)