github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-01 19:55:34 +03:00
Code Issues Projects Releases Wiki Activity

Move withSomeTerm into parseBlob.

Browse Source
This commit is contained in:
Rob Rix 2018-05-14 16:36:02 -04:00
parent b72856d3b3
commit adb2b6e8aa
1 changed files with 4 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Semantic/Parse.hs
View File

@ -9,6 +9,7 @@ import Data.AST
import Data.Blob
import Data.JSON.Fields
import Data.Record
import Data.Term
import Parsing.Parser
import Prologue hiding (MonadError(..))
import Rendering.Graph
@ -23,8 +24,8 @@ parseBlobs renderer = distributeFoldMap (WrapTask . parseBlob renderer)
parseSomeBlob :: Members '[Task, Exc SomeException] effs => Blob -> Eff effs (SomeTerm '[ConstructorName, HasPackageDef, HasDeclaration, IdentifierName, Foldable, Functor, ToJSONFields1] (Record Location))
parseSomeBlob blob@Blob{..} = maybe (noLanguageForBlob blobPath) (flip parse blob . someParser) blobLanguage
renderSomeTerm :: Members '[Task, Exc SomeException] effs => TermRenderer output -> Blob -> SomeTerm '[ConstructorName, HasPackageDef, HasDeclaration, IdentifierName, Foldable, Functor, ToJSONFields1] (Record Location) -> Eff effs output
renderSomeTerm renderer blob@Blob{..} = withSomeTerm $ case renderer of
renderTerm :: (ConstructorName syntax, HasPackageDef syntax, HasDeclaration syntax, IdentifierName syntax, Foldable syntax, Functor syntax, ToJSONFields1 syntax, Members '[Task, Exc SomeException] effs) => TermRenderer output -> Blob -> Term syntax (Record Location) -> Eff effs output
renderTerm renderer blob@Blob{..} = case renderer of
JSONTermRenderer -> decorate constructorLabel >=> decorate identifierLabel >=> render (renderJSONTerm blob)
SExpressionTermRenderer -> serialize (SExpression ByConstructorName)
TagsTermRenderer -> decorate (declarationAlgebra blob) >=> render (renderToTags blob)
@ -35,4 +36,4 @@ renderSomeTerm renderer blob@Blob{..} = withSomeTerm $ case renderer of
-- | A task to parse a 'Blob' and render the resulting 'Term'.
parseBlob :: Members '[Task, Exc SomeException] effs => TermRenderer output -> Blob -> Eff effs output
parseBlob renderer blob@Blob{..} = parseSomeBlob blob >>= renderSomeTerm renderer blob
parseBlob renderer blob@Blob{..} = parseSomeBlob blob >>= withSomeTerm (renderTerm renderer blob)