github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-02 04:10:29 +03:00
Code Issues Projects Releases Wiki Activity

Use parseWith for JSONTreeTerm.

Browse Source
This commit is contained in:
Rob Rix 2019-10-02 11:41:21 -04:00
parent b0b419bf6e
commit 41652c96ab
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
1 changed files with 5 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Semantic/Api/Terms.hs
View File

@ -68,7 +68,7 @@ parseTermBuilder TermShow = distributeFoldMap (\ blob -> asks showTermPar
parseTermBuilder TermQuiet = distributeFoldMap quietTerm
jsonTerm :: ParseEffects sig m => Blob -> m (Rendering.JSON.JSON "trees" SomeJSON)
jsonTerm blob = doParse (pure . jsonTreeTerm blob) blob `catchError` jsonError blob
jsonTerm blob = parseWith jsonTreeTermParsers (pure . jsonTreeTerm blob) blob `catchError` jsonError blob
jsonError :: Applicative m => Blob -> SomeException -> m (Rendering.JSON.JSON "trees" SomeJSON)
jsonError blob (SomeException e) = pure $ renderJSONError blob (show e)
@ -118,6 +118,9 @@ instance (ConstructorName syntax, Foldable syntax, Functor syntax) => DOTGraphTe
dotGraphTerm = serialize (DOT (termStyle "terms")) . renderTreeGraph
jsonTreeTermParsers :: [(Language, SomeParser JSONTreeTerm Loc)]
jsonTreeTermParsers = aLaCarteParsers
class JSONTreeTerm term where
jsonTreeTerm :: Blob -> term Loc -> Rendering.JSON.JSON "trees" SomeJSON
@ -137,7 +140,7 @@ instance (Foldable syntax, Functor syntax, ConstructorName syntax) => JSONGraphT
lang = bridging # blobLanguage blob
type TermActions t = (JSONGraphTerm t, JSONTreeTerm t)
type TermActions t = JSONGraphTerm t
doParse
:: ( Carrier sig m