github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-26 08:25:19 +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)
)
=> 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
someParser Unknown = error "No parser suitable for an unknown language."
-> 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
@ -182,14 +182,14 @@ 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 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 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 blob@Blob{..}
| Just (SomeASTParser parser) <- someASTParser <$> (Just blobLanguage)
= SomeAST <$> parse parser blob
| Just (SomeASTParser parser) <- someASTParser blobLanguage = SomeAST <$> parse parser blob
| otherwise = noLanguageForBlob blobPath

4
src/Semantic/Diff.hs
View File

@ -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] <$> (Just (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)

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)))
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)