Define Unmarshal instances for Range, Span, and Location.

semantic-tags/src/Data/Location.hs

@@ -5,12 +5,17 @@ module Data.Location
 , Range(..)
 ) where
 
+import Control.Applicative (liftA2)
 import Data.Range
 import Data.Span
 import GHC.Generics (Generic)
+import TreeSitter.Unmarshal
 
 data Location = Location
   { locationByteRange :: {-# UNPACK #-} !Range
   , locationSpan      :: {-# UNPACK #-} !Span
   }
   deriving (Eq, Generic, Ord, Show)
+
+instance Unmarshal Location where
+  unmarshalNodes = liftA2 Location <$> unmarshalNodes <*> unmarshalNodes

semantic-tags/src/Data/Range.hs

@@ -7,6 +7,8 @@ module Data.Range
 ) where
 
 import GHC.Generics (Generic)
+import TreeSitter.Node
+import TreeSitter.Unmarshal
 
 -- | A half-open interval of integers, defined by start & end indices.
 data Range = Range { start :: {-# UNPACK #-} !Int, end :: {-# UNPACK #-} !Int }
@@ -24,13 +26,20 @@ subtractRange :: Range -> Range -> Range
 subtractRange range1 range2 = Range (start range1) (end range1 - rangeLength (Range (start range2) (max (end range1) (end range2))))
 
 
--- Instances
-
 -- $
 -- prop> a <> (b <> c) === (a <> b) <> (c :: Range)
 instance Semigroup Range where
   Range start1 end1 <> Range start2 end2 = Range (min start1 start2) (max end1 end2)
 
+instance Unmarshal Range where
+  unmarshalNodes _ = do
+    node <- peekNode
+    case node of
+      Just node -> do
+        let start = fromIntegral (nodeStartByte node)
+            end = fromIntegral (nodeEndByte node)
+        pure (Range start end)
+      Nothing -> fail "expected a node but didn't get one"
 
 -- $setup
 -- >>> import Test.QuickCheck

semantic-tags/src/Data/Span.hs

@@ -7,15 +7,14 @@ module Data.Span
 import           Data.Aeson ((.=))
 import qualified Data.Aeson as A
 import           GHC.Generics (Generic)
+import           TreeSitter.Node
+import           TreeSitter.Unmarshal
 
 data Span = Span
   { spanStart :: {-# UNPACK #-} !Pos
   , spanEnd   :: {-# UNPACK #-} !Pos
   }
-  deriving (Eq, Ord, Generic)
-
-instance Show Span where
-  showsPrec _ s = shows (spanStart s) . showString ".." . shows (spanEnd s)
+  deriving (Eq, Ord, Generic, Show)
 
 instance A.ToJSON Span where
   toJSON s = A.object
@@ -23,14 +22,23 @@ instance A.ToJSON Span where
     , "end"   .= spanEnd   s
     ]
 
+instance Unmarshal Span where
+  unmarshalNodes _ = do
+    node <- peekNode
+    case node of
+      Just node -> do
+        let spanStart = pointToPos (nodeStartPoint node)
+            spanEnd = pointToPos (nodeEndPoint node)
+        pure (Span spanStart spanEnd)
+      Nothing -> fail "expected a node but didn't get one"
+    where pointToPos (TSPoint line column) = Pos (fromIntegral line) (fromIntegral column)
+
+
 data Pos = Pos
   { posLine   :: {-# UNPACK #-} !Int
   , posColumn :: {-# UNPACK #-} !Int
   }
-  deriving (Eq, Ord, Generic)
-
-instance Show Pos where
-  showsPrec _ p = showChar '[' . shows (posLine p) . showString ", " . shows (posColumn p) . showChar ']'
+  deriving (Eq, Ord, Generic, Show)
 
 instance A.ToJSON Pos where
   toJSON p = A.toJSON [posLine p, posColumn p]