mirror of
https://github.com/github/semantic.git
synced 2024-12-21 13:51:44 +03:00
DiffArguments specifies a decorator, generalizing the fields avaialble to the renderers.
This commit is contained in:
parent
bba39a5524
commit
c08319e308
@ -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]
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user