semantic/src/Renderer.hs

{-# LANGUAGE GADTs #-}
module Renderer
( DiffRenderer(..)
, runDiffRenderer
, Format(..)
, Summaries(..)
) where

import Data.Aeson (ToJSON, Value)
import Data.Functor.Both
import Data.Map as Map hiding (null)
import Data.Functor.Listable
import Data.Record
import Diff
import Info
import Prologue
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)
  SummaryRenderer :: HasDefaultFields fields => DiffRenderer fields Summaries
  SExpressionDiffRenderer :: (HasField fields Category, HasField fields SourceSpan) => SExpressionFormat -> DiffRenderer fields ByteString
  ToCRenderer :: HasDefaultFields fields => DiffRenderer fields Summaries

runDiffRenderer :: Monoid output => DiffRenderer fields output -> [(Both SourceBlob, Diff (Syntax Text) (Record fields))] -> output
runDiffRenderer renderer = foldMap . uncurry $ case renderer of
  SplitRenderer -> R.split
  PatchRenderer -> R.patch
  JSONDiffRenderer -> R.json
  SummaryRenderer -> (Summaries .) . R.summary
  SExpressionDiffRenderer format -> R.sExpression format
  ToCRenderer -> (Summaries .) . R.toc

-- | The available types of diff rendering.
data Format = Split | Patch | JSON | Summary | SExpression | TOC | Index | ParseTree
  deriving (Show)

newtype Summaries = Summaries { unSummaries :: Map Text (Map Text [Value]) }
  deriving Show

instance Monoid Summaries where
  mempty = Summaries mempty
  mappend = (Summaries .) . (Map.unionWith (Map.unionWith (<>)) `on` unSummaries)


instance Listable Format where
  tiers = cons0 Split
       \/ cons0 Patch
       \/ cons0 JSON
       \/ cons0 Summary
       \/ cons0 SExpression
       \/ cons0 TOC