From 0312300a408bcda9154978f4f6b654614af1e64e Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Fri, 20 Sep 2019 16:59:04 -0400 Subject: [PATCH] Rename the spanStart/spanEnd fields to start/end. --- semantic-source/src/Source/Loc.hs | 4 ++-- semantic-source/src/Source/Source.hs | 2 +- semantic-source/src/Source/Span.hs | 12 ++++++------ src/Assigning/Assignment.hs | 6 +++--- src/Assigning/Assignment/Deterministic.hs | 5 +++-- src/Data/Abstract/BaseError.hs | 8 ++++---- src/Data/Error.hs | 10 +++++----- src/Data/JSON/Fields.hs | 1 + src/Data/Syntax.hs | 4 +++- src/Data/Syntax/Directive.hs | 2 +- src/Parsing/CMark.hs | 5 +++-- src/Semantic/Api/Bridge.hs | 4 ++-- src/Semantic/REPL.hs | 6 +++--- 13 files changed, 37 insertions(+), 32 deletions(-) diff --git a/semantic-source/src/Source/Loc.hs b/semantic-source/src/Source/Loc.hs index 7dcdde9ae..ca2b1c2bd 100644 --- a/semantic-source/src/Source/Loc.hs +++ b/semantic-source/src/Source/Loc.hs @@ -1,8 +1,8 @@ {-# LANGUAGE DeriveGeneric, DerivingVia #-} module Source.Loc ( Loc(..) -, Span(..) -, Range(..) +, Span(Span) +, Range(Range) ) where import Control.DeepSeq (NFData) diff --git a/semantic-source/src/Source/Source.hs b/semantic-source/src/Source/Source.hs index 3c19f3c24..182f5439c 100644 --- a/semantic-source/src/Source/Source.hs +++ b/semantic-source/src/Source/Source.hs @@ -43,7 +43,7 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T import GHC.Generics (Generic) import Source.Range -import Source.Span hiding (HasSpan (..)) +import Source.Span (Span(Span), Pos(..)) -- | The contents of a source file. This is represented as a UTF-8 diff --git a/semantic-source/src/Source/Span.hs b/semantic-source/src/Source/Span.hs index 5ff4bd202..0e43089ac 100644 --- a/semantic-source/src/Source/Span.hs +++ b/semantic-source/src/Source/Span.hs @@ -21,8 +21,8 @@ import GHC.Stack (SrcLoc(..)) -- | A Span of position information data Span = Span - { spanStart :: {-# UNPACK #-} !Pos - , spanEnd :: {-# UNPACK #-} !Pos + { start :: {-# UNPACK #-} !Pos + , end :: {-# UNPACK #-} !Pos } deriving (Eq, Ord, Generic, Show) @@ -34,8 +34,8 @@ instance Semigroup Span where instance A.ToJSON Span where toJSON s = A.object - [ "start" .= spanStart s - , "end" .= spanEnd s + [ "start" .= start s + , "end" .= end s ] instance A.FromJSON Span where @@ -97,10 +97,10 @@ instance HasSpan Span where span_ = id {-# INLINE span_ #-} - start_ = lens spanStart (\s t -> s { spanStart = t }) + start_ = lens start (\s t -> s { start = t }) {-# INLINE start_ #-} - end_ = lens spanEnd (\s t -> s { spanEnd = t }) + end_ = lens end (\s t -> s { end = t }) {-# INLINE end_ #-} diff --git a/src/Assigning/Assignment.hs b/src/Assigning/Assignment.hs index 86cbded9e..2690cb69f 100644 --- a/src/Assigning/Assignment.hs +++ b/src/Assigning/Assignment.hs @@ -105,8 +105,8 @@ import Data.Term import Data.Text (Text) import Data.Text.Encoding (decodeUtf8') import qualified Source.Loc as L -import Source.Range -import Source.Span hiding (HasSpan(..)) +import Source.Range as Range +import Source.Span as Span import Text.Parser.Combinators as Parsers hiding (choice) import TreeSitter.Language @@ -305,7 +305,7 @@ skipTokens state = state { stateNodes = dropWhile ((/= Regular) . symbolType . n -- | Advances the state past the current (head) node (if any), dropping it off stateNodes, and updating stateOffset & statePos to its end; or else returns the state unchanged. advanceState :: State ast grammar -> State ast grammar advanceState state@State{..} - | Term (In node _) : rest <- stateNodes = State (end (nodeByteRange node)) (spanEnd (nodeSpan node)) stateCallSites rest stateLocals + | Term (In node _) : rest <- stateNodes = State (Range.end (nodeByteRange node)) (Span.end (nodeSpan node)) stateCallSites rest stateLocals | otherwise = state -- | State kept while running 'Assignment's. diff --git a/src/Assigning/Assignment/Deterministic.hs b/src/Assigning/Assignment/Deterministic.hs index 8af9b92a0..de3fef899 100644 --- a/src/Assigning/Assignment/Deterministic.hs +++ b/src/Assigning/Assignment/Deterministic.hs @@ -19,7 +19,8 @@ import Data.Term (Term, termIn, termAnnotation, termOut) import Data.Text.Encoding (decodeUtf8') import Prologue import Source.Loc -import Source.Span hiding (HasSpan (..)) +import Source.Range as Range +import Source.Span as Span class (Alternative f, Ord symbol, Show symbol) => Assigning symbol f | f -> symbol where leafNode :: symbol -> f Text @@ -172,7 +173,7 @@ stateLocation state = Loc (stateRange state) (stateSpan state) advanceState :: State s -> State s advanceState state - | s:ss <- stateInput state = State (end (astRange s)) (spanEnd (astSpan s)) ss + | s:ss <- stateInput state = State (Range.end (astRange s)) (Span.end (astSpan s)) ss | otherwise = state diff --git a/src/Data/Abstract/BaseError.hs b/src/Data/Abstract/BaseError.hs index 5fece7d45..2a8b9cb08 100644 --- a/src/Data/Abstract/BaseError.hs +++ b/src/Data/Abstract/BaseError.hs @@ -18,10 +18,10 @@ instance (Show (exc resume)) => Show (BaseError exc resume) where showsPrec _ BaseError{..} = shows baseErrorException <> showString " " <> showString errorLocation where errorLocation | startErrorLine == endErrorLine = M.modulePath baseErrorModuleInfo <> " " <> startErrorLine <> ":" <> startErrorCol <> "-" <> endErrorCol | otherwise = M.modulePath baseErrorModuleInfo <> " " <> startErrorLine <> ":" <> startErrorCol <> "-" <> endErrorLine <> ":" <> endErrorCol - startErrorLine = show $ S.line (S.spanStart baseErrorSpan) - endErrorLine = show $ S.line (S.spanEnd baseErrorSpan) - startErrorCol = show $ S.column (S.spanStart baseErrorSpan) - endErrorCol = show $ S.column (S.spanEnd baseErrorSpan) + startErrorLine = show $ S.line (S.start baseErrorSpan) + endErrorLine = show $ S.line (S.end baseErrorSpan) + startErrorCol = show $ S.column (S.start baseErrorSpan) + endErrorCol = show $ S.column (S.end baseErrorSpan) instance (Eq1 exc) => Eq1 (BaseError exc) where liftEq f (BaseError info1 span1 exc1) (BaseError info2 span2 exc2) = info1 == info2 && span1 == span2 && liftEq f exc1 exc2 diff --git a/src/Data/Error.hs b/src/Data/Error.hs index 504c95086..688ac32c7 100644 --- a/src/Data/Error.hs +++ b/src/Data/Error.hs @@ -63,12 +63,12 @@ showExcerpt colourize Span{..} Blob{..} where context = fold contextLines contextLines = [ showLineNumber i <> ": " <> unpack (Source.bytes l) | (i, l) <- zip [1..] (Source.lines blobSource) - , inRange (line spanStart - 2, line spanStart) i + , inRange (line start - 2, line start) i ] showLineNumber n = let s = show n in replicate (lineNumberDigits - length s) ' ' <> s - lineNumberDigits = succ (floor (logBase 10 (fromIntegral (line spanStart) :: Double))) - caretPaddingWidth = succ (column spanStart) - caret | line spanStart == line spanEnd = replicate (max 1 (column spanEnd - column spanStart)) '^' + lineNumberDigits = succ (floor (logBase 10 (fromIntegral (line start) :: Double))) + caretPaddingWidth = succ (column start) + caret | line start == line end = replicate (max 1 (column end - column start)) '^' | otherwise = "^..." withSGRCode :: Flag Colourize -> [SGR] -> ShowS -> ShowS @@ -93,7 +93,7 @@ showSymbols colourize = go showSymbol = withSGRCode colourize [SetColor Foreground Vivid Red] . showString showSpan :: Maybe FilePath -> Span -> ShowS -showSpan path Span{..} = maybe (showParen True (showString "interactive")) showString path . showChar ':' . (if spanStart == spanEnd then showPos spanStart else showPos spanStart . showChar '-' . showPos spanEnd) +showSpan path Span{..} = maybe (showParen True (showString "interactive")) showString path . showChar ':' . (if start == end then showPos start else showPos start . showChar '-' . showPos end) where showPos Pos{..} = shows line . showChar ':' . shows column showCallStack :: Flag Colourize -> CallStack -> ShowS diff --git a/src/Data/JSON/Fields.hs b/src/Data/JSON/Fields.hs index ab42c6946..36d355c5e 100644 --- a/src/Data/JSON/Fields.hs +++ b/src/Data/JSON/Fields.hs @@ -15,6 +15,7 @@ import qualified Data.Text as Text import GHC.Generics import Prologue import Source.Loc +import Source.Range class ToJSONFields a where toJSONFields :: KeyValue kv => a -> [kv] diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs index 7c55d1eed..3155dc4fe 100644 --- a/src/Data/Syntax.hs +++ b/src/Data/Syntax.hs @@ -16,6 +16,8 @@ import Prelude import Prologue import Reprinting.Tokenize hiding (Element) import Source.Loc +import Source.Range as Range +import Source.Span as Span import qualified Assigning.Assignment as Assignment import qualified Data.Error as Error import Control.Abstract.ScopeGraph (reference, Reference(..), Declaration(..)) @@ -51,7 +53,7 @@ makeTerm1' syntax = case toList syntax of -- | Construct an empty term at the current position. emptyTerm :: (HasCallStack, Empty :< syntaxes, Apply Foldable syntaxes) => Assignment.Assignment ast grammar (Term (Sum syntaxes) Loc) emptyTerm = makeTerm . startLocation <$> Assignment.location <*> pure Empty - where startLocation Loc{..} = Loc (Range (start locByteRange) (start locByteRange)) (Span (spanStart locSpan) (spanStart locSpan)) + where startLocation Loc{..} = Loc (Range (Range.start locByteRange) (Range.start locByteRange)) (Span (Span.start locSpan) (Span.start locSpan)) -- | Catch assignment errors into an error term. handleError :: (HasCallStack, Error :< syntaxes, Enum grammar, Eq1 ast, Ix grammar, Show grammar, Apply Foldable syntaxes) => Assignment.Assignment ast grammar (Term (Sum syntaxes) Loc) -> Assignment.Assignment ast grammar (Term (Sum syntaxes) Loc) diff --git a/src/Data/Syntax/Directive.hs b/src/Data/Syntax/Directive.hs index faedc1eab..4186fcaae 100644 --- a/src/Data/Syntax/Directive.hs +++ b/src/Data/Syntax/Directive.hs @@ -31,7 +31,7 @@ data Line a = Line deriving (Eq1, Show1, Ord1) via Generically Line instance Evaluatable Line where - eval _ _ Line = currentSpan >>= integer . fromIntegral . line . spanStart + eval _ _ Line = currentSpan >>= integer . fromIntegral . line . start -- PT TODO: proper token for this instance Tokenize Line where diff --git a/src/Parsing/CMark.hs b/src/Parsing/CMark.hs index 075bb9966..e02754ec0 100644 --- a/src/Parsing/CMark.hs +++ b/src/Parsing/CMark.hs @@ -10,6 +10,7 @@ import Data.Array import qualified Data.AST as A import Data.Term import Source.Loc +import qualified Source.Range as Range import Source.Source (Source) import qualified Source.Source as Source import Source.Span hiding (HasSpan (..)) @@ -95,8 +96,8 @@ instance Symbol Grammar where spanToRangeInLineRanges :: Array Int Range -> Span -> Range spanToRangeInLineRanges lineRanges Span{..} = Range - (start (lineRanges ! line spanStart) + pred (column spanStart)) - (start (lineRanges ! line spanEnd) + pred (column spanEnd)) + (Range.start (lineRanges ! line start) + pred (column start)) + (Range.start (lineRanges ! line end) + pred (column end)) sourceLineRangesByLineNumber :: Source -> Array Int Range sourceLineRangesByLineNumber source = listArray (1, length lineRanges) lineRanges diff --git a/src/Semantic/Api/Bridge.hs b/src/Semantic/Api/Bridge.hs index 80a82eeb9..4ec705d9b 100644 --- a/src/Semantic/Api/Bridge.hs +++ b/src/Semantic/Api/Bridge.hs @@ -55,12 +55,12 @@ instance APIBridge API.Position Source.Pos where instance APIConvert API.Span Source.Span where converting = prism' toAPI fromAPI where - toAPI Source.Span{..} = API.Span (bridging #? spanStart) (bridging #? spanEnd) + toAPI Source.Span{..} = API.Span (bridging #? start) (bridging #? end) fromAPI API.Span{..} = Source.Span <$> (start >>= preview bridging) <*> (end >>= preview bridging) instance APIConvert Legacy.Span Source.Span where converting = prism' toAPI fromAPI where - toAPI Source.Span{..} = Legacy.Span (bridging #? spanStart) (bridging #? spanEnd) + toAPI Source.Span{..} = Legacy.Span (bridging #? start) (bridging #? end) fromAPI Legacy.Span {..} = Source.Span <$> (start >>= preview bridging) <*> (end >>= preview bridging) instance APIBridge T.Text Data.Language where diff --git a/src/Semantic/REPL.hs b/src/Semantic/REPL.hs index 12a6ca8f5..a458efba2 100644 --- a/src/Semantic/REPL.hs +++ b/src/Semantic/REPL.hs @@ -212,6 +212,6 @@ shouldBreak = do span <- ask pure (any @[] (matching span) breakpoints) where matching Span{..} (OnLine n) - | n >= line spanStart - , n <= line spanEnd = True - | otherwise = False + | n >= line start + , n <= line end = True + | otherwise = False