{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedLists       #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
module Language.LSP.Protocol.Types.SemanticTokens where

import           Data.Text                                                (Text)

import           Control.Monad.Except

import           Language.LSP.Protocol.Types.Common
import           Language.LSP.Protocol.Internal.Types.SemanticTokenModifiers
import           Language.LSP.Protocol.Internal.Types.SemanticTokens
import           Language.LSP.Protocol.Internal.Types.SemanticTokensDelta
import           Language.LSP.Protocol.Internal.Types.SemanticTokensEdit
import           Language.LSP.Protocol.Internal.Types.SemanticTokensLegend
import           Language.LSP.Protocol.Internal.Types.SemanticTokenTypes
import           Language.LSP.Protocol.Types.LspEnum

import qualified Data.Algorithm.Diff                                      as Diff
import qualified Data.Bits                                                as Bits
import qualified Data.DList                                               as DList
import           Data.Foldable                                            hiding
                                                                          (length)
import qualified Data.Map                                                 as Map
import           Data.Maybe                                               (fromMaybe,
                                                                           maybeToList)
import           Data.String

defaultSemanticTokensLegend :: SemanticTokensLegend
defaultSemanticTokensLegend :: SemanticTokensLegend
defaultSemanticTokensLegend = [Text] -> [Text] -> SemanticTokensLegend
SemanticTokensLegend
  (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. LspEnum a => a -> EnumBaseType a
toEnumBaseType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall a. LspEnum a => Set a
knownValues @SemanticTokenTypes)
  (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. LspEnum a => a -> EnumBaseType a
toEnumBaseType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall a. LspEnum a => Set a
knownValues @SemanticTokenModifiers)

----------------------------------------------------------
-- Tools for working with semantic tokens.
----------------------------------------------------------

-- | A single 'semantic token' as described in the LSP specification, using absolute positions.
-- This is the kind of token that is usually easiest for editors to produce.
data SemanticTokenAbsolute = SemanticTokenAbsolute {
  SemanticTokenAbsolute -> UInt
_line           :: UInt,
  SemanticTokenAbsolute -> UInt
_startChar      :: UInt,
  SemanticTokenAbsolute -> UInt
_length         :: UInt,
  SemanticTokenAbsolute -> SemanticTokenTypes
_tokenType      :: SemanticTokenTypes,
  SemanticTokenAbsolute -> [SemanticTokenModifiers]
_tokenModifiers :: [SemanticTokenModifiers]
} deriving stock (Int -> SemanticTokenAbsolute -> ShowS
[SemanticTokenAbsolute] -> ShowS
SemanticTokenAbsolute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SemanticTokenAbsolute] -> ShowS
$cshowList :: [SemanticTokenAbsolute] -> ShowS
show :: SemanticTokenAbsolute -> String
$cshow :: SemanticTokenAbsolute -> String
showsPrec :: Int -> SemanticTokenAbsolute -> ShowS
$cshowsPrec :: Int -> SemanticTokenAbsolute -> ShowS
Show, SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
$c/= :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
== :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
$c== :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
Eq, Eq SemanticTokenAbsolute
SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
SemanticTokenAbsolute -> SemanticTokenAbsolute -> Ordering
SemanticTokenAbsolute
-> SemanticTokenAbsolute -> SemanticTokenAbsolute
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
min :: SemanticTokenAbsolute
-> SemanticTokenAbsolute -> SemanticTokenAbsolute
$cmin :: SemanticTokenAbsolute
-> SemanticTokenAbsolute -> SemanticTokenAbsolute
max :: SemanticTokenAbsolute
-> SemanticTokenAbsolute -> SemanticTokenAbsolute
$cmax :: SemanticTokenAbsolute
-> SemanticTokenAbsolute -> SemanticTokenAbsolute
>= :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
$c>= :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
> :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
$c> :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
<= :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
$c<= :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
< :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
$c< :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Bool
compare :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Ordering
$ccompare :: SemanticTokenAbsolute -> SemanticTokenAbsolute -> Ordering
Ord)
-- Note: we want the Ord instance to sort the tokens textually: this is achieved due to the
-- order of the constructors

-- | A single 'semantic token' as described in the LSP specification, using relative positions.
data SemanticTokenRelative = SemanticTokenRelative {
  SemanticTokenRelative -> UInt
_deltaLine      :: UInt,
  SemanticTokenRelative -> UInt
_deltaStartChar :: UInt,
  SemanticTokenRelative -> UInt
_length         :: UInt,
  SemanticTokenRelative -> SemanticTokenTypes
_tokenType      :: SemanticTokenTypes,
  SemanticTokenRelative -> [SemanticTokenModifiers]
_tokenModifiers :: [SemanticTokenModifiers]
} deriving stock (Int -> SemanticTokenRelative -> ShowS
[SemanticTokenRelative] -> ShowS
SemanticTokenRelative -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SemanticTokenRelative] -> ShowS
$cshowList :: [SemanticTokenRelative] -> ShowS
show :: SemanticTokenRelative -> String
$cshow :: SemanticTokenRelative -> String
showsPrec :: Int -> SemanticTokenRelative -> ShowS
$cshowsPrec :: Int -> SemanticTokenRelative -> ShowS
Show, SemanticTokenRelative -> SemanticTokenRelative -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SemanticTokenRelative -> SemanticTokenRelative -> Bool
$c/= :: SemanticTokenRelative -> SemanticTokenRelative -> Bool
== :: SemanticTokenRelative -> SemanticTokenRelative -> Bool
$c== :: SemanticTokenRelative -> SemanticTokenRelative -> Bool
Eq, Eq SemanticTokenRelative
SemanticTokenRelative -> SemanticTokenRelative -> Bool
SemanticTokenRelative -> SemanticTokenRelative -> Ordering
SemanticTokenRelative
-> SemanticTokenRelative -> SemanticTokenRelative
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
min :: SemanticTokenRelative
-> SemanticTokenRelative -> SemanticTokenRelative
$cmin :: SemanticTokenRelative
-> SemanticTokenRelative -> SemanticTokenRelative
max :: SemanticTokenRelative
-> SemanticTokenRelative -> SemanticTokenRelative
$cmax :: SemanticTokenRelative
-> SemanticTokenRelative -> SemanticTokenRelative
>= :: SemanticTokenRelative -> SemanticTokenRelative -> Bool
$c>= :: SemanticTokenRelative -> SemanticTokenRelative -> Bool
> :: SemanticTokenRelative -> SemanticTokenRelative -> Bool
$c> :: SemanticTokenRelative -> SemanticTokenRelative -> Bool
<= :: SemanticTokenRelative -> SemanticTokenRelative -> Bool
$c<= :: SemanticTokenRelative -> SemanticTokenRelative -> Bool
< :: SemanticTokenRelative -> SemanticTokenRelative -> Bool
$c< :: SemanticTokenRelative -> SemanticTokenRelative -> Bool
compare :: SemanticTokenRelative -> SemanticTokenRelative -> Ordering
$ccompare :: SemanticTokenRelative -> SemanticTokenRelative -> Ordering
Ord)
-- Note: we want the Ord instance to sort the tokens textually: this is achieved due to the
-- order of the constructors

-- | Turn a list of absolutely-positioned tokens into a list of relatively-positioned tokens. The tokens are assumed to be in the
-- order that they appear in the document!
relativizeTokens :: [SemanticTokenAbsolute] -> [SemanticTokenRelative]
relativizeTokens :: [SemanticTokenAbsolute] -> [SemanticTokenRelative]
relativizeTokens [SemanticTokenAbsolute]
xs = forall a. DList a -> [a]
DList.toList forall a b. (a -> b) -> a -> b
$ UInt
-> UInt
-> [SemanticTokenAbsolute]
-> DList SemanticTokenRelative
-> DList SemanticTokenRelative
go UInt
0 UInt
0 [SemanticTokenAbsolute]
xs forall a. Monoid a => a
mempty
  where
    -- Pass an accumulator to make this tail-recursive
    go :: UInt -> UInt -> [SemanticTokenAbsolute] -> DList.DList SemanticTokenRelative -> DList.DList SemanticTokenRelative
    go :: UInt
-> UInt
-> [SemanticTokenAbsolute]
-> DList SemanticTokenRelative
-> DList SemanticTokenRelative
go UInt
_ UInt
_ [] DList SemanticTokenRelative
acc = DList SemanticTokenRelative
acc
    go UInt
lastLine UInt
lastChar (SemanticTokenAbsolute UInt
l UInt
c UInt
len SemanticTokenTypes
ty [SemanticTokenModifiers]
mods:[SemanticTokenAbsolute]
ts) DList SemanticTokenRelative
acc =
      let
        lastCharInLine :: UInt
lastCharInLine = if UInt
l forall a. Eq a => a -> a -> Bool
== UInt
lastLine then UInt
lastChar else UInt
0
        dl :: UInt
dl = UInt
l forall a. Num a => a -> a -> a
- UInt
lastLine
        dc :: UInt
dc = UInt
c forall a. Num a => a -> a -> a
- UInt
lastCharInLine
      in UInt
-> UInt
-> [SemanticTokenAbsolute]
-> DList SemanticTokenRelative
-> DList SemanticTokenRelative
go UInt
l UInt
c [SemanticTokenAbsolute]
ts (forall a. DList a -> a -> DList a
DList.snoc DList SemanticTokenRelative
acc (UInt
-> UInt
-> UInt
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> SemanticTokenRelative
SemanticTokenRelative UInt
dl UInt
dc UInt
len SemanticTokenTypes
ty [SemanticTokenModifiers]
mods))

-- | Turn a list of relatively-positioned tokens into a list of absolutely-positioned tokens. The tokens are assumed to be in the
-- order that they appear in the document!
absolutizeTokens :: [SemanticTokenRelative] -> [SemanticTokenAbsolute]
absolutizeTokens :: [SemanticTokenRelative] -> [SemanticTokenAbsolute]
absolutizeTokens [SemanticTokenRelative]
xs = forall a. DList a -> [a]
DList.toList forall a b. (a -> b) -> a -> b
$ UInt
-> UInt
-> [SemanticTokenRelative]
-> DList SemanticTokenAbsolute
-> DList SemanticTokenAbsolute
go UInt
0 UInt
0 [SemanticTokenRelative]
xs forall a. Monoid a => a
mempty
  where
    -- Pass an accumulator to make this tail-recursive
    go :: UInt -> UInt -> [SemanticTokenRelative] -> DList.DList SemanticTokenAbsolute -> DList.DList SemanticTokenAbsolute
    go :: UInt
-> UInt
-> [SemanticTokenRelative]
-> DList SemanticTokenAbsolute
-> DList SemanticTokenAbsolute
go UInt
_ UInt
_ [] DList SemanticTokenAbsolute
acc = DList SemanticTokenAbsolute
acc
    go UInt
lastLine UInt
lastChar (SemanticTokenRelative UInt
dl UInt
dc UInt
len SemanticTokenTypes
ty [SemanticTokenModifiers]
mods:[SemanticTokenRelative]
ts) DList SemanticTokenAbsolute
acc =
      let
        lastCharInLine :: UInt
lastCharInLine = if UInt
dl forall a. Eq a => a -> a -> Bool
== UInt
0 then UInt
lastChar else UInt
0
        l :: UInt
l = UInt
lastLine forall a. Num a => a -> a -> a
+ UInt
dl
        c :: UInt
c = UInt
lastCharInLine forall a. Num a => a -> a -> a
+ UInt
dc
      in UInt
-> UInt
-> [SemanticTokenRelative]
-> DList SemanticTokenAbsolute
-> DList SemanticTokenAbsolute
go UInt
l UInt
c [SemanticTokenRelative]
ts (forall a. DList a -> a -> DList a
DList.snoc DList SemanticTokenAbsolute
acc (UInt
-> UInt
-> UInt
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> SemanticTokenAbsolute
SemanticTokenAbsolute UInt
l UInt
c UInt
len SemanticTokenTypes
ty [SemanticTokenModifiers]
mods))

-- | Encode a series of relatively-positioned semantic tokens into an integer array following the given legend.
encodeTokens :: SemanticTokensLegend -> [SemanticTokenRelative] -> Either Text [UInt]
encodeTokens :: SemanticTokensLegend
-> [SemanticTokenRelative] -> Either Text [UInt]
encodeTokens SemanticTokensLegend{$sel:_tokenTypes:SemanticTokensLegend :: SemanticTokensLegend -> [Text]
_tokenTypes=[Text]
tts,$sel:_tokenModifiers:SemanticTokensLegend :: SemanticTokensLegend -> [Text]
_tokenModifiers=[Text]
tms} [SemanticTokenRelative]
sts =
  forall a. DList a -> [a]
DList.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [DList a] -> DList a
DList.concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SemanticTokenRelative -> Either Text (DList UInt)
encodeToken [SemanticTokenRelative]
sts
  where
    -- Note that there's no "fast" version of these (e.g. backed by an IntMap or similar)
    -- in general, due to the possibility  of unknown token types which are only identified by strings.
    tyMap :: Map.Map SemanticTokenTypes UInt
    tyMap :: Map SemanticTokenTypes UInt
tyMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. LspOpenEnum a => EnumBaseType a -> a
fromOpenEnumBaseType [Text]
tts) [UInt
0..]
    modMap :: Map.Map SemanticTokenModifiers Int
    modMap :: Map SemanticTokenModifiers Int
modMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. LspOpenEnum a => EnumBaseType a -> a
fromOpenEnumBaseType [Text]
tms) [Int
0..]

    lookupTy :: SemanticTokenTypes -> Either Text UInt
    lookupTy :: SemanticTokenTypes -> Either Text UInt
lookupTy SemanticTokenTypes
ty = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SemanticTokenTypes
ty Map SemanticTokenTypes UInt
tyMap of
        Just UInt
tycode -> forall (f :: * -> *) a. Applicative f => a -> f a
pure UInt
tycode
        Maybe UInt
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text
"Semantic token type " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show SemanticTokenTypes
ty) forall a. Semigroup a => a -> a -> a
<> Text
" did not appear in the legend"
    lookupMod :: SemanticTokenModifiers -> Either Text Int
    lookupMod :: SemanticTokenModifiers -> Either Text Int
lookupMod SemanticTokenModifiers
modifier = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SemanticTokenModifiers
modifier Map SemanticTokenModifiers Int
modMap of
        Just Int
modcode -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
modcode
        Maybe Int
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text
"Semantic token modifier " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show SemanticTokenModifiers
modifier) forall a. Semigroup a => a -> a -> a
<> Text
" did not appear in the legend"

    -- Use a DList here for better efficiency when concatenating all these together
    encodeToken :: SemanticTokenRelative -> Either Text (DList.DList UInt)
    encodeToken :: SemanticTokenRelative -> Either Text (DList UInt)
encodeToken (SemanticTokenRelative UInt
dl UInt
dc UInt
len SemanticTokenTypes
ty [SemanticTokenModifiers]
mods) = do
      UInt
tycode <- SemanticTokenTypes -> Either Text UInt
lookupTy SemanticTokenTypes
ty
      [Int]
modcodes <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SemanticTokenModifiers -> Either Text Int
lookupMod [SemanticTokenModifiers]
mods
      let Int
combinedModcode :: Int = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Bits a => a -> Int -> a
Bits.setBit forall a. Bits a => a
Bits.zeroBits [Int]
modcodes

      forall (f :: * -> *) a. Applicative f => a -> f a
pure [UInt
dl, UInt
dc, UInt
len, UInt
tycode, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
combinedModcode ]

-- This is basically 'SemanticTokensEdit', but slightly easier to work with.
-- | An edit to a buffer of items.
data Edit a = Edit { forall a. Edit a -> UInt
editStart :: UInt, forall a. Edit a -> UInt
editDeleteCount :: UInt, forall a. Edit a -> [a]
editInsertions :: [a] }
  deriving stock (ReadPrec [Edit a]
ReadPrec (Edit a)
ReadS [Edit a]
forall a. Read a => ReadPrec [Edit a]
forall a. Read a => ReadPrec (Edit a)
forall a. Read a => Int -> ReadS (Edit a)
forall a. Read a => ReadS [Edit a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Edit a]
$creadListPrec :: forall a. Read a => ReadPrec [Edit a]
readPrec :: ReadPrec (Edit a)
$creadPrec :: forall a. Read a => ReadPrec (Edit a)
readList :: ReadS [Edit a]
$creadList :: forall a. Read a => ReadS [Edit a]
readsPrec :: Int -> ReadS (Edit a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Edit a)
Read, Int -> Edit a -> ShowS
forall a. Show a => Int -> Edit a -> ShowS
forall a. Show a => [Edit a] -> ShowS
forall a. Show a => Edit a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Edit a] -> ShowS
$cshowList :: forall a. Show a => [Edit a] -> ShowS
show :: Edit a -> String
$cshow :: forall a. Show a => Edit a -> String
showsPrec :: Int -> Edit a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Edit a -> ShowS
Show, Edit a -> Edit a -> Bool
forall a. Eq a => Edit a -> Edit a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Edit a -> Edit a -> Bool
$c/= :: forall a. Eq a => Edit a -> Edit a -> Bool
== :: Edit a -> Edit a -> Bool
$c== :: forall a. Eq a => Edit a -> Edit a -> Bool
Eq, Edit a -> Edit a -> Bool
Edit a -> Edit a -> Ordering
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
forall {a}. Ord a => Eq (Edit a)
forall a. Ord a => Edit a -> Edit a -> Bool
forall a. Ord a => Edit a -> Edit a -> Ordering
forall a. Ord a => Edit a -> Edit a -> Edit a
min :: Edit a -> Edit a -> Edit a
$cmin :: forall a. Ord a => Edit a -> Edit a -> Edit a
max :: Edit a -> Edit a -> Edit a
$cmax :: forall a. Ord a => Edit a -> Edit a -> Edit a
>= :: Edit a -> Edit a -> Bool
$c>= :: forall a. Ord a => Edit a -> Edit a -> Bool
> :: Edit a -> Edit a -> Bool
$c> :: forall a. Ord a => Edit a -> Edit a -> Bool
<= :: Edit a -> Edit a -> Bool
$c<= :: forall a. Ord a => Edit a -> Edit a -> Bool
< :: Edit a -> Edit a -> Bool
$c< :: forall a. Ord a => Edit a -> Edit a -> Bool
compare :: Edit a -> Edit a -> Ordering
$ccompare :: forall a. Ord a => Edit a -> Edit a -> Ordering
Ord)

-- | Compute a list of edits that will turn the first list into the second list.
computeEdits :: Eq a => [a] -> [a] -> [Edit a]
computeEdits :: forall a. Eq a => [a] -> [a] -> [Edit a]
computeEdits [a]
l [a]
r = forall a. DList a -> [a]
DList.toList forall a b. (a -> b) -> a -> b
$ forall a.
UInt
-> Maybe (Edit a) -> [Diff [a]] -> DList (Edit a) -> DList (Edit a)
go UInt
0 forall a. Maybe a
Nothing (forall a. Eq a => [a] -> [a] -> [Diff [a]]
Diff.getGroupedDiff [a]
l [a]
r) forall a. Monoid a => a
mempty
  where
    {-
    Strategy: traverse the list of diffs, keeping the current index and (maybe) an in-progress 'Edit'.
    Whenever we see a 'Diff' that's only one side or the other, we can bundle that in to our in-progress
    'Edit'. We only have to stop if we see a 'Diff' that's on both sides (i.e. unchanged), then we
    dump the 'Edit' into the accumulator.
    We need the index, because 'Edit's need to say where they start.
    -}
    go :: UInt -> Maybe (Edit a) -> [Diff.Diff [a]] -> DList.DList (Edit a) -> DList.DList (Edit a)
    -- No more diffs: append the current edit if there is one and return
    go :: forall a.
UInt
-> Maybe (Edit a) -> [Diff [a]] -> DList (Edit a) -> DList (Edit a)
go UInt
_ Maybe (Edit a)
e [] DList (Edit a)
acc = DList (Edit a)
acc forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> DList a
DList.fromList (forall a. Maybe a -> [a]
maybeToList Maybe (Edit a)
e)

    -- Items only on the left (i.e. deletions): increment the current index, and record the count of deletions,
    -- starting a new edit if necessary.
    go UInt
ix Maybe (Edit a)
e (Diff.First [a]
ds : [Diff [a]]
rest) DList (Edit a)
acc =
      let
        deleteCount :: UInt
deleteCount = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [a]
ds
        edit :: Edit a
edit = forall a. a -> Maybe a -> a
fromMaybe (forall a. UInt -> UInt -> [a] -> Edit a
Edit UInt
ix UInt
0 []) Maybe (Edit a)
e
      in forall a.
UInt
-> Maybe (Edit a) -> [Diff [a]] -> DList (Edit a) -> DList (Edit a)
go (UInt
ix forall a. Num a => a -> a -> a
+ UInt
deleteCount) (forall a. a -> Maybe a
Just (Edit a
edit{$sel:editDeleteCount:Edit :: UInt
editDeleteCount=forall a. Edit a -> UInt
editDeleteCount Edit a
edit forall a. Num a => a -> a -> a
+ UInt
deleteCount})) [Diff [a]]
rest DList (Edit a)
acc
    -- Items only on the right (i.e. insertions): don't increment the current index, and record the insertions,
    -- starting a new edit if necessary.
    go UInt
ix Maybe (Edit a)
e (Diff.Second [a]
as : [Diff [a]]
rest) DList (Edit a)
acc =
      let edit :: Edit a
edit = forall a. a -> Maybe a -> a
fromMaybe (forall a. UInt -> UInt -> [a] -> Edit a
Edit UInt
ix UInt
0 []) Maybe (Edit a)
e
      in forall a.
UInt
-> Maybe (Edit a) -> [Diff [a]] -> DList (Edit a) -> DList (Edit a)
go UInt
ix (forall a. a -> Maybe a
Just (Edit a
edit{$sel:editInsertions:Edit :: [a]
editInsertions=forall a. Edit a -> [a]
editInsertions Edit a
edit forall a. Semigroup a => a -> a -> a
<> [a]
as})) [Diff [a]]
rest DList (Edit a)
acc

    -- Items on both sides: increment the current index appropriately (since the items appear on the left),
    -- and append the current edit (if there is one) to our list of edits (since we can't continue it with a break).
    go UInt
ix Maybe (Edit a)
e (Diff.Both [a]
bs [a]
_bs : [Diff [a]]
rest) DList (Edit a)
acc =
      let bothCount :: UInt
bothCount = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [a]
bs
      in forall a.
UInt
-> Maybe (Edit a) -> [Diff [a]] -> DList (Edit a) -> DList (Edit a)
go (UInt
ix forall a. Num a => a -> a -> a
+ UInt
bothCount) forall a. Maybe a
Nothing [Diff [a]]
rest (DList (Edit a)
acc forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> DList a
DList.fromList (forall a. Maybe a -> [a]
maybeToList Maybe (Edit a)
e))

-- | Convenience method for making a 'SemanticTokens' from a list of 'SemanticTokenAbsolute's. An error may be returned if

-- The resulting 'SemanticTokens' lacks a result ID, which must be set separately if you are using that.
makeSemanticTokens :: SemanticTokensLegend -> [SemanticTokenAbsolute] -> Either Text SemanticTokens
makeSemanticTokens :: SemanticTokensLegend
-> [SemanticTokenAbsolute] -> Either Text SemanticTokens
makeSemanticTokens SemanticTokensLegend
legend [SemanticTokenAbsolute]
sts = do
  [UInt]
encoded <- SemanticTokensLegend
-> [SemanticTokenRelative] -> Either Text [UInt]
encodeTokens SemanticTokensLegend
legend forall a b. (a -> b) -> a -> b
$ [SemanticTokenAbsolute] -> [SemanticTokenRelative]
relativizeTokens [SemanticTokenAbsolute]
sts
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe Text -> [UInt] -> SemanticTokens
SemanticTokens forall a. Maybe a
Nothing [UInt]
encoded

-- | Convenience function for making a 'SemanticTokensDelta' from a previous and current 'SemanticTokens'.
-- The resulting 'SemanticTokensDelta' lacks a result ID, which must be set separately if you are using that.
makeSemanticTokensDelta :: SemanticTokens -> SemanticTokens -> SemanticTokensDelta
makeSemanticTokensDelta :: SemanticTokens -> SemanticTokens -> SemanticTokensDelta
makeSemanticTokensDelta SemanticTokens{$sel:_data_:SemanticTokens :: SemanticTokens -> [UInt]
_data_=[UInt]
prevTokens} SemanticTokens{$sel:_data_:SemanticTokens :: SemanticTokens -> [UInt]
_data_=[UInt]
curTokens} =
  let edits :: [Edit UInt]
edits = forall a. Eq a => [a] -> [a] -> [Edit a]
computeEdits [UInt]
prevTokens [UInt]
curTokens
      stEdits :: [SemanticTokensEdit]
stEdits = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Edit UInt
s UInt
ds [UInt]
as) -> UInt -> UInt -> Maybe [UInt] -> SemanticTokensEdit
SemanticTokensEdit UInt
s UInt
ds (forall a. a -> Maybe a
Just [UInt]
as)) [Edit UInt]
edits
  in Maybe Text -> [SemanticTokensEdit] -> SemanticTokensDelta
SemanticTokensDelta forall a. Maybe a
Nothing [SemanticTokensEdit]
stEdits