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

Move decoration of terms out of the JSON renderer.

Browse Source
This commit is contained in:
Rob Rix 2017-04-27 19:36:35 -04:00
parent 013d998ef3
commit 4975dc61fe
2 changed files with 15 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
src/Renderer.hs
View File

@ -18,7 +18,7 @@ import Data.Map as Map hiding (null)
import Data.Record
import Diff
import Info
import Language.Ruby.Syntax (decoratorWithAlgebra)
import Language.Ruby.Syntax (decoratorWithAlgebra, fToR)
import Prologue
import Renderer.JSON as R
import Renderer.Patch as R
@ -58,14 +58,14 @@ data ParseTreeRenderer fields output where
JSONIndexParseTreeRenderer :: (ToJSONFields (Record fields), HasField fields Range) => Bool -> ParseTreeRenderer fields Value
resolveParseTreeRenderer :: (Monoid output, StringConv output ByteString) => ParseTreeRenderer fields output -> SourceBlob -> Term (Syntax Text) (Record fields) -> output
resolveParseTreeRenderer renderer = case renderer of
SExpressionParseTreeRenderer format -> R.sExpressionParseTree format
JSONParseTreeRenderer True -> (uncurry R.jsonParseTree .) . decorateWithSource
JSONParseTreeRenderer False -> R.jsonParseTree
JSONIndexParseTreeRenderer True -> (uncurry R.jsonIndexParseTree .) . decorateWithSource
JSONIndexParseTreeRenderer False -> R.jsonIndexParseTree
where decorateWithSource blob = (,) blob . decoratorWithAlgebra (sourceDecorator (source blob))
sourceDecorator source (ann :< _) = Just (SourceText (toText (Source.slice (byteRange ann) source)))
resolveParseTreeRenderer renderer blob = case renderer of
SExpressionParseTreeRenderer format -> R.sExpressionParseTree format blob
JSONParseTreeRenderer True -> R.jsonParseTree blob . decoratorWithAlgebra (fToR identifierAlg) . decoratorWithAlgebra (sourceDecorator (source blob))
JSONParseTreeRenderer False -> R.jsonParseTree blob . decoratorWithAlgebra (fToR identifierAlg)
JSONIndexParseTreeRenderer True -> R.jsonIndexParseTree blob . decoratorWithAlgebra (fToR identifierAlg) . decoratorWithAlgebra (sourceDecorator (source blob))
JSONIndexParseTreeRenderer False -> R.jsonIndexParseTree blob . decoratorWithAlgebra (fToR identifierAlg)
where sourceDecorator source (ann :< _) = Just (SourceText (toText (Source.slice (byteRange ann) source)))
identifierAlg = fmap R.Identifier . maybeIdentifier . fmap (fmap unIdentifier)
runParseTreeRenderer :: (Monoid output, StringConv output ByteString) => ParseTreeRenderer fields output -> [(SourceBlob, Term (Syntax Text) (Record fields))] -> output
runParseTreeRenderer = foldMap . uncurry . resolveParseTreeRenderer

17
src/Renderer/JSON.hs
View File

@ -3,9 +3,11 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Renderer.JSON
( json
, jsonFile
, jsonParseTree
, jsonIndexParseTree
, ToJSONFields(..)
, Identifier(..)
) where
import Alignment
@ -19,7 +21,6 @@ import Data.These
import Data.Vector as Vector hiding (toList)
import Diff
import Info
import Language.Ruby.Syntax (decoratorWithAlgebra, fToR, FAlgebra)
import Prologue
import qualified Data.Map as Map
import Source
@ -197,9 +198,6 @@ instance Monoid Value where
instance StringConv Value ByteString where
strConv _ = toS . (<> "\n") . encode
ala :: Functor f => (a -> b) -> (b -> a) -> FAlgebra f a -> FAlgebra f b
ala into outof f = into . f . fmap outof
newtype Identifier = Identifier { unIdentifier :: Text }
deriving (Eq, Show)
@ -210,13 +208,10 @@ jsonFile :: ToJSON a => SourceBlob -> a -> Value
jsonFile SourceBlob{..} = toJSON . File path
jsonParseTree :: ToJSONFields (Record fields) => SourceBlob -> Term (Syntax Text) (Record fields) -> Value
jsonParseTree blob = jsonFile blob . decoratorWithAlgebra (fToR identifierAlg)
jsonParseTree = jsonFile
jsonIndexParseTree :: ToJSONFields (Record fields) => SourceBlob -> Term (Syntax Text) (Record fields) -> Value
jsonIndexParseTree blob = jsonFile blob . fmap (object . toJSONFields) . cata combine . decoratorWithAlgebra (fToR identifierAlg)
where combine (a :< f) | Nothing <- rhead a = Prologue.concat f
jsonIndexParseTree :: (ToJSONFields (Record fields), HasField fields (Maybe Identifier)) => SourceBlob -> Term (Syntax Text) (Record fields) -> Value
jsonIndexParseTree blob = jsonFile blob . fmap (object . toJSONFields) . cata combine
where combine (a :< f) | Nothing <- getField a :: Maybe Identifier = Prologue.concat f
| Leaf _ <- f = Prologue.concat f
| otherwise = a : Prologue.concat f
identifierAlg :: FAlgebra (SyntaxTermF Text a) (Maybe Identifier)
identifierAlg = ala (fmap Renderer.JSON.Identifier) (fmap unIdentifier) maybeIdentifier