mirror of
https://github.com/github/semantic.git
synced 2024-12-25 16:02:43 +03:00
27 lines
1.2 KiB
Haskell
27 lines
1.2 KiB
Haskell
module Parser where
|
||
|
||
import Diff
|
||
import Range
|
||
import Syntax
|
||
import Term
|
||
import Control.Comonad.Cofree
|
||
import qualified OrderedMap as Map
|
||
import qualified Data.Set as Set
|
||
import qualified Data.Text as T
|
||
|
||
type Parser = T.Text -> IO (Term T.Text Info)
|
||
|
||
-- | Given a source string and a term’s annotation & production/child pairs, construct the term.
|
||
type Constructor = String -> Info -> [(String, Term String Info)] -> Term String Info
|
||
|
||
-- | Given two sets of production names, produce a Constructor.
|
||
constructorForProductions :: Set.Set String -> Set.Set String -> Constructor
|
||
constructorForProductions keyed fixed source info@(Info range categories) = (info :<) . construct
|
||
where construct [] = Leaf (substring range source)
|
||
construct children | not . Set.null $ Set.intersection fixed categories = Fixed $ fmap snd children
|
||
construct children | not . Set.null $ Set.intersection keyed categories = Keyed . Map.fromList $ assignKey <$> children
|
||
construct children = Indexed $ fmap snd children
|
||
assignKey ("pair", node@(_ :< Fixed (key : _))) = (getSubstring key, node)
|
||
assignKey (_, node) = (getSubstring node, node)
|
||
getSubstring (Info range _ :< _) = substring range source
|