github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-21 13:51:44 +03:00
Code Issues Projects Releases Wiki Activity

DiffArguments specifies a decorator, generalizing the fields avaialble to the renderers.

Browse Source
This commit is contained in:
Rob Rix 2017-05-10 15:23:16 -04:00
parent bba39a5524
commit c08319e308
2 changed files with 23 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
src/Arguments.hs
View File

@ -3,39 +3,51 @@
module Arguments where module Arguments where
import Data.Maybe import Data.Maybe
import Prelude import Data.Record
import Data.String
import Info
import Prologue import Prologue
import Renderer import Renderer
import Info import Source
import Syntax
import Term
import Text.Show
data DiffMode = DiffCommits String String [FilePath] | DiffPaths FilePath FilePath data DiffMode = DiffCommits String String [FilePath] | DiffPaths FilePath FilePath
deriving Show deriving Show
data DiffArguments where data DiffArguments where
DiffArguments :: (Monoid output, StringConv output ByteString) => DiffArguments :: (Monoid output, StringConv output ByteString, HasField fields Category, NFData (Record fields)) =>
{ diffRenderer :: DiffRenderer DefaultFields output { diffRenderer :: DiffRenderer fields output
, termDecorator :: Source -> Term (Syntax Text) (Record DefaultFields) -> Term (Syntax Text) (Record fields)
, diffMode :: DiffMode , diffMode :: DiffMode
, gitDir :: FilePath , gitDir :: FilePath
, alternateObjectDirs :: [FilePath] , alternateObjectDirs :: [FilePath]
} -> DiffArguments } -> 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 :: DiffMode -> FilePath -> [FilePath] -> DiffArguments
patchDiff = DiffArguments PatchRenderer patchDiff = DiffArguments PatchRenderer (const identity)
jsonDiff :: DiffMode -> FilePath -> [FilePath] -> DiffArguments jsonDiff :: DiffMode -> FilePath -> [FilePath] -> DiffArguments
jsonDiff = DiffArguments JSONDiffRenderer jsonDiff = DiffArguments JSONDiffRenderer (const identity)
summaryDiff :: DiffMode -> FilePath -> [FilePath] -> DiffArguments summaryDiff :: DiffMode -> FilePath -> [FilePath] -> DiffArguments
summaryDiff = DiffArguments SummaryRenderer summaryDiff = DiffArguments SummaryRenderer (const identity)
sExpressionDiff :: DiffMode -> FilePath -> [FilePath] -> DiffArguments sExpressionDiff :: DiffMode -> FilePath -> [FilePath] -> DiffArguments
sExpressionDiff = DiffArguments (SExpressionDiffRenderer TreeOnly) sExpressionDiff = DiffArguments (SExpressionDiffRenderer TreeOnly) (const identity)
tocDiff :: DiffMode -> FilePath -> [FilePath] -> DiffArguments tocDiff :: DiffMode -> FilePath -> [FilePath] -> DiffArguments
tocDiff = DiffArguments ToCRenderer tocDiff = DiffArguments ToCRenderer (const identity)
data ParseMode = ParseCommit String [FilePath] | ParsePaths [FilePath] data ParseMode = ParseCommit String [FilePath] | ParsePaths [FilePath]

2
src/SemanticCmdLine.hs
View File

@ -49,7 +49,7 @@ runDiff DiffArguments{..} = do
blobs <- runCommand $ case diffMode of blobs <- runCommand $ case diffMode of
DiffPaths a b -> pure <$> traverse readFile (both a b) DiffPaths a b -> pure <$> traverse readFile (both a b)
DiffCommits sha1 sha2 paths -> readFilesAtSHAs gitDir alternateObjectDirs paths (both sha1 sha2) 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 -> IO ByteString
runParse ParseArguments{..} = do runParse ParseArguments{..} = do