github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-25 07:55:12 +03:00
Code Issues Projects Releases Wiki Activity

Remove tree-sitter dependency from semantic-core.

Browse Source
This commit is contained in:
Patrick Thomson 2019-09-18 13:49:04 -04:00
parent 302add6c5e
commit da5bb84b05
4 changed files with 16 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
semantic-core/semantic-core.cabal
View File

@ -51,7 +51,6 @@ library
, semigroupoids ^>= 5.3 , semigroupoids ^>= 5.3
, text ^>= 1.2.3.1 , text ^>= 1.2.3.1
, transformers ^>= 0.5.6 , transformers ^>= 0.5.6
, tree-sitter == 0.3.0.0
, trifecta ^>= 2 , trifecta ^>= 2
, unordered-containers ^>= 0.2.10 , unordered-containers ^>= 0.2.10
hs-source-dirs: src hs-source-dirs: src

2
semantic-core/src/Data/Core.hs
View File

@ -230,7 +230,7 @@ annAt :: (Carrier sig m, Member Ann sig) => Loc -> m a -> m a
annAt loc = send . Ann loc annAt loc = send . Ann loc
annWith :: (Carrier sig m, Member Ann sig) => CallStack -> m a -> m a 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 stripAnnotations :: (HFunctor sig, forall g . Functor g => Functor (sig g)) => Term (Ann :+: sig) a -> Term sig a

27
semantic-core/src/Data/Loc.hs
View File

@ -1,9 +1,7 @@
{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, OverloadedStrings, RecordWildCards, {-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, OverloadedStrings, RecordWildCards, TypeOperators, UndecidableInstances #-}
TypeOperators, UndecidableInstances #-}
module Data.Loc module Data.Loc
( Loc(..) ( Loc(..)
, interactive , interactive
, fromTSSpan
, Span(..) , Span(..)
, emptySpan , emptySpan
, Pos(..) , Pos(..)
@ -13,16 +11,15 @@ module Data.Loc
, runFailWithLoc , runFailWithLoc
) where ) where
import Control.Applicative import Control.Applicative
import Control.Effect.Carrier import Control.Effect.Carrier
import Control.Effect.Error import Control.Effect.Error
import Control.Effect.Fail import Control.Effect.Fail
import Control.Effect.Reader import Control.Effect.Reader
import Data.Text (Text, pack) import Data.Text (Text, pack)
import Data.Text.Prettyprint.Doc (Pretty (..)) import Data.Text.Prettyprint.Doc (Pretty (..))
import GHC.Stack import GHC.Stack
import Prelude hiding (fail) import Prelude hiding (fail)
import qualified TreeSitter.Span as TreeSitter
data Loc = Loc data Loc = Loc
{ locPath :: !Text { locPath :: !Text
@ -30,10 +27,6 @@ data Loc = Loc
} }
deriving (Eq, Ord, Show) 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 = Loc "<interactive>" emptySpan interactive = Loc "<interactive>" emptySpan

6
semantic-python/src/Language/Python/Core.hs
View File

@ -19,6 +19,7 @@ import GHC.Records
import qualified Data.Loc import qualified Data.Loc
import qualified TreeSitter.Python.AST as Py import qualified TreeSitter.Python.AST as Py
import TreeSitter.Span (Span) import TreeSitter.Span (Span)
import qualified TreeSitter.Span as TreeSitter
-- We don't want to commit to a particular representation of Core syntax, -- 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 -- 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 compileCC py cc = (>>>) <$> compile py <*> cc
locate :: (HasField "ann" syntax Span, CoreSyntax sig t) => syntax -> t a -> t a 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 -- | TODO: This is not right, it should be a reference to a Preluded
-- NoneType instance, but it will do for now. -- NoneType instance, but it will do for now.