{-# 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)
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)
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)
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
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))
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
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))
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
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"
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 ]
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)
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
go :: UInt -> Maybe (Edit a) -> [Diff.Diff [a]] -> DList.DList (Edit a) -> DList.DList (Edit a)
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)
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
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
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))
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
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