1
1
mirror of https://github.com/github/semantic.git synced 2024-12-23 14:54:16 +03:00
semantic/src/Renderer.hs

123 lines
4.6 KiB
Haskell
Raw Normal View History

{-# LANGUAGE GADTs #-}
2017-03-31 22:55:57 +03:00
module Renderer
( DiffRenderer(..)
, runDiffRenderer
, runDiffRenderer'
, Renderer
2017-03-31 22:55:57 +03:00
, Output(..)
, concatOutputs
, Format(..)
) where
import Data.Aeson (ToJSON, Value, encode)
import Data.Functor.Both
2016-08-24 21:30:29 +03:00
import Data.Map as Map hiding (null)
import Data.Text.Encoding (encodeUtf8)
import qualified Data.ByteString as B
import Data.Functor.Listable
import Data.Record
2017-04-01 06:02:41 +03:00
import Diff
import Info
2017-03-09 01:45:47 +03:00
import Prologue
2017-03-31 23:49:29 +03:00
import Renderer.JSON as R
import Renderer.Patch as R
import Renderer.SExpression as R
import Renderer.Split as R
import Renderer.Summary as R
import Renderer.TOC as R
import Source (SourceBlob)
import Syntax
data DiffRenderer fields output where
SplitRenderer :: (HasField fields Category, HasField fields Range) => DiffRenderer fields Text
PatchRenderer :: HasField fields Range => DiffRenderer fields Text
JSONDiffRenderer :: (ToJSON (Record fields), HasField fields Category, HasField fields Range) => DiffRenderer fields (Map Text Value)
2017-03-31 23:39:40 +03:00
SummaryRenderer :: HasDefaultFields fields => DiffRenderer fields (Map Text (Map Text [Value]))
SExpressionDiffRenderer :: (HasField fields Category, HasField fields SourceSpan) => SExpressionFormat -> DiffRenderer fields ByteString
2017-03-31 23:49:09 +03:00
ToCRenderer :: HasDefaultFields fields => DiffRenderer fields (Map Text (Map Text [Value]))
2017-04-01 00:03:17 +03:00
runDiffRenderer :: DiffRenderer fields output -> Both SourceBlob -> Diff (Syntax Text) (Record fields) -> Output
runDiffRenderer renderer sources diff = case renderer of
2017-03-31 23:49:29 +03:00
SplitRenderer -> SplitOutput (R.split sources diff)
PatchRenderer -> PatchOutput (R.patch sources diff)
JSONDiffRenderer -> JSONOutput (R.json sources diff)
SummaryRenderer -> SummaryOutput (R.summary sources diff)
SExpressionDiffRenderer format -> SExpressionOutput (R.sExpression format sources diff)
ToCRenderer -> TOCOutput (R.toc sources diff)
2017-04-01 00:03:17 +03:00
runDiffRenderer' :: DiffRenderer fields output -> Both SourceBlob -> Diff (Syntax Text) (Record fields) -> output
runDiffRenderer' renderer = case renderer of
SplitRenderer -> R.split
PatchRenderer -> R.patch
JSONDiffRenderer -> R.json
SummaryRenderer -> R.summary
SExpressionDiffRenderer format -> R.sExpression format
ToCRenderer -> R.toc
2016-07-29 19:24:12 +03:00
-- | A function that will render a diff, given the two source blobs.
type Renderer annotation = Both SourceBlob -> Diff (Syntax Text) annotation -> Output
2016-04-01 22:34:52 +03:00
-- | The available types of diff rendering.
2017-03-11 01:12:23 +03:00
data Format = Split | Patch | JSON | Summary | SExpression | TOC | Index | ParseTree
deriving (Show)
data Output = SplitOutput Text | PatchOutput Text | JSONOutput (Map Text Value) | SummaryOutput (Map Text (Map Text [Value])) | SExpressionOutput ByteString | TOCOutput (Map Text (Map Text [Value]))
2016-08-22 16:27:13 +03:00
deriving (Show)
2016-08-22 04:51:48 +03:00
2016-08-24 21:16:01 +03:00
-- Concatenates a list of 'Output' depending on the output type.
-- For JSON, each file output is merged since they're uniquely keyed by filename.
-- For Summaries, each file output is merged into one 'Object' consisting of lists of
-- changes and errors.
-- Split and Patch output is appended together with newlines.
concatOutputs :: [Output] -> ByteString
2017-03-09 01:45:47 +03:00
concatOutputs list | isJSON list = toS . encode $ concatJSON list
where
concatJSON :: [Output] -> Map Text Value
concatJSON (JSONOutput hash : rest) = Map.union hash (concatJSON rest)
concatJSON _ = mempty
2017-03-09 01:45:47 +03:00
concatOutputs list | isSummary list = toS . encode $ concatSummaries list
where
2016-10-06 20:12:40 +03:00
concatSummaries :: [Output] -> Map Text (Map Text [Value])
2016-08-25 00:07:43 +03:00
concatSummaries (SummaryOutput hash : rest) = Map.unionWith (Map.unionWith (<>)) hash (concatSummaries rest)
2017-01-24 01:31:01 +03:00
concatSummaries (TOCOutput hash : rest) = Map.unionWith (Map.unionWith (<>)) hash (concatSummaries rest)
concatSummaries _ = mempty
concatOutputs list | isByteString list = B.intercalate "\n" (toByteString <$> list)
concatOutputs list | isText list = B.intercalate "\n" (encodeUtf8 . toText <$> list)
2016-08-22 04:51:48 +03:00
concatOutputs _ = mempty
isJSON :: [Output] -> Bool
isJSON (JSONOutput _ : _) = True
isJSON _ = False
isSummary :: [Output] -> Bool
isSummary (SummaryOutput _ : _) = True
2017-01-24 01:31:01 +03:00
isSummary (TOCOutput _ : _) = True
2016-08-22 04:51:48 +03:00
isSummary _ = False
isText :: [Output] -> Bool
isText (SplitOutput _ : _) = True
isText (PatchOutput _ : _) = True
isText _ = False
2016-08-10 19:17:23 +03:00
toText :: Output -> Text
toText (SplitOutput text) = text
toText (PatchOutput text) = text
toText _ = mempty
isByteString :: [Output] -> Bool
isByteString (SExpressionOutput _ : _) = True
isByteString _ = False
toByteString :: Output -> ByteString
toByteString (SExpressionOutput text) = text
toByteString _ = B.empty
instance Listable Format where
tiers = cons0 Split
\/ cons0 Patch
\/ cons0 JSON
\/ cons0 Summary
\/ cons0 SExpression
\/ cons0 TOC