1
1
mirror of https://github.com/github/semantic.git synced 2024-11-28 01:47:01 +03:00

Merge pull request #339 from github/output-directory

Output directory
This commit is contained in:
Josh Vera 2015-12-16 12:45:07 -05:00
commit 271c4af962
2 changed files with 19 additions and 9 deletions

View File

@ -14,18 +14,21 @@ import Control.Comonad.Cofree
import qualified Data.ByteString.Char8 as B1 import qualified Data.ByteString.Char8 as B1
import qualified Data.ByteString.Lazy as B2 import qualified Data.ByteString.Lazy as B2
import Options.Applicative import Options.Applicative
import System.Directory
import System.FilePath import System.FilePath
import qualified System.IO as IO
data Output = Unified | Split data Renderer = Unified | Split
data Argument = Argument { output :: Output, sourceA :: FilePath, sourceB :: FilePath } data Argument = Argument { renderer :: Renderer, output :: Maybe FilePath, sourceA :: FilePath, sourceB :: FilePath }
arguments :: Parser Argument arguments :: Parser Argument
arguments = Argument arguments = Argument
<$> (flag Split Unified (long "unified" <> help "output a unified diff") <$> (flag Split Unified (long "unified" <> help "output a unified diff")
<|> flag' Split (long "split" <> help "output a split diff")) <|> flag' Split (long "split" <> help "output a split diff"))
<*> argument str (metavar "FILE a") <*> (optional $ strOption (long "output" <> short 'o' <> help "output directory for split diffs, defaulting to stdout if unspecified"))
<*> argument str (metavar "FILE b") <*> strArgument (metavar "FILE a")
<*> strArgument (metavar "FILE b")
main :: IO () main :: IO ()
main = do main = do
@ -38,16 +41,21 @@ main = do
bTerm <- parse bContents bTerm <- parse bContents
return (replaceLeavesWithWordBranches aContents aTerm, replaceLeavesWithWordBranches bContents bTerm) return (replaceLeavesWithWordBranches aContents aTerm, replaceLeavesWithWordBranches bContents bTerm)
let diff = interpret comparable aTerm bTerm in let diff = interpret comparable aTerm bTerm in
case output arguments of case renderer arguments of
Unified -> do Unified -> do
output <- unified diff aContents bContents rendered <- unified diff aContents bContents
B1.putStr output B1.putStr rendered
Split -> do Split -> do
output <- split diff aContents bContents rendered <- split diff aContents bContents
B2.putStr output case output arguments of
Just path -> do
isDir <- doesDirectoryExist path
IO.withFile (if isDir then path </> (takeFileName sourceBPath -<.> ".html") else path) IO.WriteMode (write rendered)
Nothing -> B2.putStr rendered
where where
opts = info (helper <*> arguments) opts = info (helper <*> arguments)
(fullDesc <> progDesc "Diff some things" <> header "semantic-diff - diff semantically") (fullDesc <> progDesc "Diff some things" <> header "semantic-diff - diff semantically")
write rendered h = B2.hPut h rendered
parserForType :: String -> P.Parser parserForType :: String -> P.Parser
parserForType mediaType = maybe P.lineByLineParser parseTreeSitterFile $ case mediaType of parserForType mediaType = maybe P.lineByLineParser parseTreeSitterFile $ case mediaType of

View File

@ -50,6 +50,7 @@ executable semantic-diff-exe
, bytestring , bytestring
, optparse-applicative , optparse-applicative
, filepath , filepath
, directory
default-language: Haskell2010 default-language: Haskell2010
extra-libraries: bridge extra-libraries: bridge
extra-lib-dirs: . extra-lib-dirs: .
@ -69,6 +70,7 @@ executable semantic-diff-profile
, bytestring , bytestring
, optparse-applicative , optparse-applicative
, filepath , filepath
, directory
default-language: Haskell2010 default-language: Haskell2010
extra-libraries: bridge extra-libraries: bridge
extra-lib-dirs: . extra-lib-dirs: .