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

Extract a common handler for path-annotated rendering.

Browse Source
This commit is contained in:
Rob Rix 2017-04-27 19:27:03 -04:00
parent 66d611b460
commit 013d998ef3
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/Renderer/JSON.hs
View File

@ -206,11 +206,14 @@ newtype Identifier = Identifier { unIdentifier :: Text }
instance ToJSONFields Identifier where
toJSONFields (Renderer.JSON.Identifier i) = ["identifier" .= i]
jsonFile :: ToJSON a => SourceBlob -> a -> Value
jsonFile SourceBlob{..} = toJSON . File path
jsonParseTree :: ToJSONFields (Record fields) => SourceBlob -> Term (Syntax Text) (Record fields) -> Value
jsonParseTree SourceBlob{..} = toJSON . File path . decoratorWithAlgebra (fToR identifierAlg)
jsonParseTree blob = jsonFile blob . decoratorWithAlgebra (fToR identifierAlg)
jsonIndexParseTree :: ToJSONFields (Record fields) => SourceBlob -> Term (Syntax Text) (Record fields) -> Value
jsonIndexParseTree SourceBlob{..} = toJSON . File path . fmap (object . toJSONFields) . cata combine . decoratorWithAlgebra (fToR identifierAlg)
jsonIndexParseTree blob = jsonFile blob . fmap (object . toJSONFields) . cata combine . decoratorWithAlgebra (fToR identifierAlg)
where combine (a :< f) | Nothing <- rhead a = Prologue.concat f
| Leaf _ <- f = Prologue.concat f
| otherwise = a : Prologue.concat f