github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-27 00:44:57 +03:00
Code Issues Projects Releases Wiki Activity

tighten up some Maybes now that Unknown is a thing

Browse Source
This commit is contained in:
Patrick Thomson 2018-06-04 18:17:02 -04:00
parent 16066c1f7d
commit 6abb7b9a2a
4 changed files with 28 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
src/Parsing/Parser.hs
View File

@ -126,19 +126,19 @@ someParser :: ( ApplyAll typeclasses (Sum Go.Syntax)
, ApplyAll typeclasses (Sum PHP.Syntax) , ApplyAll typeclasses (Sum PHP.Syntax)
) )
=> Language   -- ^ The 'Language' to select. => Language   -- ^ The 'Language' to select.
-> Parser (SomeTerm typeclasses (Record Location)) -- ^ A 'SomeParser' abstracting the syntax type to be produced. -> Maybe (Parser (SomeTerm typeclasses (Record Location))) -- ^ A 'SomeParser' abstracting the syntax type to be produced.
someParser Go = SomeParser goParser someParser Go = Just (SomeParser goParser)
someParser Java = SomeParser javaParser someParser Java = Just (SomeParser javaParser)
someParser JavaScript = SomeParser typescriptParser someParser JavaScript = Just (SomeParser typescriptParser)
someParser JSON = SomeParser jsonParser someParser JSON = Just (SomeParser jsonParser)
someParser Haskell = SomeParser haskellParser someParser Haskell = Just (SomeParser haskellParser)
someParser JSX = SomeParser typescriptParser someParser JSX = Just (SomeParser typescriptParser)
someParser Markdown = SomeParser markdownParser someParser Markdown = Just (SomeParser markdownParser)
someParser Python = SomeParser pythonParser someParser Python = Just (SomeParser pythonParser)
someParser Ruby = SomeParser rubyParser someParser Ruby = Just (SomeParser rubyParser)
someParser TypeScript = SomeParser typescriptParser someParser TypeScript = Just (SomeParser typescriptParser)
someParser PHP = SomeParser phpParser someParser PHP = Just (SomeParser phpParser)
someParser Unknown = error "No parser suitable for an unknown language." someParser Unknown = Nothing
goParser :: Parser Go.Term goParser :: Parser Go.Term
@ -182,14 +182,14 @@ data SomeASTParser where
=> Parser (AST [] grammar) => Parser (AST [] grammar)
-> SomeASTParser -> SomeASTParser
someASTParser :: Language -> SomeASTParser someASTParser :: Language -> Maybe SomeASTParser
someASTParser Go = SomeASTParser (ASTParser tree_sitter_go :: Parser (AST [] Go.Grammar)) someASTParser Go = Just (SomeASTParser (ASTParser tree_sitter_go :: Parser (AST [] Go.Grammar)))
someASTParser Haskell = SomeASTParser (ASTParser tree_sitter_haskell :: Parser (AST [] Haskell.Grammar)) someASTParser Haskell = Just (SomeASTParser (ASTParser tree_sitter_haskell :: Parser (AST [] Haskell.Grammar)))
someASTParser JavaScript = SomeASTParser (ASTParser tree_sitter_typescript :: Parser (AST [] TypeScript.Grammar)) someASTParser JavaScript = Just (SomeASTParser (ASTParser tree_sitter_typescript :: Parser (AST [] TypeScript.Grammar)))
someASTParser JSON = SomeASTParser (ASTParser tree_sitter_json :: Parser (AST [] JSON.Grammar)) someASTParser JSON = Just (SomeASTParser (ASTParser tree_sitter_json :: Parser (AST [] JSON.Grammar)))
someASTParser JSX = SomeASTParser (ASTParser tree_sitter_typescript :: Parser (AST [] TypeScript.Grammar)) someASTParser JSX = Just (SomeASTParser (ASTParser tree_sitter_typescript :: Parser (AST [] TypeScript.Grammar)))
someASTParser Python = SomeASTParser (ASTParser tree_sitter_python :: Parser (AST [] Python.Grammar)) someASTParser Python = Just (SomeASTParser (ASTParser tree_sitter_python :: Parser (AST [] Python.Grammar)))
someASTParser Ruby = SomeASTParser (ASTParser tree_sitter_ruby :: Parser (AST [] Ruby.Grammar)) someASTParser Ruby = Just (SomeASTParser (ASTParser tree_sitter_ruby :: Parser (AST [] Ruby.Grammar)))
someASTParser TypeScript = SomeASTParser (ASTParser tree_sitter_typescript :: Parser (AST [] TypeScript.Grammar)) someASTParser TypeScript = Just (SomeASTParser (ASTParser tree_sitter_typescript :: Parser (AST [] TypeScript.Grammar)))
someASTParser PHP = SomeASTParser (ASTParser tree_sitter_php :: Parser (AST [] PHP.Grammar)) someASTParser PHP = Just (SomeASTParser (ASTParser tree_sitter_php :: Parser (AST [] PHP.Grammar)))
someASTParser l = error $ "Tree-Sitter AST parsing not supported for: " <> show l someASTParser l = Nothing

3
src/Semantic/AST.hs
View File

@ -18,8 +18,7 @@ withSomeAST f (SomeAST ast) = f ast
astParseBlob :: (Member (Exc SomeException) effs, Member Task effs) => Blob -> Eff effs SomeAST astParseBlob :: (Member (Exc SomeException) effs, Member Task effs) => Blob -> Eff effs SomeAST
astParseBlob blob@Blob{..} astParseBlob blob@Blob{..}
| Just (SomeASTParser parser) <- someASTParser <$> (Just blobLanguage) | Just (SomeASTParser parser) <- someASTParser blobLanguage = SomeAST <$> parse parser blob
= SomeAST <$> parse parser blob
| otherwise = noLanguageForBlob blobPath | otherwise = noLanguageForBlob blobPath

4
src/Semantic/Diff.hs
View File

@ -54,6 +54,6 @@ withParsedBlobPair :: (Member (Distribute WrappedTask) effs, Member (Exc SomeExc
-> BlobPair -> BlobPair
-> Eff effs (SomeTermPair '[ConstructorName, Diffable, Eq1, HasDeclaration, Hashable1, Show1, ToJSONFields1, Traversable] (Record fields)) -> Eff effs (SomeTermPair '[ConstructorName, Diffable, Eq1, HasDeclaration, Hashable1, Show1, ToJSONFields1, Traversable] (Record fields))
withParsedBlobPair decorate blobs withParsedBlobPair decorate blobs
| Just (SomeParser parser) <- someParser @'[ConstructorName, Diffable, Eq1, HasDeclaration, Hashable1, Show1, ToJSONFields1, Traversable] <$> (Just (languageForBlobPair 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)) = SomeTermPair <$> distributeFor blobs (\ blob -> WrapTask (parse parser blob >>= decorate blob))
| otherwise = noLanguageForBlob (pathForBlobPair blobs) | otherwise = noLanguageForBlob (pathForBlobPair blobs)

2
src/Semantic/Parse.hs
View File

@ -31,4 +31,4 @@ withParsedBlobs :: (Member (Distribute WrappedTask) effs, Monoid output) => (for
withParsedBlobs render = distributeFoldMap (\ blob -> WrapTask (parseSomeBlob blob >>= withSomeTerm (render blob))) 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 :: (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) (ensureLanguage blobLanguage) parseSomeBlob blob@Blob{..} = maybe (noLanguageForBlob blobPath) (flip parse blob) (someParser blobLanguage)