1
1
mirror of https://github.com/github/semantic.git synced 2024-11-26 09:07:39 +03:00

Lints and cleanups

This commit is contained in:
Timothy Clem 2020-07-01 17:02:06 -07:00
parent b52403ffd9
commit 38638dd008
2 changed files with 4 additions and 57 deletions

View File

@ -12,10 +12,7 @@ module Tags.Tagging.Precise
, LineIndices(..)
, yield
, runTagging
, baselineCalculateLineAndSpans
, calculateLineAndSpansPRVersion
, calculateLineAndSpans
, calculateLineAndSpans' -- For testing: TODO move to tests
, countUtf16CodeUnits
, surroundingLine
, surroundingLineRange
@ -27,10 +24,8 @@ import Control.Carrier.Writer.Strict
import Control.Carrier.State.Strict
import qualified Data.ByteString as B
import Data.Char (ord)
import qualified Data.List as List
import Data.Functor.Identity
import Data.Monoid (Endo (..))
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Proto.Semantic as P
@ -44,8 +39,6 @@ import Prelude hiding (span)
import Data.Map as Map
import Data.IntMap as IntMap
import Debug.Trace
type Tags = Endo [Tag]
@ -66,7 +59,6 @@ yield name syntaxType nodeType loc _ = do
xs <- get @LineIndices
let (line, span, lspSpan, map) = calculateLineAndSpans src xs loc
put map
-- let (line, span, lspSpan) = baselineCalculateLineAndSpans src loc
tell . Endo . (:) $
Tag name syntaxType nodeType (byteRange loc) span line lspSpan
@ -85,55 +77,6 @@ type LineCache = (Source, IntMap.IntMap UTF16CUCount)
newtype LineIndices = LineIndices { unLineIndices :: Map.Map Int LineCache } -- NB: IntMap Key is a utf8 byteoffset
deriving (Eq, Show, NFData)
baselineCalculateLineAndSpans :: Source -> Loc -> (Text, OneIndexedSpan, UTF16CodeUnitSpan)
baselineCalculateLineAndSpans src Loc { byteRange, span } = (line, toOneIndexed span, UTF16CodeUnitSpan (Span (Pos 0 0) (Pos 0 0))) --utf16Span)
where
line = Text.strip . Text.take 180 . Text.takeWhile (/= '\n') . Source.toText $ Source.slice src byteRange
toOneIndexed (Span (Pos l1 c1) (Pos l2 c2)) = OneIndexedSpan $ Span (Pos (l1 + 1) (c1 + 1)) (Pos (l2 + 1) (c2 + 1))
calculateLineAndSpansPRVersion ::
Source -> -- | ^ Source
Loc -> -- | ^ Location of identifier
(Text, OneIndexedSpan, UTF16CodeUnitSpan)
calculateLineAndSpansPRVersion
src
Loc
{ byteRange = srcRange,
span =
span@Span
{ start = start@Pos {column = startCol},
end = end@Pos {column = endCol}
}
} = (line, toOneIndexed span, utf16Span)
where
-- NB: Important to limit to 180 characters after converting to text so as not to take in the middle of a multi-byte character.
-- line = Text.strip . Text.take 180 . Source.toText $ srcLine
line = sliceCenter180 startCol . Source.toText $ srcLine
srcLine = surroundingLine src srcRange
toOneIndexed (Span (Pos l1 c1) (Pos l2 c2)) = OneIndexedSpan $ Span (Pos (l1 + 1) (c1 + 1)) (Pos (l2 + 1) (c2 + 1))
utf16Span = UTF16CodeUnitSpan $ Span start {column = utf16cpStartOffset} end {column = utf16cpEndOffset}
utf16cpStartOffset = countUtf16CodeUnits startSlice
utf16cpEndOffset = utf16cpStartOffset + countUtf16CodeUnits endSlice
-- NB: Slice out of the Source ByteString, NOT Text because Loc/Range is in units of bytes.
startSlice = Source.slice srcLine (Range 0 startCol)
endSlice = Source.slice srcLine (Range startCol endCol)
-- Slice out up to 180 characters around an index. Favors including the
-- identifier and all succeeding text before including any preceeding context
sliceCenter180 :: Int -> Text -> Text
sliceCenter180 start txt = lhs <> rhs
where
(h, t) = Text.splitAt start txt
rhs = Text.stripEnd . Text.take 180 $ t
quota = 180 - Text.length rhs
lhs = Text.stripStart . Text.take quota $ h
-- | For testing
calculateLineAndSpans' :: Source -> Loc -> (Text, OneIndexedSpan, UTF16CodeUnitSpan)
calculateLineAndSpans' src loc = let (a, b, c, _) = calculateLineAndSpans src (LineIndices mempty) loc in (a, b, c)
-- | Takes a Loc (where the span's column offset is measured in bytes) and
-- returns two Spans: A 1-indexed span LSP friendly span (where column offset is
-- measure in utf16 code units).

View File

@ -17,6 +17,10 @@ main = defaultMain $ testGroup "semantic-tags" [ testTree ]
src :: Text -> Source
src = Source.fromText
-- | For testing
calculateLineAndSpans' :: Source -> Loc -> (Text, OneIndexedSpan, UTF16CodeUnitSpan)
calculateLineAndSpans' src loc = let (a, b, c, _) = calculateLineAndSpans src (LineIndices mempty) loc in (a, b, c)
testTree :: Tasty.TestTree
testTree = Tasty.testGroup "Tags.Tagging.Precise"
[ Tasty.testGroup "countUtf16CodeUnits from utf8 encoded bytestring"