mirror of
https://github.com/github/semantic.git
synced 2024-12-25 07:55:12 +03:00
Remove tree-sitter dependency from semantic-core.
This commit is contained in:
parent
302add6c5e
commit
da5bb84b05
@ -51,7 +51,6 @@ library
|
||||
, semigroupoids ^>= 5.3
|
||||
, text ^>= 1.2.3.1
|
||||
, transformers ^>= 0.5.6
|
||||
, tree-sitter == 0.3.0.0
|
||||
, trifecta ^>= 2
|
||||
, unordered-containers ^>= 0.2.10
|
||||
hs-source-dirs: src
|
||||
|
@ -230,7 +230,7 @@ annAt :: (Carrier sig m, Member Ann sig) => Loc -> m a -> m a
|
||||
annAt loc = send . Ann loc
|
||||
|
||||
annWith :: (Carrier sig m, Member Ann sig) => CallStack -> m a -> m a
|
||||
annWith callStack = maybe id (fmap annAt) (stackLoc callStack)
|
||||
annWith callStack = maybe id annAt (stackLoc callStack)
|
||||
|
||||
|
||||
stripAnnotations :: (HFunctor sig, forall g . Functor g => Functor (sig g)) => Term (Ann :+: sig) a -> Term sig a
|
||||
|
@ -1,9 +1,7 @@
|
||||
{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, OverloadedStrings, RecordWildCards,
|
||||
TypeOperators, UndecidableInstances #-}
|
||||
{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, OverloadedStrings, RecordWildCards, TypeOperators, UndecidableInstances #-}
|
||||
module Data.Loc
|
||||
( Loc(..)
|
||||
, interactive
|
||||
, fromTSSpan
|
||||
, Span(..)
|
||||
, emptySpan
|
||||
, Pos(..)
|
||||
@ -13,16 +11,15 @@ module Data.Loc
|
||||
, runFailWithLoc
|
||||
) where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Effect.Carrier
|
||||
import Control.Effect.Error
|
||||
import Control.Effect.Fail
|
||||
import Control.Effect.Reader
|
||||
import Data.Text (Text, pack)
|
||||
import Data.Text.Prettyprint.Doc (Pretty (..))
|
||||
import GHC.Stack
|
||||
import Prelude hiding (fail)
|
||||
import qualified TreeSitter.Span as TreeSitter
|
||||
import Control.Applicative
|
||||
import Control.Effect.Carrier
|
||||
import Control.Effect.Error
|
||||
import Control.Effect.Fail
|
||||
import Control.Effect.Reader
|
||||
import Data.Text (Text, pack)
|
||||
import Data.Text.Prettyprint.Doc (Pretty (..))
|
||||
import GHC.Stack
|
||||
import Prelude hiding (fail)
|
||||
|
||||
data Loc = Loc
|
||||
{ locPath :: !Text
|
||||
@ -30,10 +27,6 @@ data Loc = Loc
|
||||
}
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
fromTSSpan :: TreeSitter.Span -> Loc
|
||||
fromTSSpan (TreeSitter.Span (TreeSitter.Pos a b) (TreeSitter.Pos c d))
|
||||
= Loc mempty (Span (Pos a b) (Pos c d))
|
||||
|
||||
interactive :: Loc
|
||||
interactive = Loc "<interactive>" emptySpan
|
||||
|
||||
|
@ -19,6 +19,7 @@ import GHC.Records
|
||||
import qualified Data.Loc
|
||||
import qualified TreeSitter.Python.AST as Py
|
||||
import TreeSitter.Span (Span)
|
||||
import qualified TreeSitter.Span as TreeSitter
|
||||
|
||||
-- We don't want to commit to a particular representation of Core syntax,
|
||||
-- but there are commonalities that repeatedly crop up and that clog type
|
||||
@ -42,7 +43,10 @@ class Compile py where
|
||||
compileCC py cc = (>>>) <$> compile py <*> cc
|
||||
|
||||
locate :: (HasField "ann" syntax Span, CoreSyntax sig t) => syntax -> t a -> t a
|
||||
locate syn = Core.annAt (Data.Loc.fromTSSpan (getField @"ann" syn))
|
||||
locate syn = Core.annAt (locFromTSSpan (getField @"ann" syn))
|
||||
where
|
||||
locFromTSSpan (TreeSitter.Span (TreeSitter.Pos a b) (TreeSitter.Pos c d))
|
||||
= Data.Loc.Loc mempty (Data.Loc.Span (Data.Loc.Pos a b) (Data.Loc.Pos c d))
|
||||
|
||||
-- | TODO: This is not right, it should be a reference to a Preluded
|
||||
-- NoneType instance, but it will do for now.
|
||||
|
Loading…
Reference in New Issue
Block a user