github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-22 14:21:31 +03:00
Code Issues Projects Releases Wiki Activity

Use type applications to supply the list of typeclasses for someParser.

Browse Source
This commit is contained in:
Rob Rix 2018-05-11 16:43:53 -04:00
parent eb41652cbd
commit bcb889f85d
3 changed files with 13 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
src/Parsing/Parser.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE ConstraintKinds, DataKinds, GADTs, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators #-} {-# LANGUAGE AllowAmbiguousTypes, ConstraintKinds, GADTs, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators #-}
module Parsing.Parser module Parsing.Parser
( Parser(..) ( Parser(..)
, SomeParser(..) , SomeParser(..)
@ -116,18 +116,17 @@ someParser :: ( ApplyAll typeclasses (Sum Go.Syntax)
, ApplyAll typeclasses (Sum TypeScript.Syntax) , ApplyAll typeclasses (Sum TypeScript.Syntax)
, ApplyAll typeclasses (Sum PHP.Syntax) , ApplyAll typeclasses (Sum PHP.Syntax)
) )
=> proxy typeclasses -- ^ A proxy for the list of typeclasses required, e.g. @(Proxy :: Proxy '[Show1])@. => Language -- ^ The 'Language' to select.
-> Language -- ^ The 'Language' to select.
-> SomeParser typeclasses (Record Location) -- ^ A 'SomeParser' abstracting the syntax type to be produced. -> SomeParser typeclasses (Record Location) -- ^ A 'SomeParser' abstracting the syntax type to be produced.
someParser _ Go = SomeParser goParser someParser Go = SomeParser goParser
someParser _ JavaScript = SomeParser typescriptParser someParser JavaScript = SomeParser typescriptParser
someParser _ JSON = SomeParser jsonParser someParser JSON = SomeParser jsonParser
someParser _ JSX = SomeParser typescriptParser someParser JSX = SomeParser typescriptParser
someParser _ Markdown = SomeParser markdownParser someParser Markdown = SomeParser markdownParser
someParser _ Python = SomeParser pythonParser someParser Python = SomeParser pythonParser
someParser _ Ruby = SomeParser rubyParser someParser Ruby = SomeParser rubyParser
someParser _ TypeScript = SomeParser typescriptParser someParser TypeScript = SomeParser typescriptParser
someParser _ PHP = SomeParser phpParser someParser PHP = SomeParser phpParser
goParser :: Parser Go.Term goParser :: Parser Go.Term

2
src/Semantic/Diff.hs
View File

@ -26,7 +26,7 @@ diffBlobPairs renderer blobs = distributeFoldMap (WrapTask . diffBlobPair render
-- | A task to parse a pair of 'Blob's, diff them, and render the 'Diff'. -- | A task to parse a pair of 'Blob's, diff them, and render the 'Diff'.
diffBlobPair :: Members '[Distribute WrappedTask, Task, Telemetry, Exc SomeException, IO] effs => DiffRenderer output -> BlobPair -> Eff effs output diffBlobPair :: Members '[Distribute WrappedTask, Task, Telemetry, Exc SomeException, IO] effs => DiffRenderer output -> BlobPair -> Eff effs output
diffBlobPair renderer blobs diffBlobPair renderer blobs
| Just (SomeParser parser) <- someParser (Proxy :: Proxy '[ConstructorName, Diffable, Eq1, GAlign, HasDeclaration, IdentifierName, Show1, ToJSONFields1, Traversable]) <$> effectiveLanguage | Just (SomeParser parser) <- someParser @'[ConstructorName, Diffable, Eq1, GAlign, HasDeclaration, IdentifierName, Show1, ToJSONFields1, Traversable] <$> effectiveLanguage
= case renderer of = case renderer of
ToCDiffRenderer -> run (WrapTask . (\ blob -> parse parser blob >>= decorate (declarationAlgebra blob))) diffTerms renderToCDiff ToCDiffRenderer -> run (WrapTask . (\ blob -> parse parser blob >>= decorate (declarationAlgebra blob))) diffTerms renderToCDiff
JSONDiffRenderer -> run (WrapTask . ( parse parser >=> decorate constructorLabel >=> decorate identifierLabel)) diffTerms renderJSONDiff JSONDiffRenderer -> run (WrapTask . ( parse parser >=> decorate constructorLabel >=> decorate identifierLabel)) diffTerms renderJSONDiff

2
src/Semantic/Parse.hs
View File

@ -21,7 +21,7 @@ parseBlobs renderer blobs = distributeFoldMap (WrapTask . parseBlob renderer) bl
-- | A task to parse a 'Blob' and render the resulting 'Term'. -- | A task to parse a 'Blob' and render the resulting 'Term'.
parseBlob :: Members '[Task, Exc SomeException] effs => TermRenderer output -> Blob -> Eff effs output parseBlob :: Members '[Task, Exc SomeException] effs => TermRenderer output -> Blob -> Eff effs output
parseBlob renderer blob@Blob{..} parseBlob renderer blob@Blob{..}
| Just (SomeParser parser) <- someParser (Proxy :: Proxy '[ConstructorName, HasPackageDef, HasDeclaration, IdentifierName, Foldable, Functor, ToJSONFields1]) <$> blobLanguage | Just (SomeParser parser) <- someParser @'[ConstructorName, HasPackageDef, HasDeclaration, IdentifierName, Foldable, Functor, ToJSONFields1] <$> blobLanguage
= parse parser blob >>= case renderer of = parse parser blob >>= case renderer of
JSONTermRenderer -> decorate constructorLabel >=> decorate identifierLabel >=> render (renderJSONTerm blob) JSONTermRenderer -> decorate constructorLabel >=> decorate identifierLabel >=> render (renderJSONTerm blob)
SExpressionTermRenderer -> serialize SExpression SExpressionTermRenderer -> serialize SExpression