github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-04 05:27:08 +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.Blob
import Data.JSON.Fields import Data.JSON.Fields
import Data.Record import Data.Record
import Data.Term
import Parsing.Parser import Parsing.Parser
import Prologue hiding (MonadError(..)) import Prologue hiding (MonadError(..))
import Rendering.Graph 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 :: 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 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 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
renderSomeTerm renderer blob@Blob{..} = withSomeTerm $ case renderer of renderTerm renderer blob@Blob{..} = case renderer of
JSONTermRenderer -> decorate constructorLabel >=> decorate identifierLabel >=> render (renderJSONTerm blob) JSONTermRenderer -> decorate constructorLabel >=> decorate identifierLabel >=> render (renderJSONTerm blob)
SExpressionTermRenderer -> serialize (SExpression ByConstructorName) SExpressionTermRenderer -> serialize (SExpression ByConstructorName)
TagsTermRenderer -> decorate (declarationAlgebra blob) >=> render (renderToTags blob) 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'. -- | 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{..} = parseSomeBlob blob >>= renderSomeTerm renderer blob parseBlob renderer blob@Blob{..} = parseSomeBlob blob >>= withSomeTerm (renderTerm renderer blob)