diff --git a/semantic-core/semantic-core.cabal b/semantic-core/semantic-core.cabal index e132f3901..ba80c082e 100644 --- a/semantic-core/semantic-core.cabal +++ b/semantic-core/semantic-core.cabal @@ -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 diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs index d124a1f7b..63c28c77a 100644 --- a/semantic-core/src/Data/Core.hs +++ b/semantic-core/src/Data/Core.hs @@ -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 diff --git a/semantic-core/src/Data/Loc.hs b/semantic-core/src/Data/Loc.hs index e6c2c24dd..7309da66e 100644 --- a/semantic-core/src/Data/Loc.hs +++ b/semantic-core/src/Data/Loc.hs @@ -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 "" emptySpan diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs index f4266912d..df386fcd0 100644 --- a/semantic-python/src/Language/Python/Core.hs +++ b/semantic-python/src/Language/Python/Core.hs @@ -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.