diff --git a/src/Arguments.hs b/src/Arguments.hs index 982d61f40..e13783843 100644 --- a/src/Arguments.hs +++ b/src/Arguments.hs @@ -3,39 +3,51 @@ module Arguments where import Data.Maybe -import Prelude +import Data.Record +import Data.String +import Info import Prologue import Renderer -import Info +import Source +import Syntax +import Term +import Text.Show data DiffMode = DiffCommits String String [FilePath] | DiffPaths FilePath FilePath deriving Show data DiffArguments where - DiffArguments :: (Monoid output, StringConv output ByteString) => - { diffRenderer :: DiffRenderer DefaultFields output + DiffArguments :: (Monoid output, StringConv output ByteString, HasField fields Category, NFData (Record fields)) => + { diffRenderer :: DiffRenderer fields output + , termDecorator :: Source -> Term (Syntax Text) (Record DefaultFields) -> Term (Syntax Text) (Record fields) , diffMode :: DiffMode , gitDir :: FilePath , alternateObjectDirs :: [FilePath] } -> DiffArguments -deriving instance Show DiffArguments +instance Show DiffArguments where + showsPrec d DiffArguments{..} = showParen (d > 10) $ showString "DiffArguments { " . foldr (.) identity (intersperse (showString ", ") fields) . showString " }" + where fields = [ showString "diffRenderer " . shows diffRenderer + , showString "termDecorator _" + , showString "diffMode " . shows diffMode + , showString "gitDir " . shows gitDir + , showString "alternateObjectDirs " . shows alternateObjectDirs ] patchDiff :: DiffMode -> FilePath -> [FilePath] -> DiffArguments -patchDiff = DiffArguments PatchRenderer +patchDiff = DiffArguments PatchRenderer (const identity) jsonDiff :: DiffMode -> FilePath -> [FilePath] -> DiffArguments -jsonDiff = DiffArguments JSONDiffRenderer +jsonDiff = DiffArguments JSONDiffRenderer (const identity) summaryDiff :: DiffMode -> FilePath -> [FilePath] -> DiffArguments -summaryDiff = DiffArguments SummaryRenderer +summaryDiff = DiffArguments SummaryRenderer (const identity) sExpressionDiff :: DiffMode -> FilePath -> [FilePath] -> DiffArguments -sExpressionDiff = DiffArguments (SExpressionDiffRenderer TreeOnly) +sExpressionDiff = DiffArguments (SExpressionDiffRenderer TreeOnly) (const identity) tocDiff :: DiffMode -> FilePath -> [FilePath] -> DiffArguments -tocDiff = DiffArguments ToCRenderer +tocDiff = DiffArguments ToCRenderer (const identity) data ParseMode = ParseCommit String [FilePath] | ParsePaths [FilePath] diff --git a/src/SemanticCmdLine.hs b/src/SemanticCmdLine.hs index c03549703..c1b1e9db2 100644 --- a/src/SemanticCmdLine.hs +++ b/src/SemanticCmdLine.hs @@ -49,7 +49,7 @@ runDiff DiffArguments{..} = do blobs <- runCommand $ case diffMode of DiffPaths a b -> pure <$> traverse readFile (both a b) DiffCommits sha1 sha2 paths -> readFilesAtSHAs gitDir alternateObjectDirs paths (both sha1 sha2) - Semantic.diffBlobPairs identity diffRenderer blobs + Semantic.diffBlobPairs termDecorator diffRenderer blobs runParse :: ParseArguments -> IO ByteString runParse ParseArguments{..} = do