2017-04-20 21:00:02 +03:00
|
|
|
{-# LANGUAGE GADTs, MultiParamTypeClasses #-}
|
2017-03-31 22:55:57 +03:00
|
|
|
module Renderer
|
2017-03-31 23:50:13 +03:00
|
|
|
( DiffRenderer(..)
|
|
|
|
, runDiffRenderer
|
2017-04-20 21:00:02 +03:00
|
|
|
-- , DefaultParseTreeRenderer
|
2017-04-20 04:27:36 +03:00
|
|
|
, ParseTreeRenderer(..)
|
|
|
|
, runParseTreeRenderer
|
2017-04-03 22:31:46 +03:00
|
|
|
, Summaries(..)
|
2017-04-03 23:21:14 +03:00
|
|
|
, File(..)
|
2017-03-31 22:55:57 +03:00
|
|
|
) where
|
2016-01-14 21:18:40 +03:00
|
|
|
|
2017-04-03 23:00:00 +03:00
|
|
|
import Data.Aeson (ToJSON, Value)
|
2016-09-09 21:46:50 +03:00
|
|
|
import Data.Functor.Both
|
2017-04-11 01:10:24 +03:00
|
|
|
import Data.Functor.Classes
|
|
|
|
import Text.Show
|
2016-08-24 21:30:29 +03:00
|
|
|
import Data.Map as Map hiding (null)
|
2017-03-31 23:08:39 +03:00
|
|
|
import Data.Record
|
2017-04-01 06:02:41 +03:00
|
|
|
import Diff
|
2017-03-31 23:08:39 +03:00
|
|
|
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
|
2016-09-09 21:46:50 +03:00
|
|
|
import Source (SourceBlob)
|
|
|
|
import Syntax
|
2017-04-20 04:27:36 +03:00
|
|
|
import Term
|
|
|
|
import Data.Functor.Listable
|
2016-01-14 21:18:40 +03:00
|
|
|
|
2017-04-20 21:00:02 +03:00
|
|
|
|
2017-03-31 23:08:39 +03:00
|
|
|
data DiffRenderer fields output where
|
2017-04-03 23:21:14 +03:00
|
|
|
SplitRenderer :: (HasField fields Category, HasField fields Range) => DiffRenderer fields File
|
|
|
|
PatchRenderer :: HasField fields Range => DiffRenderer fields File
|
2017-03-31 23:08:39 +03:00
|
|
|
JSONDiffRenderer :: (ToJSON (Record fields), HasField fields Category, HasField fields Range) => DiffRenderer fields (Map Text Value)
|
2017-04-03 22:37:20 +03:00
|
|
|
SummaryRenderer :: HasDefaultFields fields => DiffRenderer fields Summaries
|
2017-03-31 23:14:44 +03:00
|
|
|
SExpressionDiffRenderer :: (HasField fields Category, HasField fields SourceSpan) => SExpressionFormat -> DiffRenderer fields ByteString
|
2017-04-03 22:37:20 +03:00
|
|
|
ToCRenderer :: HasDefaultFields fields => DiffRenderer fields Summaries
|
2017-03-31 23:08:39 +03:00
|
|
|
|
2017-04-20 21:00:02 +03:00
|
|
|
runDiffRenderer :: (Monoid output, StringConv output ByteString) => DiffRenderer fields output -> [(Both SourceBlob, Diff (Syntax Text) (Record fields))] -> output
|
2017-04-03 23:05:36 +03:00
|
|
|
runDiffRenderer renderer = foldMap . uncurry $ case renderer of
|
2017-04-03 23:21:14 +03:00
|
|
|
SplitRenderer -> (File .) . R.split
|
|
|
|
PatchRenderer -> (File .) . R.patch
|
2017-04-01 06:02:56 +03:00
|
|
|
JSONDiffRenderer -> R.json
|
2017-04-04 00:15:58 +03:00
|
|
|
SummaryRenderer -> R.summary
|
2017-04-01 06:02:56 +03:00
|
|
|
SExpressionDiffRenderer format -> R.sExpression format
|
2017-04-04 00:15:58 +03:00
|
|
|
ToCRenderer -> R.toc
|
2017-03-31 23:54:55 +03:00
|
|
|
|
2017-04-20 04:27:36 +03:00
|
|
|
data ParseTreeRenderer fields output where
|
|
|
|
SExpressionParseTreeRenderer :: (HasField fields Category, HasField fields SourceSpan) => SExpressionFormat -> ParseTreeRenderer fields ByteString
|
2017-04-20 21:00:02 +03:00
|
|
|
-- JSONParseTreeRenderer :: ParseTreeRenderer ParseTreeFile
|
2017-04-20 04:27:36 +03:00
|
|
|
|
2017-04-20 21:00:02 +03:00
|
|
|
runParseTreeRenderer :: (Monoid output, StringConv output ByteString) => ParseTreeRenderer fields output -> [(SourceBlob, Term (Syntax Text) (Record fields))] -> output
|
|
|
|
runParseTreeRenderer renderer = foldMap . uncurry $ case renderer of
|
|
|
|
SExpressionParseTreeRenderer format -> R.sExpressionParseTree format
|
|
|
|
-- where
|
|
|
|
-- printTerm format term = R.printTerm term 0 format
|
2017-04-20 04:27:36 +03:00
|
|
|
|
2017-04-03 23:21:14 +03:00
|
|
|
newtype File = File { unFile :: Text }
|
|
|
|
deriving Show
|
|
|
|
|
2017-04-20 21:00:02 +03:00
|
|
|
instance StringConv File ByteString where
|
|
|
|
strConv _ = encodeUtf8 . unFile
|
|
|
|
|
2017-04-11 01:10:24 +03:00
|
|
|
instance Show (DiffRenderer fields output) where
|
|
|
|
showsPrec _ SplitRenderer = showString "SplitRenderer"
|
|
|
|
showsPrec _ PatchRenderer = showString "PatchRenderer"
|
|
|
|
showsPrec _ JSONDiffRenderer = showString "JSONDiffRenderer"
|
|
|
|
showsPrec _ SummaryRenderer = showString "SummaryRenderer"
|
|
|
|
showsPrec d (SExpressionDiffRenderer format) = showsUnaryWith showsPrec "SExpressionDiffRenderer" d format
|
|
|
|
showsPrec _ ToCRenderer = showString "ToCRenderer"
|
|
|
|
|
2017-04-20 04:27:36 +03:00
|
|
|
instance Show (ParseTreeRenderer fields output) where
|
|
|
|
showsPrec d (SExpressionParseTreeRenderer format) = showsUnaryWith showsPrec "SExpressionParseTreeRenderer" d format
|
2017-04-20 21:00:02 +03:00
|
|
|
-- showsPrec _ JSONParseTreeRenderer = showString "JSONParseTreeRenderer"
|
2017-04-20 04:27:36 +03:00
|
|
|
|
2017-04-03 23:21:14 +03:00
|
|
|
instance Monoid File where
|
|
|
|
mempty = File mempty
|
|
|
|
mappend (File a) (File b) = File (a <> "\n" <> b)
|
2017-04-20 04:27:36 +03:00
|
|
|
|
2017-04-20 21:00:02 +03:00
|
|
|
-- instance Listable ParseTreeRenderer where
|
|
|
|
-- tiers = cons0 (SExpressionParseTreeRenderer TreeOnly)
|
|
|
|
-- \/ cons0 JSONParseTreeRenderer
|