1
1
mirror of https://github.com/github/semantic.git synced 2024-12-25 16:02:43 +03:00
semantic/src/Data/AST.hs

36 lines
775 B
Haskell

{-# LANGUAGE DataKinds #-}
module Data.AST
( Node (..)
, nodeSpan
, nodeByteRange
, AST
) where
import Data.Term
import Data.Aeson
import Data.Text (pack)
import Data.JSON.Fields
import Source.Loc
-- | An AST node labelled with symbols and source location.
type AST syntax grammar = Term syntax (Node grammar)
data Node grammar = Node
{ nodeSymbol :: !grammar
, nodeLocation :: {-# UNPACK #-} !Loc
}
deriving (Eq, Ord, Show)
instance Show grammar => ToJSONFields (Node grammar) where
toJSONFields Node{..} =
[ "symbol" .= pack (show nodeSymbol)
, "span" .= locSpan nodeLocation
]
nodeSpan :: Node grammar -> Span
nodeSpan = locSpan . nodeLocation
nodeByteRange :: Node grammar -> Range
nodeByteRange = locByteRange . nodeLocation