mirror of
https://github.com/github/semantic.git
synced 2024-11-29 21:52:59 +03:00
a few more otiose items
This commit is contained in:
Patrick Thomson
parent
0e26b83a1b
commit
a127404bb0
@ -89,7 +89,6 @@ library
|
||||
, Analysis.Abstract.Collecting
|
||||
, Analysis.Abstract.Dead
|
||||
, Analysis.Abstract.Tracing
|
||||
, Analysis.ConstructorName
|
||||
-- Control structures & interfaces for abstract interpretation
|
||||
, Control.Abstract
|
||||
, Control.Abstract.Context
|
||||
@ -260,7 +259,6 @@ test-suite test
|
||||
, Data.Functor.Classes.Generic.Spec
|
||||
, Data.Functor.Listable
|
||||
, Data.Graph.Spec
|
||||
, Data.Mergeable
|
||||
, Data.Language.Spec
|
||||
, Data.Scientific.Spec
|
||||
, Data.Semigroup.App.Spec
|
||||
|
||||
@ -1,62 +0,0 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
module Analysis.ConstructorName
|
||||
( ConstructorName(..)
|
||||
) where
|
||||
|
||||
import Data.Proxy
|
||||
import Data.Sum
|
||||
import Data.Term
|
||||
import GHC.Generics
|
||||
|
||||
-- | A typeclass to retrieve the name of the data constructor for a value.
|
||||
--
|
||||
-- This typeclass employs the Advanced Overlap techniques designed by Oleg Kiselyov & Simon Peyton Jones: https://wiki.haskell.org/GHC/AdvancedOverlap; see also src/Analysis/Declaration.hs for discussion of the details of the mechanism.
|
||||
class ConstructorName syntax where
|
||||
constructorName :: syntax a -> String
|
||||
|
||||
instance (ConstructorNameStrategy syntax ~ strategy, ConstructorNameWithStrategy strategy syntax) => ConstructorName syntax where
|
||||
constructorName = constructorNameWithStrategy (Proxy :: Proxy strategy)
|
||||
|
||||
instance Apply ConstructorName fs => ConstructorNameWithStrategy 'Custom (Sum fs) where
|
||||
constructorNameWithStrategy _ = apply @ConstructorName constructorName
|
||||
|
||||
instance ConstructorNameWithStrategy 'Custom [] where
|
||||
constructorNameWithStrategy _ _ = "Statements"
|
||||
|
||||
instance (ConstructorName syntax) => ConstructorNameWithStrategy 'Custom (TermF syntax ann) where
|
||||
constructorNameWithStrategy _ = constructorName . termFOut
|
||||
|
||||
data Strategy = Default | Custom
|
||||
|
||||
type family ConstructorNameStrategy syntax where
|
||||
ConstructorNameStrategy (Sum _) = 'Custom
|
||||
ConstructorNameStrategy [] = 'Custom
|
||||
ConstructorNameStrategy (TermF _ _) = 'Custom
|
||||
ConstructorNameStrategy _ = 'Default
|
||||
|
||||
class ConstructorNameWithStrategy (strategy :: Strategy) syntax where
|
||||
constructorNameWithStrategy :: proxy strategy -> syntax a -> String
|
||||
|
||||
instance (Generic1 syntax, GConstructorName (Rep1 syntax)) => ConstructorNameWithStrategy 'Default syntax where
|
||||
constructorNameWithStrategy _ = gconstructorName . from1
|
||||
|
||||
|
||||
class GConstructorName f where
|
||||
gconstructorName :: f a -> String
|
||||
|
||||
instance GConstructorName f => GConstructorName (M1 D c f) where
|
||||
gconstructorName = gconstructorName . unM1
|
||||
|
||||
instance (GConstructorName f, GConstructorName g) => GConstructorName (f :+: g) where
|
||||
gconstructorName (L1 l) = gconstructorName l
|
||||
gconstructorName (R1 r) = gconstructorName r
|
||||
|
||||
instance Constructor c => GConstructorName (M1 C c f) where
|
||||
gconstructorName = conName
|
||||
@ -1,104 +0,0 @@
|
||||
{-# LANGUAGE DataKinds, RecordWildCards, TypeOperators #-}
|
||||
module Parsing.CMark
|
||||
( Grammar(..)
|
||||
, cmarkParser
|
||||
, toGrammar
|
||||
) where
|
||||
|
||||
import CMarkGFM
|
||||
import Data.Array
|
||||
import qualified Data.AST as A
|
||||
import Data.Term
|
||||
import Source.Loc
|
||||
import qualified Source.Range as Range
|
||||
import Source.Source (Source)
|
||||
import qualified Source.Source as Source
|
||||
import Source.Span hiding (HasSpan (..))
|
||||
import TreeSitter.Language (Symbol (..), SymbolType (..))
|
||||
|
||||
data Grammar
|
||||
= Document
|
||||
| ThematicBreak
|
||||
| Paragraph
|
||||
| BlockQuote
|
||||
| HTMLBlock
|
||||
| CustomBlock
|
||||
| CodeBlock
|
||||
| Heading
|
||||
| List
|
||||
| Item
|
||||
| Text
|
||||
| SoftBreak
|
||||
| LineBreak
|
||||
| HTMLInline
|
||||
| CustomInline
|
||||
| Code
|
||||
| Emphasis
|
||||
| Strong
|
||||
| Link
|
||||
| Image
|
||||
| Strikethrough
|
||||
| Table
|
||||
| TableRow
|
||||
| TableCell
|
||||
deriving (Bounded, Enum, Eq, Ix, Ord, Show)
|
||||
|
||||
exts :: [CMarkExtension]
|
||||
exts = [
|
||||
extStrikethrough
|
||||
, extTable
|
||||
, extAutolink
|
||||
, extTagfilter
|
||||
]
|
||||
|
||||
cmarkParser :: Source -> A.AST (TermF [] NodeType) Grammar
|
||||
cmarkParser source = toTerm (Source.totalRange source) (Source.totalSpan source) $ commonmarkToNode [ optSourcePos ] exts (Source.toText source)
|
||||
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
|
||||
in termIn (A.Node (toGrammar t) (Loc range span)) (In t (toTerm range span <$> children))
|
||||
|
||||
toSpan PosInfo{..} = Span (Pos startLine startColumn) (Pos (max startLine endLine) (succ (if endLine <= startLine then max startColumn endColumn else endColumn)))
|
||||
|
||||
lineRanges = sourceLineRangesByLineNumber source
|
||||
|
||||
toGrammar :: NodeType -> Grammar
|
||||
toGrammar DOCUMENT{} = Document
|
||||
toGrammar THEMATIC_BREAK{} = ThematicBreak
|
||||
toGrammar PARAGRAPH{} = Paragraph
|
||||
toGrammar BLOCK_QUOTE{} = BlockQuote
|
||||
toGrammar HTML_BLOCK{} = HTMLBlock
|
||||
toGrammar CUSTOM_BLOCK{} = CustomBlock
|
||||
toGrammar CODE_BLOCK{} = CodeBlock
|
||||
toGrammar HEADING{} = Heading
|
||||
toGrammar LIST{} = List
|
||||
toGrammar ITEM{} = Item
|
||||
toGrammar TEXT{} = Text
|
||||
toGrammar SOFTBREAK{} = SoftBreak
|
||||
toGrammar LINEBREAK{} = LineBreak
|
||||
toGrammar HTML_INLINE{} = HTMLInline
|
||||
toGrammar CUSTOM_INLINE{} = CustomInline
|
||||
toGrammar CODE{} = Code
|
||||
toGrammar EMPH{} = Emphasis
|
||||
toGrammar STRONG{} = Strong
|
||||
toGrammar LINK{} = Link
|
||||
toGrammar IMAGE{} = Image
|
||||
toGrammar STRIKETHROUGH{} = Strikethrough
|
||||
toGrammar TABLE{} = Table
|
||||
toGrammar TABLE_ROW{} = TableRow
|
||||
toGrammar TABLE_CELL{} = TableCell
|
||||
|
||||
|
||||
instance Symbol Grammar where
|
||||
symbolType _ = Regular
|
||||
|
||||
|
||||
spanToRangeInLineRanges :: Array Int Range -> Span -> Range
|
||||
spanToRangeInLineRanges lineRanges Span{..} = Range
|
||||
(Range.start (lineRanges ! line start) + pred (column start))
|
||||
(Range.start (lineRanges ! line end) + pred (column end))
|
||||
|
||||
sourceLineRangesByLineNumber :: Source -> Array Int Range
|
||||
sourceLineRangesByLineNumber source = listArray (1, length lineRanges) lineRanges
|
||||
where lineRanges = Source.lineRanges source
|
||||
@ -1,86 +0,0 @@
|
||||
{-# LANGUAGE DefaultSignatures, FlexibleContexts, TypeApplications, TypeOperators, UndecidableInstances #-}
|
||||
module Data.Mergeable ( Mergeable (..) ) where
|
||||
|
||||
import Control.Applicative
|
||||
import Data.Functor.Identity
|
||||
import Data.List.NonEmpty
|
||||
import Data.Sum
|
||||
import qualified Data.Syntax as Syntax
|
||||
import qualified Data.Syntax.Comment as Comment
|
||||
import qualified Data.Syntax.Declaration as Declaration
|
||||
import qualified Data.Syntax.Statement as Statement
|
||||
import GHC.Generics
|
||||
|
||||
-- Classes
|
||||
|
||||
-- | A 'Mergeable' functor is one which supports pushing itself through an 'Alternative' functor. Note the similarities with 'Traversable' & 'Crosswalk'.
|
||||
--
|
||||
-- This is a kind of distributive law which produces (at least) the union of the two functors’ shapes; i.e. unlike 'Traversable', an 'empty' value in the inner functor does not produce an 'empty' result, and unlike 'Crosswalk', an 'empty' value in the outer functor does not produce an 'empty' result.
|
||||
--
|
||||
-- For example, 'Data.Diff' uses 'sequenceAlt' to select one side or the other of a diff node, while correctly handling the fact that some patches don’t have any content for that side.
|
||||
class Functor t => Mergeable t where
|
||||
-- | Sequence a 'Mergeable' functor by merging the 'Alternative' values.
|
||||
sequenceAlt :: Alternative f => t (f a) -> f (t a)
|
||||
default sequenceAlt :: (Generic1 t, GMergeable (Rep1 t), Alternative f) => t (f a) -> f (t a)
|
||||
sequenceAlt = genericSequenceAlt
|
||||
|
||||
|
||||
-- Instances
|
||||
|
||||
instance Mergeable [] where
|
||||
sequenceAlt = foldr (\ x -> (((:) <$> x <|> pure id) <*>)) (pure [])
|
||||
|
||||
instance Mergeable NonEmpty where
|
||||
sequenceAlt (x :|[]) = (:|) <$> x <*> pure []
|
||||
sequenceAlt (x1:|x2:xs) = (:|) <$> x1 <*> sequenceAlt (x2 : xs) <|> sequenceAlt (x2:|xs)
|
||||
|
||||
instance Mergeable Maybe where
|
||||
sequenceAlt = maybe (pure empty) (fmap Just)
|
||||
|
||||
instance Mergeable Identity where
|
||||
sequenceAlt = fmap Identity . runIdentity
|
||||
|
||||
instance (Apply Functor fs, Apply Mergeable fs) => Mergeable (Sum fs) where
|
||||
sequenceAlt = apply' @Mergeable (\ reinj t -> reinj <$> sequenceAlt t)
|
||||
|
||||
instance Mergeable Comment.Comment
|
||||
instance Mergeable Declaration.Function
|
||||
instance Mergeable Declaration.Method
|
||||
instance Mergeable Statement.If
|
||||
instance Mergeable Syntax.Context
|
||||
instance Mergeable Syntax.Empty
|
||||
instance Mergeable Syntax.Identifier
|
||||
|
||||
|
||||
-- Generics
|
||||
|
||||
class GMergeable t where
|
||||
gsequenceAlt :: Alternative f => t (f a) -> f (t a)
|
||||
|
||||
genericSequenceAlt :: (Generic1 t, GMergeable (Rep1 t), Alternative f) => t (f a) -> f (t a)
|
||||
genericSequenceAlt = fmap to1 . gsequenceAlt . from1
|
||||
|
||||
|
||||
-- Instances
|
||||
|
||||
instance GMergeable U1 where
|
||||
gsequenceAlt _ = pure U1
|
||||
|
||||
instance GMergeable Par1 where
|
||||
gsequenceAlt (Par1 a) = Par1 <$> a
|
||||
|
||||
instance GMergeable (K1 i c) where
|
||||
gsequenceAlt (K1 a) = pure (K1 a)
|
||||
|
||||
instance Mergeable f => GMergeable (Rec1 f) where
|
||||
gsequenceAlt (Rec1 a) = Rec1 <$> sequenceAlt a
|
||||
|
||||
instance GMergeable f => GMergeable (M1 i c f) where
|
||||
gsequenceAlt (M1 a) = M1 <$> gsequenceAlt a
|
||||
|
||||
instance (GMergeable f, GMergeable g) => GMergeable (f :+: g) where
|
||||
gsequenceAlt (L1 a) = L1 <$> gsequenceAlt a
|
||||
gsequenceAlt (R1 a) = R1 <$> gsequenceAlt a
|
||||
|
||||
instance (GMergeable f, GMergeable g) => GMergeable (f :*: g) where
|
||||
gsequenceAlt (a :*: b) = (:*:) <$> gsequenceAlt a <*> gsequenceAlt b
|
||||
Loading…
Reference in New Issue
Block a user