{-# 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.Internal.Types.SemanticTokenModifiers
import Language.LSP.Protocol.Internal.Types.SemanticTokenTypes
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.Types.Common
import Language.LSP.Protocol.Types.LspEnum

import Data.Algorithm.Diff qualified as Diff
import Data.Bits qualified as Bits
import Data.DList qualified as DList
import Data.Foldable hiding (
  length,
 )
import Data.Map qualified 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