1
1
mirror of https://github.com/github/semantic.git synced 2024-12-24 23:42:31 +03:00

Rename Cofree/CofreeF to Term/TermF.

This commit is contained in:
Rob Rix 2017-09-08 16:45:08 +01:00
parent aa9d4c4f19
commit f2cd05d5fc
7 changed files with 40 additions and 45 deletions

View File

@ -127,7 +127,7 @@ type Assignment ast grammar = Freer (Tracing (AssignmentF ast grammar))
data AssignmentF ast grammar a where
End :: AssignmentF ast grammar ()
Location :: AssignmentF ast grammar (Record Location)
CurrentNode :: AssignmentF ast grammar (CofreeF ast (Node grammar) ())
CurrentNode :: AssignmentF ast grammar (TermF ast (Node grammar) ())
Source :: AssignmentF ast grammar ByteString
Children :: Assignment ast grammar a -> AssignmentF ast grammar a
Advance :: AssignmentF ast grammar ()
@ -157,7 +157,7 @@ location :: HasCallStack => Assignment ast grammar (Record Location)
location = tracing Location `Then` return
-- | Zero-width production of the current node.
currentNode :: HasCallStack => Assignment ast grammar (CofreeF ast (Node grammar) ())
currentNode :: HasCallStack => Assignment ast grammar (TermF ast (Node grammar) ())
currentNode = tracing CurrentNode `Then` return
-- | Zero-width match of a node with the given symbol, producing the current nodes location.
@ -206,7 +206,7 @@ toIndex = index (minBound, maxBound)
type Location = '[Info.Range, Info.Span]
-- | An AST node labelled with symbols and source location.
type AST f grammar = Cofree f (Node grammar)
type AST f grammar = Term f (Node grammar)
data Node grammar = Node
{ nodeSymbol :: !grammar

View File

@ -11,7 +11,7 @@ import Data.Source
import qualified Data.Syntax.Assignment as A (AST, Node(..))
import Info
import TreeSitter.Language (Symbol(..), SymbolType(..))
import Term as Cofree
import Term
data Grammar
= Document
@ -48,9 +48,9 @@ exts = [
, extTagfilter
]
cmarkParser :: Source -> A.AST (CofreeF [] NodeType) Grammar
cmarkParser :: Source -> A.AST (TermF [] NodeType) Grammar
cmarkParser source = toTerm (totalRange source) (totalSpan source) $ commonmarkToNode [ optSourcePos, optSafe ] exts (toText source)
where toTerm :: Range -> Span -> Node -> A.AST (CofreeF [] NodeType) Grammar
where toTerm :: Range -> Span -> Node -> A.AST (TermF [] NodeType) Grammar
toTerm within withinSpan (Node position t children) =
let range = maybe within (spanToRangeInLineRanges lineRanges . toSpan) position
span = maybe withinSpan toSpan position

View File

@ -20,7 +20,7 @@ import Data.Text.Encoding (encodeUtf8)
import Data.Union
import GHC.Stack
import Language.Markdown as Grammar (Grammar(..))
import Term (Cofree(..), CofreeF(..), unwrap, headF, tailF)
import Term (TermF(..), unwrap, headF, tailF)
import qualified Term
type Syntax =
@ -52,7 +52,7 @@ type Syntax =
]
type Term = Term.Term (Union Syntax) (Record Location)
type Assignment = HasCallStack => Assignment.Assignment (CofreeF [] CMarkGFM.NodeType) Grammar Term
type Assignment = HasCallStack => Assignment.Assignment (TermF [] CMarkGFM.NodeType) Grammar Term
assignment :: Assignment
@ -68,7 +68,7 @@ paragraph :: Assignment
paragraph = makeTerm <$> symbol Paragraph <*> children (Markup.Paragraph <$> many inlineElement)
list :: Assignment
list = (:<) <$> symbol List <*> ((\ (CMarkGFM.LIST CMarkGFM.ListAttributes{..}) -> case listType of
list = (Term.:<) <$> symbol List <*> ((\ (CMarkGFM.LIST CMarkGFM.ListAttributes{..}) -> case listType of
CMarkGFM.BULLET_LIST -> inj . Markup.UnorderedList
CMarkGFM.ORDERED_LIST -> inj . Markup.OrderedList) . headF . tailF <$> currentNode <*> children (many item))

View File

@ -39,14 +39,14 @@ data Parser term where
-- | A parser producing 'AST' using a 'TS.Language'.
ASTParser :: (Bounded grammar, Enum grammar) => Ptr TS.Language -> Parser (AST [] grammar)
-- | A parser producing an à la carte term given an 'AST'-producing parser and an 'Assignment' onto 'Term's in some syntax type.
AssignmentParser :: (Bounded grammar, Ix grammar, Show grammar, TS.Symbol grammar, Syntax.Error :< fs, Eq (ast (Cofree ast (Node grammar))), Apply1 Foldable fs, Apply1 Functor fs, Foldable ast, Functor ast)
=> Parser (Cofree ast (Node grammar)) -- ^ A parser producing AST.
AssignmentParser :: (Bounded grammar, Ix grammar, Show grammar, TS.Symbol grammar, Syntax.Error :< fs, Eq (ast (Term ast (Node grammar))), Apply1 Foldable fs, Apply1 Functor fs, Foldable ast, Functor ast)
=> Parser (Term ast (Node grammar)) -- ^ A parser producing AST.
-> Assignment ast grammar (Term (Union fs) (Record Location)) -- ^ An assignment from AST onto 'Term's.
-> Parser (Term (Union fs) (Record Location)) -- ^ A parser producing 'Term's.
-- | A tree-sitter parser.
TreeSitterParser :: Ptr TS.Language -> Parser (SyntaxTerm DefaultFields)
-- | A parser for 'Markdown' using cmark.
MarkdownParser :: Parser (Cofree (CofreeF [] CMarkGFM.NodeType) (Node Markdown.Grammar))
MarkdownParser :: Parser (Term (TermF [] CMarkGFM.NodeType) (Node Markdown.Grammar))
-- | A parser which will parse any input 'Source' into a top-level 'Term' whose children are leaves consisting of the 'Source's lines.
LineByLineParser :: Parser (SyntaxTerm DefaultFields)

View File

@ -74,7 +74,7 @@ data SomeRenderer f where
deriving instance Show (SomeRenderer f)
identifierAlgebra :: RAlgebra (CofreeF Syntax a) (Cofree Syntax a) (Maybe Identifier)
identifierAlgebra :: RAlgebra (TermF Syntax a) (Term Syntax a) (Maybe Identifier)
identifierAlgebra (_ :<< syntax) = case syntax of
S.Assignment f _ -> identifier f
S.Class f _ _ -> identifier f

View File

@ -56,7 +56,7 @@ instance (ToJSONFields a, ToJSONFields (f (Free f a))) => ToJSON (Free f a) wher
toJSON = object . toJSONFields
toEncoding = pairs . mconcat . toJSONFields
instance (ToJSONFields a, ToJSONFields (f (Cofree f a))) => ToJSON (Cofree f a) where
instance (ToJSONFields a, ToJSONFields (f (Term f a))) => ToJSON (Term f a) where
toJSON (a :< f) = object (toJSONFields a <> toJSONFields f)
toEncoding (a :< f) = pairs (mconcat (toJSONFields a <> toJSONFields f))
@ -85,10 +85,10 @@ instance ToJSONFields Span where
instance ToJSONFields a => ToJSONFields (Maybe a) where
toJSONFields = maybe [] toJSONFields
instance (ToJSONFields a, ToJSONFields (f (Cofree f a))) => ToJSONFields (Cofree f a) where
instance (ToJSONFields a, ToJSONFields (f (Term f a))) => ToJSONFields (Term f a) where
toJSONFields (a :< f) = toJSONFields a <> toJSONFields f
instance (ToJSONFields a, ToJSONFields (f b)) => ToJSONFields (CofreeF f a b) where
instance (ToJSONFields a, ToJSONFields (f b)) => ToJSONFields (TermF f a b) where
toJSONFields (a :<< f) = toJSONFields a <> toJSONFields f
instance (ToJSONFields a, ToJSONFields (f (Free f a))) => ToJSONFields (Free f a) where

View File

@ -1,19 +1,17 @@
{-# LANGUAGE MultiParamTypeClasses, RankNTypes, TypeFamilies, TypeSynonymInstances, UndecidableInstances #-}
module Term
( Term
, TermF
( Term(..)
, TermF(..)
, SyntaxTerm
, SyntaxTermF
, zipTerms
, termSize
, alignCofreeWith
, alignTermWith
, cofree
, runCofree
, Cofree(..)
, extract
, unwrap
, hoistCofree
, CofreeF(..)
) where
import Control.Comonad
@ -33,28 +31,25 @@ import Data.Union
import Syntax
-- | A Term with an abstract syntax tree and an annotation.
type Term = Cofree
type TermF = CofreeF
infixr 5 :<
data Cofree f a = a :< f (Cofree f a)
data CofreeF f a b = (:<<) { headF :: a, tailF :: f b }
data Term f a = a :< f (Term f a)
data TermF f a b = (:<<) { headF :: a, tailF :: f b }
deriving (Eq, Foldable, Functor, Show, Traversable)
-- | A Term with a Syntax leaf and a record of fields.
type SyntaxTerm fields = Term Syntax (Record fields)
type SyntaxTermF fields = TermF Syntax (Record fields)
instance (NFData (f (Cofree f a)), NFData a, Functor f) => NFData (Cofree f a) where
instance (NFData (f (Term f a)), NFData a, Functor f) => NFData (Term f a) where
rnf = rnf . runCofree
instance (NFData a, NFData (f b)) => NFData (CofreeF f a b) where
instance (NFData a, NFData (f b)) => NFData (TermF f a b) where
rnf (a :<< s) = rnf a `seq` rnf s `seq` ()
-- | Zip two terms by combining their annotations into a pair of annotations.
-- | If the structure of the two terms don't match, then Nothing will be returned.
zipTerms :: (Traversable f, GAlign f) => Term f annotation -> Term f annotation -> Maybe (Term f (Both annotation))
zipTerms t1 t2 = iter go (alignCofreeWith galign (const Nothing) both (These t1 t2))
zipTerms t1 t2 = iter go (alignTermWith galign (const Nothing) both (These t1 t2))
where go (a :<< s) = (a :<) <$> sequenceA s
-- | Return the node count of a term.
@ -63,58 +58,58 @@ termSize = cata size where
size (_ :<< syntax) = 1 + sum syntax
-- | Aligns (zips, retaining non-overlapping portions of the structure) a pair of terms.
alignCofreeWith :: Functor f
alignTermWith :: Functor f
=> (forall a b. f a -> f b -> Maybe (f (These a b))) -- ^ A function comparing a pair of structures, returning `Just` the combined structure if they are comparable (e.g. if they have the same constructor), and `Nothing` otherwise. The 'Data.Align.Generic.galign' function is usually what you want here.
-> (These (Term f a) (Term f b) -> contrasted) -- ^ A function mapping a 'These' of incomparable terms into 'Pure' values in the resulting tree.
-> (a -> b -> combined) -- ^ A function mapping the input terms annotations into annotations in the 'Free' values in the resulting tree.
-> These (Term f a) (Term f b) -- ^ The input terms.
-> Free (TermF f combined) contrasted
alignCofreeWith compare contrast combine = go
alignTermWith compare contrast combine = go
where go terms = fromMaybe (pure (contrast terms)) $ case terms of
These (a1 :< f1) (a2 :< f2) -> wrap . (combine a1 a2 :<<) . fmap go <$> compare f1 f2
_ -> Nothing
cofree :: CofreeF f a (Cofree f a) -> Cofree f a
cofree :: TermF f a (Term f a) -> Term f a
cofree (a :<< f) = a :< f
runCofree :: Cofree f a -> CofreeF f a (Cofree f a)
runCofree :: Term f a -> TermF f a (Term f a)
runCofree (a :< f) = a :<< f
hoistCofree :: Functor f => (forall a. f a -> g a) -> Cofree f a -> Cofree g a
hoistCofree :: Functor f => (forall a. f a -> g a) -> Term f a -> Term g a
hoistCofree f = go where go (a :< r) = a :< f (fmap go r)
instance Pretty1 f => Pretty1 (Cofree f) where
instance Pretty1 f => Pretty1 (Term f) where
liftPretty p pl = go where go (a :< f) = p a <+> liftPretty go (list . map (liftPretty p pl)) f
instance (Pretty1 f, Pretty a) => Pretty (Cofree f a) where
instance (Pretty1 f, Pretty a) => Pretty (Term f a) where
pretty = liftPretty pretty prettyList
instance Apply1 Pretty1 fs => Pretty1 (Union fs) where
liftPretty p pl = apply1 (Proxy :: Proxy Pretty1) (liftPretty p pl)
type instance Base (Cofree f a) = CofreeF f a
type instance Base (Term f a) = TermF f a
instance Functor f => Recursive (Cofree f a) where project = runCofree
instance Functor f => Corecursive (Cofree f a) where embed = cofree
instance Functor f => Recursive (Term f a) where project = runCofree
instance Functor f => Corecursive (Term f a) where embed = cofree
instance Functor f => Comonad (Cofree f) where
instance Functor f => Comonad (Term f) where
extract (a :< _) = a
duplicate w = w :< fmap duplicate (unwrap w)
extend f = go where go w = f w :< fmap go (unwrap w)
instance Functor f => Functor (Cofree f) where
instance Functor f => Functor (Term f) where
fmap f = go where go (a :< r) = f a :< fmap go r
instance Functor f => ComonadCofree f (Cofree f) where
instance Functor f => ComonadCofree f (Term f) where
unwrap (_ :< as) = as
{-# INLINE unwrap #-}
instance (Eq (f (Cofree f a)), Eq a) => Eq (Cofree f a) where
instance (Eq (f (Term f a)), Eq a) => Eq (Term f a) where
a1 :< f1 == a2 :< f2 = a1 == a2 && f1 == f2
instance (Show (f (Cofree f a)), Show a) => Show (Cofree f a) where
instance (Show (f (Term f a)), Show a) => Show (Term f a) where
showsPrec d (a :< f) = showParen (d > 5) $ showsPrec 6 a . showString " :< " . showsPrec 5 f
instance Functor f => Bifunctor (CofreeF f) where
instance Functor f => Bifunctor (TermF f) where
bimap f g (a :<< r) = f a :<< fmap g r