mirror of
https://github.com/github/semantic.git
synced 2024-11-28 01:47:01 +03:00
Merge branch 'master' into normalize-unevaluated-module-tables
This commit is contained in:
commit
571d273c93
@ -25,13 +25,13 @@ import Prologue hiding (project)
|
||||
|
||||
-- | A declaration’s identifier and type.
|
||||
data Declaration
|
||||
= MethodDeclaration { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Maybe Language, declarationReceiver :: Maybe T.Text }
|
||||
| ClassDeclaration { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Maybe Language }
|
||||
| ImportDeclaration { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Maybe Language, declarationAlias :: T.Text, declarationSymbols :: [(T.Text, T.Text)] }
|
||||
| FunctionDeclaration { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Maybe Language }
|
||||
| HeadingDeclaration { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Maybe Language, declarationLevel :: Int }
|
||||
| CallReference { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Maybe Language, declarationImportIdentifier :: [T.Text] }
|
||||
| ErrorDeclaration { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Maybe Language }
|
||||
= MethodDeclaration { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Language, declarationReceiver :: Maybe T.Text }
|
||||
| ClassDeclaration { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Language }
|
||||
| ImportDeclaration { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Language, declarationAlias :: T.Text, declarationSymbols :: [(T.Text, T.Text)] }
|
||||
| FunctionDeclaration { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Language }
|
||||
| HeadingDeclaration { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Language, declarationLevel :: Int }
|
||||
| CallReference { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Language, declarationImportIdentifier :: [T.Text] }
|
||||
| ErrorDeclaration { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Language }
|
||||
deriving (Eq, Generic, Show)
|
||||
|
||||
|
||||
@ -108,7 +108,7 @@ instance CustomHasDeclaration whole Declaration.Method where
|
||||
-- Methods without a receiver
|
||||
| isEmpty receiverAnn = Just $ MethodDeclaration (getSource blobSource identifierAnn) (getMethodSource blob (In ann decl)) blobLanguage Nothing
|
||||
-- Methods with a receiver type and an identifier (e.g. (a *Type) in Go).
|
||||
| blobLanguage == Just Go
|
||||
| blobLanguage == Go
|
||||
, [ _, Term (In receiverType _) ] <- toList receiverF = Just $ MethodDeclaration (getSource blobSource identifierAnn) (getMethodSource blob (In ann decl)) blobLanguage (Just (getSource blobSource receiverType))
|
||||
-- Methods with a receiver (class methods) are formatted like `receiver.method_name`
|
||||
| otherwise = Just $ MethodDeclaration (getSource blobSource identifierAnn) (getMethodSource blob (In ann decl)) blobLanguage (Just (getSource blobSource receiverAnn))
|
||||
|
@ -26,17 +26,16 @@ import Data.Source as Source
|
||||
data Blob = Blob
|
||||
{ blobSource :: Source -- ^ The UTF-8 encoded source text of the blob.
|
||||
, blobPath :: FilePath -- ^ The file path to the blob.
|
||||
, blobLanguage :: Maybe Language -- ^ The language of this blob. Nothing denotes a langauge we don't support yet.
|
||||
, blobLanguage :: Language -- ^ The language of this blob.
|
||||
}
|
||||
deriving (Show, Eq, Generic, Message, Named)
|
||||
|
||||
nullBlob :: Blob -> Bool
|
||||
nullBlob Blob{..} = nullSource blobSource
|
||||
|
||||
sourceBlob :: FilePath -> Maybe Language -> Source -> Blob
|
||||
sourceBlob :: FilePath -> Language -> Source -> Blob
|
||||
sourceBlob filepath language source = Blob source filepath language
|
||||
|
||||
|
||||
-- | Represents a blobs suitable for diffing which can be either a blob to
|
||||
-- delete, a blob to insert, or a pair of blobs to diff.
|
||||
type BlobPair = Join These Blob
|
||||
@ -51,10 +50,14 @@ blobPairInserting = Join . That
|
||||
blobPairDeleting :: Blob -> BlobPair
|
||||
blobPairDeleting = Join . This
|
||||
|
||||
languageForBlobPair :: BlobPair -> Maybe Language
|
||||
languageForBlobPair :: BlobPair -> Language
|
||||
languageForBlobPair (Join (This Blob{..})) = blobLanguage
|
||||
languageForBlobPair (Join (That Blob{..})) = blobLanguage
|
||||
languageForBlobPair (Join (These _ Blob{..})) = blobLanguage
|
||||
languageForBlobPair (Join (These a b))
|
||||
| blobLanguage a == Unknown || blobLanguage b == Unknown
|
||||
= Unknown
|
||||
| otherwise
|
||||
= blobLanguage b
|
||||
|
||||
pathForBlobPair :: BlobPair -> FilePath
|
||||
pathForBlobPair (Join (This Blob{..})) = blobPath
|
||||
@ -62,7 +65,7 @@ pathForBlobPair (Join (That Blob{..})) = blobPath
|
||||
pathForBlobPair (Join (These _ Blob{..})) = blobPath
|
||||
|
||||
languageTagForBlobPair :: BlobPair -> [(String, String)]
|
||||
languageTagForBlobPair pair = maybe [] showLanguage (languageForBlobPair pair)
|
||||
languageTagForBlobPair pair = showLanguage (languageForBlobPair pair)
|
||||
where showLanguage = pure . (,) "language" . show
|
||||
|
||||
pathKeyForBlobPair :: BlobPair -> FilePath
|
||||
|
@ -1,13 +1,16 @@
|
||||
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveAnyClass, DeriveGeneric, LambdaCase #-}
|
||||
module Data.Language where
|
||||
|
||||
import Prologue
|
||||
import Data.Aeson
|
||||
import Prologue
|
||||
import Proto3.Suite
|
||||
|
||||
-- | A programming language.
|
||||
-- | The various languages we support.
|
||||
-- Please do not reorder any of the field names: the current implementation of 'Primitive'
|
||||
-- delegates to the auto-generated 'Enum' instance.
|
||||
data Language
|
||||
= Go
|
||||
= Unknown
|
||||
| Go
|
||||
| Haskell
|
||||
| Java
|
||||
| JavaScript
|
||||
@ -18,33 +21,54 @@ data Language
|
||||
| Ruby
|
||||
| TypeScript
|
||||
| PHP
|
||||
deriving (Eq, Generic, Ord, Read, Show, ToJSON, Named, Enum, Finite, Message)
|
||||
deriving (Eq, Generic, Ord, Read, Show, Bounded, ToJSON, Named, Enum, Finite, MessageField)
|
||||
|
||||
-- | Predicate failing on 'Unknown' and passing in all other cases.
|
||||
knownLanguage :: Language -> Bool
|
||||
knownLanguage = (/= Unknown)
|
||||
|
||||
-- | Returns 'Nothing' when passed 'Unknown'.
|
||||
ensureLanguage :: Language -> Maybe Language
|
||||
ensureLanguage Unknown = Nothing
|
||||
ensureLanguage x = Just x
|
||||
|
||||
-- | Defaults to 'Unknown'.
|
||||
instance HasDefault Language where def = Unknown
|
||||
|
||||
-- | Piggybacks on top of the 'Enumerated' instance, as the generated code would.
|
||||
-- This instance will get easier when we have DerivingVia.
|
||||
instance Primitive Language where
|
||||
primType _ = primType (Proxy @(Enumerated Language))
|
||||
encodePrimitive f = encodePrimitive f . Enumerated . Right
|
||||
decodePrimitive = decodePrimitive >>= \case
|
||||
(Enumerated (Right r)) -> pure r
|
||||
other -> Prelude.fail ("Language decodeMessageField: unexpected value" <> show other)
|
||||
|
||||
-- | Returns a Language based on the file extension (including the ".").
|
||||
languageForType :: String -> Maybe Language
|
||||
languageForType :: String -> Language
|
||||
languageForType mediaType = case mediaType of
|
||||
".java" -> Just Java
|
||||
".json" -> Just JSON
|
||||
".hs" -> Just Haskell
|
||||
".md" -> Just Markdown
|
||||
".rb" -> Just Ruby
|
||||
".go" -> Just Go
|
||||
".js" -> Just JavaScript
|
||||
".ts" -> Just TypeScript
|
||||
".tsx" -> Just TypeScript
|
||||
".jsx" -> Just JSX
|
||||
".py" -> Just Python
|
||||
".php" -> Just PHP
|
||||
".phpt" -> Just PHP
|
||||
_ -> Nothing
|
||||
".java" -> Java
|
||||
".json" -> JSON
|
||||
".hs" -> Haskell
|
||||
".md" -> Markdown
|
||||
".rb" -> Ruby
|
||||
".go" -> Go
|
||||
".js" -> JavaScript
|
||||
".ts" -> TypeScript
|
||||
".tsx" -> TypeScript
|
||||
".jsx" -> JSX
|
||||
".py" -> Python
|
||||
".php" -> PHP
|
||||
".phpt" -> PHP
|
||||
_ -> Unknown
|
||||
|
||||
extensionsForLanguage :: Language -> [String]
|
||||
extensionsForLanguage language = case language of
|
||||
Go -> [".go"]
|
||||
Haskell -> [".hs"]
|
||||
Go -> [".go"]
|
||||
Haskell -> [".hs"]
|
||||
JavaScript -> [".js"]
|
||||
PHP -> [".php"]
|
||||
Python -> [".py"]
|
||||
Ruby -> [".rb"]
|
||||
PHP -> [".php"]
|
||||
Python -> [".py"]
|
||||
Ruby -> [".rb"]
|
||||
TypeScript -> [".ts", ".tsx", ".d.tsx"]
|
||||
_ -> []
|
||||
_ -> []
|
||||
|
@ -23,9 +23,8 @@ projectExtensions = extensionsForLanguage . projectLanguage
|
||||
|
||||
data File = File
|
||||
{ filePath :: FilePath
|
||||
, fileLanguage :: Maybe Language
|
||||
}
|
||||
deriving (Eq, Ord, Show)
|
||||
, fileLanguage :: Language
|
||||
} deriving (Eq, Ord, Show)
|
||||
|
||||
file :: FilePath -> File
|
||||
file path = File path (languageForFilePath path)
|
||||
|
@ -182,7 +182,7 @@ instance Evaluatable Decorator
|
||||
|
||||
|
||||
-- | An ADT, i.e. a disjoint sum of products, like 'data' in Haskell, or 'enum' in Rust or Swift.
|
||||
data Datatype a = Datatype { datatypeName :: !a, datatypeConstructors :: ![a] }
|
||||
data Datatype a = Datatype { datatypeContext :: a, datatypeName :: a, datatypeConstructors :: [a], datatypeDeriving :: a }
|
||||
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1)
|
||||
|
||||
instance Eq1 Data.Syntax.Declaration.Datatype where liftEq = genericLiftEq
|
||||
|
@ -33,7 +33,10 @@ type Syntax = '[
|
||||
, Literal.Float
|
||||
, Literal.Integer
|
||||
, Literal.TextElement
|
||||
, Syntax.Class
|
||||
, Syntax.Context
|
||||
, Syntax.Context'
|
||||
, Syntax.Deriving
|
||||
, Syntax.Empty
|
||||
, Syntax.Error
|
||||
, Syntax.Field
|
||||
@ -77,7 +80,9 @@ expressionChoices = [
|
||||
algebraicDatatypeDeclaration
|
||||
, character
|
||||
, comment
|
||||
, context'
|
||||
, constructorIdentifier
|
||||
, derivingClause
|
||||
, float
|
||||
, functionConstructor
|
||||
, functionDeclaration
|
||||
@ -105,9 +110,11 @@ algebraicDatatypeDeclaration :: Assignment
|
||||
algebraicDatatypeDeclaration = makeTerm
|
||||
<$> symbol AlgebraicDatatypeDeclaration
|
||||
<*> children (Declaration.Datatype
|
||||
<$> (makeTerm <$> location <*> (Syntax.Type <$> typeConstructor <*> typeParameters))
|
||||
<$> (context' <|> emptyTerm)
|
||||
<*> (makeTerm <$> location <*> (Syntax.Type <$> typeConstructor <*> typeParameters))
|
||||
<*> ((symbol Constructors *> children (many constructor))
|
||||
<|> pure []))
|
||||
<|> pure [])
|
||||
<*> (derivingClause <|> emptyTerm))
|
||||
|
||||
comment :: Assignment
|
||||
comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
|
||||
@ -116,6 +123,18 @@ constructor :: Assignment
|
||||
constructor = (makeTerm <$> symbol DataConstructor <*> children (Declaration.Constructor <$> typeConstructor <*> typeParameters))
|
||||
<|> (makeTerm <$> symbol RecordDataConstructor <*> children (Syntax.RecordDataConstructor <$> constructorIdentifier <*> fields))
|
||||
|
||||
class' :: Assignment
|
||||
class' = makeTerm <$> symbol Class <*> children (Syntax.Class <$> typeConstructor <*> typeParameters)
|
||||
|
||||
context' :: Assignment
|
||||
context' = makeTerm <$> symbol Context <*> children (Syntax.Context' <$> many (type' <|> contextPattern))
|
||||
|
||||
contextPattern :: Assignment
|
||||
contextPattern = symbol ContextPattern *> children type'
|
||||
|
||||
derivingClause :: Assignment
|
||||
derivingClause = makeTerm <$> symbol Deriving <*> children (Syntax.Deriving <$> many typeConstructor)
|
||||
|
||||
fields :: Assignment
|
||||
fields = makeTerm <$> symbol Fields <*> children (many field)
|
||||
|
||||
@ -134,6 +153,9 @@ constructorIdentifier = makeTerm <$> symbol ConstructorIdentifier <*> (Syntax.Id
|
||||
moduleIdentifier :: Assignment
|
||||
moduleIdentifier = makeTerm <$> symbol ModuleIdentifier <*> (Syntax.Identifier . Name.name <$> source)
|
||||
|
||||
typeClassIdentifier :: Assignment
|
||||
typeClassIdentifier = makeTerm <$> symbol TypeClassIdentifier <*> (Syntax.Identifier . Name.name <$> source)
|
||||
|
||||
typeConstructorIdentifier :: Assignment
|
||||
typeConstructorIdentifier = makeTerm <$> symbol TypeConstructorIdentifier <*> (Syntax.Identifier . Name.name <$> source)
|
||||
|
||||
@ -177,6 +199,9 @@ listExpression = makeTerm <$> symbol ListExpression <*> children (Literal.Array
|
||||
listType :: Assignment
|
||||
listType = makeTerm <$> symbol ListType <*> children (Literal.Array <$> many type')
|
||||
|
||||
parenthesizedTypePattern :: Assignment
|
||||
parenthesizedTypePattern = symbol ParenthesizedTypePattern *> children typeParameters
|
||||
|
||||
strictType :: Assignment
|
||||
strictType = makeTerm' <$> symbol StrictType <*> children ((inject <$> (Syntax.StrictType <$> typeConstructor <*> typeParameters))
|
||||
<|> (inject <$> (Syntax.StrictTypeVariable <$> typeVariableIdentifier)))
|
||||
@ -189,8 +214,10 @@ tuplingConstructor = makeTerm <$> symbol TuplingConstructor <*> (tupleWithArity
|
||||
type' :: Assignment
|
||||
type' = (makeTerm <$> symbol Type <*> children (Syntax.Type <$> typeConstructor <*> typeParameters))
|
||||
<|> (makeTerm <$> symbol TypePattern <*> children (Syntax.Type <$> typeConstructor <*> typeParameters))
|
||||
<|> parenthesizedTypePattern
|
||||
<|> strictType
|
||||
<|> typeConstructor
|
||||
<|> class'
|
||||
|
||||
typeParameters :: Assignment
|
||||
typeParameters = makeTerm <$> location <*> (Type.TypeParameters <$> many expression)
|
||||
@ -205,13 +232,14 @@ string :: Assignment
|
||||
string = makeTerm <$> symbol String <*> (Literal.TextElement <$> source)
|
||||
|
||||
typeConstructor :: Assignment
|
||||
typeConstructor = typeConstructorIdentifier
|
||||
typeConstructor = constructorIdentifier
|
||||
<|> functionConstructor
|
||||
<|> listConstructor
|
||||
<|> listType
|
||||
<|> typeClassIdentifier
|
||||
<|> typeConstructorIdentifier
|
||||
<|> tuplingConstructor
|
||||
<|> unitConstructor
|
||||
<|> constructorIdentifier
|
||||
|
||||
typeSynonymDeclaration :: Assignment
|
||||
typeSynonymDeclaration = makeTerm
|
||||
|
@ -20,25 +20,21 @@ instance Show1 Module where liftShowsPrec = genericLiftShowsPrec
|
||||
instance Evaluatable Module
|
||||
|
||||
data StrictType a = StrictType { strictTypeIdentifier :: !a, strictTypeParameters :: !a }
|
||||
deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
|
||||
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1)
|
||||
|
||||
instance Eq1 StrictType where liftEq = genericLiftEq
|
||||
instance Ord1 StrictType where liftCompare = genericLiftCompare
|
||||
instance Show1 StrictType where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
instance ToJSONFields1 StrictType
|
||||
|
||||
instance Evaluatable StrictType
|
||||
|
||||
newtype StrictTypeVariable a = StrictTypeVariable { strictTypeVariableIdentifier :: a }
|
||||
deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
|
||||
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1)
|
||||
|
||||
instance Eq1 StrictTypeVariable where liftEq = genericLiftEq
|
||||
instance Ord1 StrictTypeVariable where liftCompare = genericLiftCompare
|
||||
instance Show1 StrictTypeVariable where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
instance ToJSONFields1 StrictTypeVariable
|
||||
|
||||
instance Evaluatable StrictTypeVariable
|
||||
|
||||
data Type a = Type { typeIdentifier :: !a, typeParameters :: !a }
|
||||
@ -59,7 +55,8 @@ instance Show1 TypeSynonym where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
instance Evaluatable TypeSynonym
|
||||
|
||||
data UnitConstructor a = UnitConstructor deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1)
|
||||
data UnitConstructor a = UnitConstructor
|
||||
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1)
|
||||
|
||||
instance Eq1 UnitConstructor where liftEq = genericLiftEq
|
||||
instance Ord1 UnitConstructor where liftCompare = genericLiftCompare
|
||||
@ -67,7 +64,8 @@ instance Show1 UnitConstructor where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
instance Evaluatable UnitConstructor
|
||||
|
||||
newtype TupleConstructor a = TupleConstructor { tupleConstructorArity :: Int } deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1)
|
||||
newtype TupleConstructor a = TupleConstructor { tupleConstructorArity :: Int }
|
||||
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1)
|
||||
|
||||
instance Eq1 TupleConstructor where liftEq = genericLiftEq
|
||||
instance Ord1 TupleConstructor where liftCompare = genericLiftCompare
|
||||
@ -75,7 +73,8 @@ instance Show1 TupleConstructor where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
instance Evaluatable TupleConstructor
|
||||
|
||||
data ListConstructor a = ListConstructor deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1)
|
||||
data ListConstructor a = ListConstructor
|
||||
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1)
|
||||
|
||||
instance Eq1 ListConstructor where liftEq = genericLiftEq
|
||||
instance Ord1 ListConstructor where liftCompare = genericLiftCompare
|
||||
@ -83,7 +82,8 @@ instance Show1 ListConstructor where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
instance Evaluatable ListConstructor
|
||||
|
||||
data FunctionConstructor a = FunctionConstructor deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1)
|
||||
data FunctionConstructor a = FunctionConstructor
|
||||
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1)
|
||||
|
||||
instance Eq1 FunctionConstructor where liftEq = genericLiftEq
|
||||
instance Ord1 FunctionConstructor where liftCompare = genericLiftCompare
|
||||
@ -91,32 +91,56 @@ instance Show1 FunctionConstructor where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
instance Evaluatable FunctionConstructor
|
||||
|
||||
data RecordDataConstructor a = RecordDataConstructor { recordDataConstructorName :: !a, recordDataConstructorFields :: !a } deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
|
||||
data RecordDataConstructor a = RecordDataConstructor { recordDataConstructorName :: !a, recordDataConstructorFields :: !a }
|
||||
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1)
|
||||
|
||||
instance Eq1 RecordDataConstructor where liftEq = genericLiftEq
|
||||
instance Ord1 RecordDataConstructor where liftCompare = genericLiftCompare
|
||||
instance Show1 RecordDataConstructor where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
instance ToJSONFields1 RecordDataConstructor
|
||||
|
||||
instance Evaluatable RecordDataConstructor
|
||||
|
||||
data Field a = Field { fieldName :: !a, fieldBody :: !a } deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
|
||||
data Field a = Field { fieldName :: !a, fieldBody :: !a }
|
||||
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1)
|
||||
|
||||
instance Eq1 Field where liftEq = genericLiftEq
|
||||
instance Ord1 Field where liftCompare = genericLiftCompare
|
||||
instance Show1 Field where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
instance ToJSONFields1 Field
|
||||
|
||||
instance Evaluatable Field
|
||||
|
||||
newtype Pragma a = Pragma Text deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
|
||||
newtype Pragma a = Pragma Text
|
||||
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1)
|
||||
|
||||
instance Eq1 Pragma where liftEq = genericLiftEq
|
||||
instance Ord1 Pragma where liftCompare = genericLiftCompare
|
||||
instance Show1 Pragma where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
instance ToJSONFields1 Pragma
|
||||
|
||||
instance Evaluatable Pragma
|
||||
|
||||
newtype Deriving a = Deriving [a]
|
||||
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1)
|
||||
|
||||
instance Eq1 Deriving where liftEq = genericLiftEq
|
||||
instance Ord1 Deriving where liftCompare = genericLiftCompare
|
||||
instance Show1 Deriving where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
instance Evaluatable Deriving
|
||||
|
||||
newtype Context' a = Context' [a]
|
||||
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1)
|
||||
|
||||
instance Eq1 Context' where liftEq = genericLiftEq
|
||||
instance Ord1 Context' where liftCompare = genericLiftCompare
|
||||
instance Show1 Context' where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
instance Evaluatable Context'
|
||||
|
||||
data Class a = Class { classType :: a, classTypeParameters :: a }
|
||||
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1)
|
||||
|
||||
instance Eq1 Class where liftEq = genericLiftEq
|
||||
instance Ord1 Class where liftCompare = genericLiftCompare
|
||||
instance Show1 Class where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
instance Evaluatable Class
|
||||
|
@ -82,11 +82,11 @@ someAnalysisParser :: ( ApplyAll' typeclasses Go.Syntax
|
||||
-> SomeAnalysisParser typeclasses (Record Location) -- ^ A 'SomeAnalysisParser abstracting the syntax type to be produced.
|
||||
someAnalysisParser _ Go = SomeAnalysisParser goParser Nothing
|
||||
someAnalysisParser _ Java = SomeAnalysisParser javaParser Nothing
|
||||
someAnalysisParser _ JavaScript = SomeAnalysisParser typescriptParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath TypeScript.Term))) (Just JavaScript))
|
||||
someAnalysisParser _ JavaScript = SomeAnalysisParser typescriptParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath TypeScript.Term))) JavaScript)
|
||||
someAnalysisParser _ Haskell = SomeAnalysisParser haskellParser Nothing
|
||||
someAnalysisParser _ PHP = SomeAnalysisParser phpParser Nothing
|
||||
someAnalysisParser _ Python = SomeAnalysisParser pythonParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Python.Term))) (Just Python))
|
||||
someAnalysisParser _ Ruby = SomeAnalysisParser rubyParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Ruby.Term))) (Just Ruby))
|
||||
someAnalysisParser _ Python = SomeAnalysisParser pythonParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Python.Term))) Python)
|
||||
someAnalysisParser _ Ruby = SomeAnalysisParser rubyParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Ruby.Term))) Ruby)
|
||||
someAnalysisParser _ TypeScript = SomeAnalysisParser typescriptParser Nothing
|
||||
someAnalysisParser _ l = error $ "Analysis not supported for: " <> show l
|
||||
|
||||
@ -126,18 +126,19 @@ someParser :: ( ApplyAll typeclasses (Sum Go.Syntax)
|
||||
, ApplyAll typeclasses (Sum PHP.Syntax)
|
||||
)
|
||||
=> Language -- ^ The 'Language' to select.
|
||||
-> Parser (SomeTerm typeclasses (Record Location)) -- ^ A 'SomeParser' abstracting the syntax type to be produced.
|
||||
someParser Go = SomeParser goParser
|
||||
someParser Java = SomeParser javaParser
|
||||
someParser JavaScript = SomeParser typescriptParser
|
||||
someParser JSON = SomeParser jsonParser
|
||||
someParser Haskell = SomeParser haskellParser
|
||||
someParser JSX = SomeParser typescriptParser
|
||||
someParser Markdown = SomeParser markdownParser
|
||||
someParser Python = SomeParser pythonParser
|
||||
someParser Ruby = SomeParser rubyParser
|
||||
someParser TypeScript = SomeParser typescriptParser
|
||||
someParser PHP = SomeParser phpParser
|
||||
-> Maybe (Parser (SomeTerm typeclasses (Record Location))) -- ^ A 'SomeParser' abstracting the syntax type to be produced.
|
||||
someParser Go = Just (SomeParser goParser)
|
||||
someParser Java = Just (SomeParser javaParser)
|
||||
someParser JavaScript = Just (SomeParser typescriptParser)
|
||||
someParser JSON = Just (SomeParser jsonParser)
|
||||
someParser Haskell = Just (SomeParser haskellParser)
|
||||
someParser JSX = Just (SomeParser typescriptParser)
|
||||
someParser Markdown = Just (SomeParser markdownParser)
|
||||
someParser Python = Just (SomeParser pythonParser)
|
||||
someParser Ruby = Just (SomeParser rubyParser)
|
||||
someParser TypeScript = Just (SomeParser typescriptParser)
|
||||
someParser PHP = Just (SomeParser phpParser)
|
||||
someParser Unknown = Nothing
|
||||
|
||||
|
||||
goParser :: Parser Go.Term
|
||||
@ -181,14 +182,16 @@ data SomeASTParser where
|
||||
=> Parser (AST [] grammar)
|
||||
-> SomeASTParser
|
||||
|
||||
someASTParser :: Language -> SomeASTParser
|
||||
someASTParser Go = SomeASTParser (ASTParser tree_sitter_go :: Parser (AST [] Go.Grammar))
|
||||
someASTParser Haskell = SomeASTParser (ASTParser tree_sitter_haskell :: Parser (AST [] Haskell.Grammar))
|
||||
someASTParser JavaScript = SomeASTParser (ASTParser tree_sitter_typescript :: Parser (AST [] TypeScript.Grammar))
|
||||
someASTParser JSON = SomeASTParser (ASTParser tree_sitter_json :: Parser (AST [] JSON.Grammar))
|
||||
someASTParser JSX = SomeASTParser (ASTParser tree_sitter_typescript :: Parser (AST [] TypeScript.Grammar))
|
||||
someASTParser Python = SomeASTParser (ASTParser tree_sitter_python :: Parser (AST [] Python.Grammar))
|
||||
someASTParser Ruby = SomeASTParser (ASTParser tree_sitter_ruby :: Parser (AST [] Ruby.Grammar))
|
||||
someASTParser TypeScript = SomeASTParser (ASTParser tree_sitter_typescript :: Parser (AST [] TypeScript.Grammar))
|
||||
someASTParser PHP = SomeASTParser (ASTParser tree_sitter_php :: Parser (AST [] PHP.Grammar))
|
||||
someASTParser l = error $ "Tree-Sitter AST parsing not supported for: " <> show l
|
||||
someASTParser :: Language -> Maybe SomeASTParser
|
||||
someASTParser Go = Just (SomeASTParser (ASTParser tree_sitter_go :: Parser (AST [] Go.Grammar)))
|
||||
someASTParser Haskell = Just (SomeASTParser (ASTParser tree_sitter_haskell :: Parser (AST [] Haskell.Grammar)))
|
||||
someASTParser Java = Just (SomeASTParser (ASTParser tree_sitter_java :: Parser (AST [] Java.Grammar)))
|
||||
someASTParser JavaScript = Just (SomeASTParser (ASTParser tree_sitter_typescript :: Parser (AST [] TypeScript.Grammar)))
|
||||
someASTParser JSON = Just (SomeASTParser (ASTParser tree_sitter_json :: Parser (AST [] JSON.Grammar)))
|
||||
someASTParser JSX = Just (SomeASTParser (ASTParser tree_sitter_typescript :: Parser (AST [] TypeScript.Grammar)))
|
||||
someASTParser Python = Just (SomeASTParser (ASTParser tree_sitter_python :: Parser (AST [] Python.Grammar)))
|
||||
someASTParser Ruby = Just (SomeASTParser (ASTParser tree_sitter_ruby :: Parser (AST [] Ruby.Grammar)))
|
||||
someASTParser TypeScript = Just (SomeASTParser (ASTParser tree_sitter_typescript :: Parser (AST [] TypeScript.Grammar)))
|
||||
someASTParser PHP = Just (SomeASTParser (ASTParser tree_sitter_php :: Parser (AST [] PHP.Grammar)))
|
||||
someASTParser Markdown = Nothing
|
||||
someASTParser Unknown = Nothing
|
||||
|
@ -9,6 +9,7 @@ import Analysis.Declaration
|
||||
import Analysis.PackageDef
|
||||
import Data.Aeson
|
||||
import Data.Blob
|
||||
import Data.Language (ensureLanguage)
|
||||
import Data.Record
|
||||
import Data.Span
|
||||
import Data.Term
|
||||
@ -44,7 +45,7 @@ renderToImports blob term = ImportSummary $ toMap (termToModule blob term)
|
||||
_ -> defaultModuleName
|
||||
|
||||
makeModule :: (HasField fields Span, HasField fields (Maybe Declaration)) => T.Text -> Blob -> [Record fields] -> Module
|
||||
makeModule name Blob{..} ds = Module name [T.pack blobPath] (T.pack . show <$> blobLanguage) (mapMaybe importSummary ds) (mapMaybe (declarationSummary name) ds) (mapMaybe referenceSummary ds)
|
||||
makeModule name Blob{..} ds = Module name [T.pack blobPath] (T.pack . show <$> ensureLanguage blobLanguage) (mapMaybe importSummary ds) (mapMaybe (declarationSummary name) ds) (mapMaybe referenceSummary ds)
|
||||
|
||||
|
||||
getPackageDef :: HasField fields (Maybe PackageDef) => Record fields -> Maybe PackageDef
|
||||
|
@ -10,6 +10,7 @@ import Prologue
|
||||
import Analysis.Declaration
|
||||
import Data.Aeson
|
||||
import Data.Blob
|
||||
import Data.Language (ensureLanguage)
|
||||
import Data.Record
|
||||
import Data.Span
|
||||
import Data.Term
|
||||
@ -34,7 +35,7 @@ renderToSymbols :: (HasField fields (Maybe Declaration), HasField fields Span, F
|
||||
renderToSymbols fields Blob{..} term = [toJSON (termToC fields blobPath term)]
|
||||
where
|
||||
termToC :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => SymbolFields -> FilePath -> Term f (Record fields) -> File
|
||||
termToC fields path = File (T.pack path) (T.pack . show <$> blobLanguage) . mapMaybe (symbolSummary fields path "unchanged") . termTableOfContentsBy declaration
|
||||
termToC fields path = File (T.pack path) (T.pack (show blobLanguage)) . mapMaybe (symbolSummary fields path "unchanged") . termTableOfContentsBy declaration
|
||||
|
||||
-- | Construct a 'Symbol' from a node annotation and a change type label.
|
||||
symbolSummary :: (HasField fields (Maybe Declaration), HasField fields Span) => SymbolFields -> FilePath -> T.Text -> Record fields -> Maybe Symbol
|
||||
@ -43,7 +44,7 @@ symbolSummary SymbolFields{..} path _ record = case getDeclaration record of
|
||||
Just declaration -> Just Symbol
|
||||
{ symbolName = when symbolFieldsName (declarationIdentifier declaration)
|
||||
, symbolPath = when symbolFieldsPath (T.pack path)
|
||||
, symbolLang = join (when symbolFieldsLang (T.pack . show <$> declarationLanguage declaration))
|
||||
, symbolLang = join (when symbolFieldsLang (T.pack . show <$> ensureLanguage (declarationLanguage declaration)))
|
||||
, symbolKind = when symbolFieldsKind (toCategoryName declaration)
|
||||
, symbolLine = when symbolFieldsLine (declarationText declaration)
|
||||
, symbolSpan = when symbolFieldsSpan (getField record)
|
||||
@ -52,7 +53,7 @@ symbolSummary SymbolFields{..} path _ record = case getDeclaration record of
|
||||
|
||||
data File = File
|
||||
{ filePath :: T.Text
|
||||
, fileLanguage :: Maybe T.Text
|
||||
, fileLanguage :: T.Text
|
||||
, fileSymbols :: [Symbol]
|
||||
} deriving (Generic, Eq, Show)
|
||||
|
||||
|
@ -54,7 +54,7 @@ data TOCSummary
|
||||
, summarySpan :: Span
|
||||
, summaryChangeType :: T.Text
|
||||
}
|
||||
| ErrorSummary { errorText :: T.Text, errorSpan :: Span, errorLanguage :: Maybe Language }
|
||||
| ErrorSummary { errorText :: T.Text, errorSpan :: Span, errorLanguage :: Language }
|
||||
deriving (Generic, Eq, Show)
|
||||
|
||||
instance ToJSON TOCSummary where
|
||||
@ -146,7 +146,7 @@ recordSummary changeText record = case getDeclaration record of
|
||||
Just declaration -> Just $ TOCSummary (toCategoryName declaration) (formatIdentifier declaration) (getField record) changeText
|
||||
Nothing -> Nothing
|
||||
where
|
||||
formatIdentifier (MethodDeclaration identifier _ (Just Language.Go) (Just receiver)) = "(" <> receiver <> ") " <> identifier
|
||||
formatIdentifier (MethodDeclaration identifier _ Language.Go (Just receiver)) = "(" <> receiver <> ") " <> identifier
|
||||
formatIdentifier (MethodDeclaration identifier _ _ (Just receiver)) = receiver <> "." <> identifier
|
||||
formatIdentifier declaration = declarationIdentifier declaration
|
||||
|
||||
|
@ -18,8 +18,7 @@ withSomeAST f (SomeAST ast) = f ast
|
||||
|
||||
astParseBlob :: (Member (Exc SomeException) effs, Member Task effs) => Blob -> Eff effs SomeAST
|
||||
astParseBlob blob@Blob{..}
|
||||
| Just (SomeASTParser parser) <- someASTParser <$> blobLanguage
|
||||
= SomeAST <$> parse parser blob
|
||||
| Just (SomeASTParser parser) <- someASTParser blobLanguage = SomeAST <$> parse parser blob
|
||||
| otherwise = noLanguageForBlob blobPath
|
||||
|
||||
|
||||
|
@ -8,6 +8,7 @@ module Semantic.CLI
|
||||
) where
|
||||
|
||||
import Data.Project
|
||||
import Data.Language (ensureLanguage)
|
||||
import Data.List (intercalate)
|
||||
import Data.List.Split (splitWhen)
|
||||
import Data.Version (showVersion)
|
||||
@ -98,15 +99,15 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar
|
||||
rootDir <- rootDirectoryOption
|
||||
excludeDirs <- excludeDirsOption
|
||||
File{..} <- argument filePathReader (metavar "DIR:LANGUAGE | FILE")
|
||||
pure $ Task.readProject rootDir filePath (fromJust fileLanguage) excludeDirs >>= Graph.runGraph graphType includePackages >>= serializer
|
||||
pure $ Task.readProject rootDir filePath fileLanguage excludeDirs >>= Graph.runGraph graphType includePackages >>= serializer
|
||||
|
||||
rootDirectoryOption = optional (strOption (long "root" <> help "Root directory of project. Optional, defaults to entry file/directory." <> metavar "DIR"))
|
||||
excludeDirsOption = many (strOption (long "exclude-dir" <> help "Exclude a directory (e.g. vendor)" <> metavar "DIR"))
|
||||
filePathReader = eitherReader parseFilePath
|
||||
parseFilePath arg = case splitWhen (== ':') arg of
|
||||
[a, b] | lang <- readMaybe b -> Right (File a lang)
|
||||
| lang <- readMaybe a -> Right (File b lang)
|
||||
[path] -> maybe (Left $ "Cannot identify language for path: " <> path) (Right . File path . Just) (languageForFilePath path)
|
||||
[a, b] | (Just lang) <- readMaybe b >>= ensureLanguage -> Right (File a lang)
|
||||
| (Just lang) <- readMaybe a >>= ensureLanguage -> Right (File b lang)
|
||||
[path] -> maybe (Left $ "Cannot identify language for path: " <> path) (Right . File path) (ensureLanguage (languageForFilePath path))
|
||||
args -> Left ("cannot parse `" <> join args <> "`\nexpecting FILE:LANGUAGE or just FILE")
|
||||
|
||||
optionsReader options = eitherReader $ \ str -> maybe (Left ("expected one of: " <> intercalate ", " (fmap fst options))) (Right . snd) (find ((== str) . fst) options)
|
||||
|
@ -54,6 +54,6 @@ withParsedBlobPair :: (Member (Distribute WrappedTask) effs, Member (Exc SomeExc
|
||||
-> BlobPair
|
||||
-> Eff effs (SomeTermPair '[ConstructorName, Diffable, Eq1, HasDeclaration, Hashable1, Show1, ToJSONFields1, Traversable] (Record fields))
|
||||
withParsedBlobPair decorate blobs
|
||||
| Just (SomeParser parser) <- someParser @'[ConstructorName, Diffable, Eq1, HasDeclaration, Hashable1, Show1, ToJSONFields1, Traversable] <$> languageForBlobPair blobs
|
||||
= SomeTermPair <$> distributeFor blobs (\ blob -> WrapTask (parse parser blob >>= decorate blob))
|
||||
| Just (SomeParser parser) <- someParser @'[ConstructorName, Diffable, Eq1, HasDeclaration, Hashable1, Show1, ToJSONFields1, Traversable] (languageForBlobPair blobs)
|
||||
= SomeTermPair <$> distributeFor blobs (\ blob -> WrapTask (parse parser blob >>= decorate blob))
|
||||
| otherwise = noLanguageForBlob (pathForBlobPair blobs)
|
||||
|
@ -77,7 +77,7 @@ isDirectory :: MonadIO m => FilePath -> m Bool
|
||||
isDirectory path = liftIO (doesDirectoryExist path)
|
||||
|
||||
-- | Return a language based on a FilePath's extension, or Nothing if extension is not found or not supported.
|
||||
languageForFilePath :: FilePath -> Maybe Language
|
||||
languageForFilePath :: FilePath -> Language
|
||||
languageForFilePath = languageForType . takeExtension
|
||||
|
||||
-- | Read JSON encoded blob pairs from a handle.
|
||||
@ -108,7 +108,7 @@ readProjectFromPaths maybeRoot path lang excludeDirs = do
|
||||
paths <- liftIO $ filterFun <$> findFilesInDir rootDir exts excludeDirs
|
||||
pure $ Project rootDir (toFile <$> paths) lang entryPoints excludeDirs
|
||||
where
|
||||
toFile path = File path (Just lang)
|
||||
toFile path = File path lang
|
||||
exts = extensionsForLanguage lang
|
||||
|
||||
-- Recursively find files in a directory.
|
||||
@ -138,7 +138,7 @@ findFilesInDir path exts excludeDirs = do
|
||||
readBlobsFromDir :: MonadIO m => FilePath -> m [Blob.Blob]
|
||||
readBlobsFromDir path = do
|
||||
paths <- liftIO (globDir1 (compile "[^vendor]**/*[.rb|.js|.tsx|.go|.py]") path)
|
||||
let paths' = catMaybes $ fmap (\p -> File p . Just <$> languageForFilePath p) paths
|
||||
let paths' = fmap (\p -> File p (languageForFilePath p)) paths
|
||||
blobs <- traverse readFile paths'
|
||||
pure (catMaybes blobs)
|
||||
|
||||
@ -153,7 +153,7 @@ toBlob :: Blob -> Blob.Blob
|
||||
toBlob Blob{..} = Blob.sourceBlob path language' (fromText content)
|
||||
where language' = case language of
|
||||
"" -> languageForFilePath path
|
||||
_ -> readMaybe language
|
||||
_ -> fromMaybe Unknown (readMaybe language)
|
||||
|
||||
|
||||
newtype BlobDiff = BlobDiff { blobs :: [BlobPair] }
|
||||
|
@ -30,4 +30,4 @@ withParsedBlobs :: (Member (Distribute WrappedTask) effs, Monoid output) => (for
|
||||
withParsedBlobs render = distributeFoldMap (\ blob -> WrapTask (parseSomeBlob blob >>= withSomeTerm (render blob)))
|
||||
|
||||
parseSomeBlob :: (Member (Exc SomeException) effs, Member Task effs) => Blob -> Eff effs (SomeTerm '[ConstructorName, Foldable, Functor, HasDeclaration, HasPackageDef, Show1, ToJSONFields1] (Record Location))
|
||||
parseSomeBlob blob@Blob{..} = maybe (noLanguageForBlob blobPath) (flip parse blob . someParser) blobLanguage
|
||||
parseSomeBlob blob@Blob{..} = maybe (noLanguageForBlob blobPath) (`parse` blob) (someParser blobLanguage)
|
||||
|
@ -227,7 +227,7 @@ runParser blob@Blob{..} parser = case parser of
|
||||
in length term `seq` pure term
|
||||
SomeParser parser -> SomeTerm <$> runParser blob parser
|
||||
where blobFields = ("path", blobPath) : languageTag
|
||||
languageTag = maybe [] (pure . (,) ("language" :: String) . show) blobLanguage
|
||||
languageTag = pure . (,) ("language" :: String) . show $ blobLanguage
|
||||
errors :: (Syntax.Error :< fs, Apply Foldable fs, Apply Functor fs) => Term (Sum fs) (Record Assignment.Location) -> [Error.Error String]
|
||||
errors = cata $ \ (In a syntax) -> case syntax of
|
||||
_ | Just err@Syntax.Error{} <- project syntax -> [Syntax.unError (getField a) err]
|
||||
|
@ -71,9 +71,9 @@ evalTypeScriptProject path = justEvaluating =<< evaluateProject typescriptParser
|
||||
|
||||
typecheckGoFile path = checking =<< evaluateProjectWithCaching goParser Language.Go Nothing path
|
||||
|
||||
rubyPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Ruby.Term))) (Just Language.Ruby)
|
||||
pythonPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Python.Term))) (Just Language.Python)
|
||||
javaScriptPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath TypeScript.Term))) (Just Language.JavaScript)
|
||||
rubyPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Ruby.Term))) Language.Ruby
|
||||
pythonPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Python.Term))) Language.Python
|
||||
javaScriptPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath TypeScript.Term))) Language.JavaScript
|
||||
|
||||
-- Evaluate a project, starting at a single entrypoint.
|
||||
evaluateProject parser lang prelude path = evaluatePackageWith id withTermSpans . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= parsePackage parser prelude)
|
||||
|
@ -274,7 +274,7 @@ instance Listable Declaration where
|
||||
tiers
|
||||
= cons4 MethodDeclaration
|
||||
\/ cons3 FunctionDeclaration
|
||||
\/ cons2 (\ a b -> ErrorDeclaration a b Nothing)
|
||||
\/ cons2 (\ a b -> ErrorDeclaration a b Language.Unknown)
|
||||
|
||||
instance Listable CyclomaticComplexity where
|
||||
tiers = cons1 CyclomaticComplexity
|
||||
|
@ -174,14 +174,14 @@ numTocSummaries diff = length $ filter isValidSummary (diffTOC diff)
|
||||
programWithChange :: Term' -> Diff'
|
||||
programWithChange body = merge (programInfo, programInfo) (inject [ function' ])
|
||||
where
|
||||
function' = merge (Just (FunctionDeclaration "foo" mempty Nothing) :. emptyInfo, Just (FunctionDeclaration "foo" mempty Nothing) :. emptyInfo) (inject (Declaration.Function [] name' [] (merge (Nothing :. emptyInfo, Nothing :. emptyInfo) (inject [ inserting body ]))))
|
||||
function' = merge (Just (FunctionDeclaration "foo" mempty Ruby) :. emptyInfo, Just (FunctionDeclaration "foo" mempty Ruby) :. emptyInfo) (inject (Declaration.Function [] name' [] (merge (Nothing :. emptyInfo, Nothing :. emptyInfo) (inject [ inserting body ]))))
|
||||
name' = let info = Nothing :. emptyInfo in merge (info, info) (inject (Syntax.Identifier (name "foo")))
|
||||
|
||||
-- Return a diff where term is inserted in the program, below a function found on both sides of the diff.
|
||||
programWithChangeOutsideFunction :: Term' -> Diff'
|
||||
programWithChangeOutsideFunction term = merge (programInfo, programInfo) (inject [ function', term' ])
|
||||
where
|
||||
function' = merge (Just (FunctionDeclaration "foo" mempty Nothing) :. emptyInfo, Just (FunctionDeclaration "foo" mempty Nothing) :. emptyInfo) (inject (Declaration.Function [] name' [] (merge (Nothing :. emptyInfo, Nothing :. emptyInfo) (inject []))))
|
||||
function' = merge (Just (FunctionDeclaration "foo" mempty Unknown) :. emptyInfo, Just (FunctionDeclaration "foo" mempty Unknown) :. emptyInfo) (inject (Declaration.Function [] name' [] (merge (Nothing :. emptyInfo, Nothing :. emptyInfo) (inject []))))
|
||||
name' = let info = Nothing :. emptyInfo in merge (info, info) (inject (Syntax.Identifier (name "foo")))
|
||||
term' = inserting term
|
||||
|
||||
@ -198,7 +198,7 @@ programOf :: Diff' -> Diff'
|
||||
programOf diff = merge (programInfo, programInfo) (inject [ diff ])
|
||||
|
||||
functionOf :: Text -> Term' -> Term'
|
||||
functionOf n body = termIn (Just (FunctionDeclaration n mempty Nothing) :. emptyInfo) (inject (Declaration.Function [] name' [] (termIn (Nothing :. emptyInfo) (inject [body]))))
|
||||
functionOf n body = termIn (Just (FunctionDeclaration n mempty Unknown) :. emptyInfo) (inject (Declaration.Function [] name' [] (termIn (Nothing :. emptyInfo) (inject [body]))))
|
||||
where
|
||||
name' = termIn (Nothing :. emptyInfo) (inject (Syntax.Identifier (name n)))
|
||||
|
||||
|
@ -39,9 +39,9 @@ parseFixtures =
|
||||
, (show (SymbolsTermRenderer defaultSymbolFields), runParse (SymbolsTermRenderer defaultSymbolFields), path'', prefix </> "parse-tree.symbols.json")
|
||||
, (show TagsTermRenderer, runParse TagsTermRenderer, path'', prefix </> "parse-tree.tags.json")
|
||||
]
|
||||
where path = [File "test/fixtures/ruby/corpus/and-or.A.rb" (Just Ruby)]
|
||||
path' = [File "test/fixtures/ruby/corpus/and-or.A.rb" (Just Ruby), File "test/fixtures/ruby/corpus/and-or.B.rb" (Just Ruby)]
|
||||
path'' = [File "test/fixtures/ruby/corpus/method-declaration.A.rb" (Just Ruby)]
|
||||
where path = [File "test/fixtures/ruby/corpus/and-or.A.rb" Ruby]
|
||||
path' = [File "test/fixtures/ruby/corpus/and-or.A.rb" Ruby, File "test/fixtures/ruby/corpus/and-or.B.rb" Ruby]
|
||||
path'' = [File "test/fixtures/ruby/corpus/method-declaration.A.rb" Ruby]
|
||||
prefix = "test/fixtures/cli"
|
||||
|
||||
diffFixtures :: [(String, [BlobPair] -> TaskEff Builder, [Both File], FilePath)]
|
||||
@ -50,5 +50,5 @@ diffFixtures =
|
||||
, (show SExpressionDiffRenderer, runDiff SExpressionDiffRenderer, pathMode, "test/fixtures/ruby/corpus/method-declaration.diffA-B.txt")
|
||||
, (show ToCDiffRenderer, runDiff ToCDiffRenderer, pathMode, prefix </> "diff-tree.toc.json")
|
||||
]
|
||||
where pathMode = [both (File "test/fixtures/ruby/corpus/method-declaration.A.rb" (Just Ruby)) (File "test/fixtures/ruby/corpus/method-declaration.B.rb" (Just Ruby))]
|
||||
where pathMode = [both (File "test/fixtures/ruby/corpus/method-declaration.A.rb" Ruby) (File "test/fixtures/ruby/corpus/method-declaration.B.rb" Ruby)]
|
||||
prefix = "test/fixtures/cli"
|
||||
|
@ -23,15 +23,15 @@ spec :: Spec
|
||||
spec = parallel $ do
|
||||
describe "readFile" $ do
|
||||
it "returns a blob for extant files" $ do
|
||||
Just blob <- readFile (File "semantic.cabal" Nothing)
|
||||
Just blob <- readFile (File "semantic.cabal" Unknown)
|
||||
blobPath blob `shouldBe` "semantic.cabal"
|
||||
|
||||
it "throws for absent files" $ do
|
||||
readFile (File "this file should not exist" Nothing) `shouldThrow` anyIOException
|
||||
readFile (File "this file should not exist" Unknown) `shouldThrow` anyIOException
|
||||
|
||||
describe "readBlobPairsFromHandle" $ do
|
||||
let a = sourceBlob "method.rb" (Just Ruby) "def foo; end"
|
||||
let b = sourceBlob "method.rb" (Just Ruby) "def bar(x); end"
|
||||
let a = sourceBlob "method.rb" Ruby "def foo; end"
|
||||
let b = sourceBlob "method.rb" Ruby "def bar(x); end"
|
||||
it "returns blobs for valid JSON encoded diff input" $ do
|
||||
blobs <- blobsFromFilePath "test/fixtures/cli/diff.json"
|
||||
blobs `shouldBe` [blobPairDiffing a b]
|
||||
@ -56,7 +56,7 @@ spec = parallel $ do
|
||||
it "returns blobs for unsupported language" $ do
|
||||
h <- openFileForReading "test/fixtures/cli/diff-unsupported-language.json"
|
||||
blobs <- readBlobPairsFromHandle h
|
||||
let b' = sourceBlob "test.kt" Nothing "fun main(args: Array<String>) {\nprintln(\"hi\")\n}\n"
|
||||
let b' = sourceBlob "test.kt" Unknown "fun main(args: Array<String>) {\nprintln(\"hi\")\n}\n"
|
||||
blobs `shouldBe` [blobPairInserting b']
|
||||
|
||||
it "detects language based on filepath for empty language" $ do
|
||||
@ -97,7 +97,7 @@ spec = parallel $ do
|
||||
it "returns blobs for valid JSON encoded parse input" $ do
|
||||
h <- openFileForReading "test/fixtures/cli/parse.json"
|
||||
blobs <- readBlobsFromHandle h
|
||||
let a = sourceBlob "method.rb" (Just Ruby) "def foo; end"
|
||||
let a = sourceBlob "method.rb" Ruby "def foo; end"
|
||||
blobs `shouldBe` [a]
|
||||
|
||||
it "throws on blank input" $ do
|
||||
|
@ -11,8 +11,8 @@ import SpecHelpers
|
||||
spec :: Spec
|
||||
spec = parallel $ do
|
||||
describe "parseBlob" $ do
|
||||
it "throws if not given a language" $ do
|
||||
runTask (runParse SExpressionTermRenderer [methodsBlob { blobLanguage = Nothing }]) `shouldThrow` (\ code -> case code of
|
||||
it "throws if given an unknown language" $ do
|
||||
runTask (runParse SExpressionTermRenderer [methodsBlob { blobLanguage = Unknown }]) `shouldThrow` (\ code -> case code of
|
||||
ExitFailure 1 -> True
|
||||
_ -> False)
|
||||
|
||||
@ -20,4 +20,4 @@ spec = parallel $ do
|
||||
output <- fmap runBuilder . runTask $ runParse SExpressionTermRenderer [methodsBlob]
|
||||
output `shouldBe` "(Statements\n (Method\n (Empty)\n (Identifier)\n (Statements)))\n"
|
||||
where
|
||||
methodsBlob = Blob "def foo\nend\n" "methods.rb" (Just Ruby)
|
||||
methodsBlob = Blob "def foo\nend\n" "methods.rb" Ruby
|
||||
|
@ -16,3 +16,10 @@ data N = N { a :: !Int, b :: Int }
|
||||
data N = N { a, b :: {-# UNPACK #-} !Int, c :: String }
|
||||
data N = N { a :: Int } | O { b :: String }
|
||||
data N = N { b :: Int } | O { c :: String }
|
||||
|
||||
data N = N deriving Show
|
||||
data N = N deriving (Eq, Ord, Enum, Bounded, Show, Read)
|
||||
|
||||
data Show a => N a = N a
|
||||
data (Eq a, Show a, Eq b) => N a b = N a b
|
||||
data (Eq (f a), Functor f) => N f a = N f a
|
||||
|
@ -16,3 +16,10 @@ data O = O { a :: !Int, b :: Int }
|
||||
data O = O { a, b :: {-# UNPACK #-} !Int, c :: String }
|
||||
data N = N { b :: Int } | O { c :: String }
|
||||
data N = N { b :: Text } | O { c :: Bool }
|
||||
|
||||
data N = N deriving Show
|
||||
data N = N deriving (Functor, Ord, Enum, Bounded, Show, Read)
|
||||
|
||||
data Monad a => N a = N a
|
||||
data (Ord a, Show a, Eq b) => N a b = N a b
|
||||
data (Eq (f a), Applicative f) => N f a = N f a
|
||||
|
@ -2,11 +2,14 @@
|
||||
(Empty)
|
||||
(Statements
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
(TypeParameters)))
|
||||
(TypeParameters))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
@ -16,8 +19,10 @@
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
(TypeParameters
|
||||
(Identifier))))
|
||||
(Identifier)))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
@ -28,8 +33,10 @@
|
||||
->(Identifier) }
|
||||
(TypeParameters
|
||||
(StrictTypeVariable
|
||||
(Identifier)))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
@ -42,8 +49,10 @@
|
||||
(TypeParameters
|
||||
(StrictTypeVariable
|
||||
(Identifier))
|
||||
(Identifier))))
|
||||
(Identifier)))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
@ -54,18 +63,20 @@
|
||||
{+(Constructor
|
||||
{+(Identifier)+}
|
||||
{+(TypeParameters)+})+}
|
||||
(Constructor
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
(TypeParameters))
|
||||
{+(Constructor
|
||||
{+(Identifier)+}
|
||||
{+(TypeParameters)+})+}
|
||||
{+(Constructor
|
||||
{+(Identifier)+}
|
||||
{+(TypeParameters)+})+}
|
||||
{+(Constructor
|
||||
{+(Identifier)+}
|
||||
{+(TypeParameters)+})+}
|
||||
{+(Constructor
|
||||
{+(Identifier)+}
|
||||
{+(TypeParameters)+})+}
|
||||
(Constructor
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
(TypeParameters))
|
||||
{-(Constructor
|
||||
{-(Identifier)-}
|
||||
{-(TypeParameters)-})-}
|
||||
@ -78,13 +89,9 @@
|
||||
{-(Constructor
|
||||
{-(Identifier)-}
|
||||
{-(TypeParameters)-})-}
|
||||
{-(Constructor
|
||||
{-(Identifier)-}
|
||||
{-(TypeParameters)-})-}
|
||||
{-(Constructor
|
||||
{-(Identifier)-}
|
||||
{-(TypeParameters)-})-})
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
@ -96,8 +103,10 @@
|
||||
(Field
|
||||
(Statements
|
||||
(Identifier))
|
||||
(Identifier)))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
@ -110,8 +119,10 @@
|
||||
(Statements
|
||||
(Identifier)
|
||||
(Identifier))
|
||||
(Identifier)))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
@ -129,8 +140,10 @@
|
||||
(Field
|
||||
(Statements
|
||||
(Identifier))
|
||||
(Identifier)))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
@ -151,8 +164,10 @@
|
||||
(Field
|
||||
(Statements
|
||||
(Identifier))
|
||||
(Identifier)))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
{-(Datatype
|
||||
{-(Empty)-}
|
||||
{-(Type
|
||||
{-(Identifier)-}
|
||||
{-(TypeParameters)-})-}
|
||||
@ -169,8 +184,10 @@
|
||||
{-(Field
|
||||
{-(Statements
|
||||
{-(Identifier)-})-}
|
||||
{-(Identifier)-})-})-})-})-}
|
||||
{-(Identifier)-})-})-})-}
|
||||
{-(Empty)-})-}
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
@ -187,8 +204,10 @@
|
||||
(Field
|
||||
(Statements
|
||||
(Identifier))
|
||||
(Identifier)))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
{+(Datatype
|
||||
{+(Empty)+}
|
||||
{+(Type
|
||||
{+(Identifier)+}
|
||||
{+(TypeParameters)+})+}
|
||||
@ -205,4 +224,97 @@
|
||||
{+(Field
|
||||
{+(Statements
|
||||
{+(Identifier)+})+}
|
||||
{+(Identifier)+})+})+})+})+}))
|
||||
{+(Identifier)+})+})+})+}
|
||||
{+(Empty)+})+}
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
(Constructor
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
(Deriving
|
||||
(Identifier)))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
(Constructor
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
(Deriving
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
(Identifier)
|
||||
(Identifier)
|
||||
(Identifier)
|
||||
(Identifier)
|
||||
(Identifier)))
|
||||
(Datatype
|
||||
(Context'
|
||||
(Class
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
(TypeParameters
|
||||
(Identifier))))
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)))
|
||||
(Constructor
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Context'
|
||||
(Class
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
(TypeParameters
|
||||
(Identifier)))
|
||||
(Class
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)))
|
||||
(Class
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier))))
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)
|
||||
(Identifier)))
|
||||
(Constructor
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)
|
||||
(Identifier)))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Context'
|
||||
(Class
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(TypeParameters
|
||||
(Identifier)
|
||||
(Identifier))))
|
||||
(Class
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
(TypeParameters
|
||||
(Identifier))))
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)
|
||||
(Identifier)))
|
||||
(Constructor
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)
|
||||
(Identifier)))
|
||||
(Empty))))
|
||||
|
@ -2,11 +2,14 @@
|
||||
(Empty)
|
||||
(Statements
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
(TypeParameters)))
|
||||
(TypeParameters))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
@ -16,8 +19,10 @@
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
(TypeParameters
|
||||
(Identifier))))
|
||||
(Identifier)))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
@ -28,8 +33,10 @@
|
||||
->(Identifier) }
|
||||
(TypeParameters
|
||||
(StrictTypeVariable
|
||||
(Identifier)))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
@ -42,8 +49,10 @@
|
||||
(TypeParameters
|
||||
(StrictTypeVariable
|
||||
(Identifier))
|
||||
(Identifier))))
|
||||
(Identifier)))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
@ -55,20 +64,19 @@
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
(TypeParameters))
|
||||
(Constructor
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
(TypeParameters))
|
||||
{+(Constructor
|
||||
{+(Identifier)+}
|
||||
{+(TypeParameters)+})+}
|
||||
{+(Constructor
|
||||
{+(Identifier)+}
|
||||
{+(TypeParameters)+})+}
|
||||
{+(Constructor
|
||||
{+(Identifier)+}
|
||||
{+(TypeParameters)+})+}
|
||||
(Constructor
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
(TypeParameters))
|
||||
(Constructor
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
(TypeParameters))
|
||||
{-(Constructor
|
||||
{-(Identifier)-}
|
||||
{-(TypeParameters)-})-}
|
||||
@ -77,8 +85,13 @@
|
||||
{-(TypeParameters)-})-}
|
||||
{-(Constructor
|
||||
{-(Identifier)-}
|
||||
{-(TypeParameters)-})-})
|
||||
{-(TypeParameters)-})-}
|
||||
{-(Constructor
|
||||
{-(Identifier)-}
|
||||
{-(TypeParameters)-})-}
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
@ -90,8 +103,10 @@
|
||||
(Field
|
||||
(Statements
|
||||
(Identifier))
|
||||
(Identifier)))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
@ -104,8 +119,10 @@
|
||||
(Statements
|
||||
(Identifier)
|
||||
(Identifier))
|
||||
(Identifier)))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
@ -123,8 +140,10 @@
|
||||
(Field
|
||||
(Statements
|
||||
(Identifier))
|
||||
(Identifier)))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
@ -145,8 +164,10 @@
|
||||
(Field
|
||||
(Statements
|
||||
(Identifier))
|
||||
(Identifier)))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
{+(Datatype
|
||||
{+(Empty)+}
|
||||
{+(Type
|
||||
{+(Identifier)+}
|
||||
{+(TypeParameters)+})+}
|
||||
@ -163,8 +184,10 @@
|
||||
{+(Field
|
||||
{+(Statements
|
||||
{+(Identifier)+})+}
|
||||
{+(Identifier)+})+})+})+})+}
|
||||
{+(Identifier)+})+})+})+}
|
||||
{+(Empty)+})+}
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
@ -181,8 +204,10 @@
|
||||
(Field
|
||||
(Statements
|
||||
(Identifier))
|
||||
(Identifier)))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
{-(Datatype
|
||||
{-(Empty)-}
|
||||
{-(Type
|
||||
{-(Identifier)-}
|
||||
{-(TypeParameters)-})-}
|
||||
@ -199,4 +224,97 @@
|
||||
{-(Field
|
||||
{-(Statements
|
||||
{-(Identifier)-})-}
|
||||
{-(Identifier)-})-})-})-})-}))
|
||||
{-(Identifier)-})-})-})-}
|
||||
{-(Empty)-})-}
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
(Constructor
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
(Deriving
|
||||
(Identifier)))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
(Constructor
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
(Deriving
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
(Identifier)
|
||||
(Identifier)
|
||||
(Identifier)
|
||||
(Identifier)
|
||||
(Identifier)))
|
||||
(Datatype
|
||||
(Context'
|
||||
(Class
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
(TypeParameters
|
||||
(Identifier))))
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)))
|
||||
(Constructor
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Context'
|
||||
(Class
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
(TypeParameters
|
||||
(Identifier)))
|
||||
(Class
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)))
|
||||
(Class
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier))))
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)
|
||||
(Identifier)))
|
||||
(Constructor
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)
|
||||
(Identifier)))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Context'
|
||||
(Class
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(TypeParameters
|
||||
(Identifier)
|
||||
(Identifier))))
|
||||
(Class
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
(TypeParameters
|
||||
(Identifier))))
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)
|
||||
(Identifier)))
|
||||
(Constructor
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)
|
||||
(Identifier)))
|
||||
(Empty))))
|
||||
|
@ -2,10 +2,13 @@
|
||||
(Empty)
|
||||
(Statements
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters)))
|
||||
(TypeParameters))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
@ -13,8 +16,10 @@
|
||||
(Constructor
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier))))
|
||||
(Identifier)))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
@ -23,8 +28,10 @@
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(StrictTypeVariable
|
||||
(Identifier)))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
@ -35,8 +42,10 @@
|
||||
(TypeParameters
|
||||
(StrictTypeVariable
|
||||
(Identifier))
|
||||
(Identifier))))
|
||||
(Identifier)))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
@ -57,8 +66,10 @@
|
||||
(TypeParameters))
|
||||
(Constructor
|
||||
(Identifier)
|
||||
(TypeParameters)))
|
||||
(TypeParameters))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
@ -68,8 +79,10 @@
|
||||
(Field
|
||||
(Statements
|
||||
(Identifier))
|
||||
(Identifier)))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
@ -80,8 +93,10 @@
|
||||
(Statements
|
||||
(Identifier)
|
||||
(Identifier))
|
||||
(Identifier)))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
@ -97,8 +112,10 @@
|
||||
(Field
|
||||
(Statements
|
||||
(Identifier))
|
||||
(Identifier)))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
@ -117,8 +134,10 @@
|
||||
(Field
|
||||
(Statements
|
||||
(Identifier))
|
||||
(Identifier)))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
@ -135,8 +154,10 @@
|
||||
(Field
|
||||
(Statements
|
||||
(Identifier))
|
||||
(Identifier)))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
@ -153,4 +174,93 @@
|
||||
(Field
|
||||
(Statements
|
||||
(Identifier))
|
||||
(Identifier)))))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
(Constructor
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
(Deriving
|
||||
(Identifier)))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
(Constructor
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
(Deriving
|
||||
(Identifier)
|
||||
(Identifier)
|
||||
(Identifier)
|
||||
(Identifier)
|
||||
(Identifier)
|
||||
(Identifier)))
|
||||
(Datatype
|
||||
(Context'
|
||||
(Class
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier))))
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)))
|
||||
(Constructor
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Context'
|
||||
(Class
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)))
|
||||
(Class
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)))
|
||||
(Class
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier))))
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)
|
||||
(Identifier)))
|
||||
(Constructor
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)
|
||||
(Identifier)))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Context'
|
||||
(Class
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(TypeParameters
|
||||
(Identifier)
|
||||
(Identifier))))
|
||||
(Class
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier))))
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)
|
||||
(Identifier)))
|
||||
(Constructor
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)
|
||||
(Identifier)))
|
||||
(Empty))))
|
||||
|
@ -2,10 +2,13 @@
|
||||
(Empty)
|
||||
(Statements
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters)))
|
||||
(TypeParameters))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
@ -13,8 +16,10 @@
|
||||
(Constructor
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier))))
|
||||
(Identifier)))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
@ -23,8 +28,10 @@
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(StrictTypeVariable
|
||||
(Identifier)))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
@ -35,8 +42,10 @@
|
||||
(TypeParameters
|
||||
(StrictTypeVariable
|
||||
(Identifier))
|
||||
(Identifier))))
|
||||
(Identifier)))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
@ -57,8 +66,10 @@
|
||||
(TypeParameters))
|
||||
(Constructor
|
||||
(Identifier)
|
||||
(TypeParameters)))
|
||||
(TypeParameters))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
@ -68,8 +79,10 @@
|
||||
(Field
|
||||
(Statements
|
||||
(Identifier))
|
||||
(Identifier)))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
@ -80,8 +93,10 @@
|
||||
(Statements
|
||||
(Identifier)
|
||||
(Identifier))
|
||||
(Identifier)))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
@ -97,8 +112,10 @@
|
||||
(Field
|
||||
(Statements
|
||||
(Identifier))
|
||||
(Identifier)))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
@ -117,8 +134,10 @@
|
||||
(Field
|
||||
(Statements
|
||||
(Identifier))
|
||||
(Identifier)))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
@ -135,8 +154,10 @@
|
||||
(Field
|
||||
(Statements
|
||||
(Identifier))
|
||||
(Identifier)))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
@ -153,4 +174,93 @@
|
||||
(Field
|
||||
(Statements
|
||||
(Identifier))
|
||||
(Identifier)))))))
|
||||
(Identifier))))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
(Constructor
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
(Deriving
|
||||
(Identifier)))
|
||||
(Datatype
|
||||
(Empty)
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
(Constructor
|
||||
(Identifier)
|
||||
(TypeParameters))
|
||||
(Deriving
|
||||
(Identifier)
|
||||
(Identifier)
|
||||
(Identifier)
|
||||
(Identifier)
|
||||
(Identifier)
|
||||
(Identifier)))
|
||||
(Datatype
|
||||
(Context'
|
||||
(Class
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier))))
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)))
|
||||
(Constructor
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Context'
|
||||
(Class
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)))
|
||||
(Class
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)))
|
||||
(Class
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier))))
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)
|
||||
(Identifier)))
|
||||
(Constructor
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)
|
||||
(Identifier)))
|
||||
(Empty))
|
||||
(Datatype
|
||||
(Context'
|
||||
(Class
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(TypeParameters
|
||||
(Identifier)
|
||||
(Identifier))))
|
||||
(Class
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier))))
|
||||
(Type
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)
|
||||
(Identifier)))
|
||||
(Constructor
|
||||
(Identifier)
|
||||
(TypeParameters
|
||||
(Identifier)
|
||||
(Identifier)))
|
||||
(Empty))))
|
||||
|
@ -1,11 +1,10 @@
|
||||
(Module
|
||||
(Identifier)
|
||||
(Statements
|
||||
(Function
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
(Statements
|
||||
(Integer)))
|
||||
{+(Function
|
||||
{+(Identifier)+}
|
||||
{+(Statements
|
||||
{+(Integer)+})+})+}
|
||||
{+(Function
|
||||
{+(Identifier)+}
|
||||
{+(Statements
|
||||
@ -284,6 +283,10 @@
|
||||
{-(Identifier)-}
|
||||
{-(Statements
|
||||
{-(Integer)-})-})-}
|
||||
{-(Function
|
||||
{-(Identifier)-}
|
||||
{-(Statements
|
||||
{-(Integer)-})-})-}
|
||||
{-(Function
|
||||
{-(Identifier)-}
|
||||
{-(Statements
|
||||
|
@ -1,11 +1,10 @@
|
||||
(Module
|
||||
(Identifier)
|
||||
(Statements
|
||||
(Function
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
(Statements
|
||||
(Integer)))
|
||||
{+(Function
|
||||
{+(Identifier)+}
|
||||
{+(Statements
|
||||
{+(Integer)+})+})+}
|
||||
{+(Function
|
||||
{+(Identifier)+}
|
||||
{+(Statements
|
||||
@ -54,12 +53,10 @@
|
||||
{+(Identifier)+}
|
||||
{+(Statements
|
||||
{+(Float)+})+})+}
|
||||
(Function
|
||||
{ (Identifier)
|
||||
->(Identifier) }
|
||||
(Statements
|
||||
{+(Float)+}
|
||||
{-(Integer)-}))
|
||||
{+(Function
|
||||
{+(Identifier)+}
|
||||
{+(Statements
|
||||
{+(Float)+})+})+}
|
||||
{+(Function
|
||||
{+(Identifier)+}
|
||||
{+(Statements
|
||||
@ -282,6 +279,14 @@
|
||||
{-(Identifier)-}
|
||||
{-(Statements
|
||||
{-(Integer)-})-})-}
|
||||
{-(Function
|
||||
{-(Identifier)-}
|
||||
{-(Statements
|
||||
{-(Integer)-})-})-}
|
||||
{-(Function
|
||||
{-(Identifier)-}
|
||||
{-(Statements
|
||||
{-(Integer)-})-})-}
|
||||
{-(Function
|
||||
{-(Identifier)-}
|
||||
{-(Statements
|
||||
|
22
types.proto
22
types.proto
@ -1,15 +1,17 @@
|
||||
syntax = "proto3";
|
||||
package semantic;
|
||||
enum Language {Go = 0;
|
||||
Haskell = 1;
|
||||
JavaScript = 2;
|
||||
JSON = 3;
|
||||
JSX = 4;
|
||||
Markdown = 5;
|
||||
Python = 6;
|
||||
Ruby = 7;
|
||||
TypeScript = 8;
|
||||
PHP = 9;}
|
||||
enum Language {Unknown = 0;
|
||||
Go = 1;
|
||||
Haskell = 2;
|
||||
Java = 3;
|
||||
JavaScript = 4;
|
||||
JSON = 5;
|
||||
JSX = 6;
|
||||
Markdown = 7;
|
||||
Python = 8;
|
||||
Ruby = 9;
|
||||
TypeScript = 10;
|
||||
PHP = 11;}
|
||||
message Blob { bytes blobSource = 1;
|
||||
string blobPath = 2;
|
||||
Language blobLanguage = 3;
|
||||
|
Loading…
Reference in New Issue
Block a user