1
1
mirror of https://github.com/github/semantic.git synced 2024-12-24 15:35:14 +03:00

Move shared IO to DiffOutput

This commit is contained in:
joshvera 2016-01-20 11:43:31 -05:00
parent b188febbe7
commit 3e72417c77
4 changed files with 39 additions and 35 deletions

33
app/DiffOutput.hs Normal file
View File

@ -0,0 +1,33 @@
module DiffOutput where
import Source
import Term
import Control.Comonad.Cofree
import qualified Data.Text as T
import Diff
import Syntax
import Range
import qualified Data.ByteString.Char8 as B1
import qualified Data.Text.ICU.Detect as Detect
import qualified Data.Text.ICU.Convert as Convert
-- | Replace every string leaf with leaves of the words in the string.
breakDownLeavesByWord :: Source Char -> Term T.Text Info -> Term T.Text Info
breakDownLeavesByWord source = cata replaceIn
where
replaceIn info@(Info range categories) (Leaf _) | ranges <- rangesAndWordsInSource range, length ranges > 1 = info :< (Indexed $ makeLeaf categories <$> ranges)
replaceIn info syntax = info :< syntax
rangesAndWordsInSource range = rangesAndWordsFrom (start range) (Source.toList $ slice range source)
makeLeaf categories (range, substring) = Info range categories :< Leaf (T.pack substring)
-- | Transcode a file to a unicode source.
transcode :: B1.ByteString -> IO (Source Char)
transcode text = fromText <$> do
match <- Detect.detectCharset text
converter <- Convert.open match Nothing
return $ Convert.toUnicode converter text
readAndTranscodeFile :: FilePath -> IO (Source Char)
readAndTranscodeFile path = do
text <- B1.readFile path
transcode text

View File

@ -22,6 +22,7 @@ import qualified System.IO as IO
import qualified Data.Text.ICU.Detect as Detect
import qualified Data.Text.ICU.Convert as Convert
import Data.Bifunctor.Join
import DiffOutput
data Renderer = Unified | Split | Patch
@ -43,7 +44,7 @@ main = do
sources <- sequence $ readAndTranscodeFile <$> Join (sourceAPath, sourceBPath)
let parse = (P.parserForType . T.pack . takeExtension) sourceAPath
terms <- sequence $ parse <$> sources
let replaceLeaves = P.breakDownLeavesByWord <$> sources
let replaceLeaves = breakDownLeavesByWord <$> sources
printDiff arguments (runJoin sources) (runJoin $ replaceLeaves <*> terms)
where opts = info (helper <*> arguments)
(fullDesc <> progDesc "Diff some things" <> header "semantic-diff - diff semantically")
@ -66,10 +67,3 @@ printDiff arguments (aSource, bSource) (aTerm, bTerm) = case renderer arguments
Patch -> putStr $ PatchOutput.patch diff (aSource, bSource)
where diff = diffTerms aTerm bTerm
write rendered h = TextIO.hPutStr h rendered
readAndTranscodeFile :: FilePath -> IO (Source Char)
readAndTranscodeFile path = fromText <$> do
text <- B1.readFile path
match <- Detect.detectCharset text
converter <- Convert.open match Nothing
return $ Convert.toUnicode converter text

View File

@ -9,7 +9,6 @@ import TreeSitter
import Control.Comonad.Cofree
import qualified Data.Text as T
import Data.Foldable
import Term
parserForType :: T.Text -> Parser
parserForType mediaType = maybe lineByLineParser parseTreeSitterFile $ languageForType mediaType
@ -26,12 +25,3 @@ lineByLineParser input = return . root . Indexed $ case foldl' annotateLeaves ([
, charIndex + length line + 1)
toText = T.pack . Source.toString
-- | Replace every string leaf with leaves of the words in the string.
breakDownLeavesByWord :: Source Char -> Term T.Text Info -> Term T.Text Info
breakDownLeavesByWord source = cata replaceIn
where
replaceIn info@(Info range categories) (Leaf _) | ranges <- rangesAndWordsInSource range, length ranges > 1 = info :< (Indexed $ makeLeaf categories <$> ranges)
replaceIn info syntax = info :< syntax
rangesAndWordsInSource range = rangesAndWordsFrom (start range) (Source.toList $ slice range source)
makeLeaf categories (range, substring) = Info range categories :< Leaf (T.pack substring)

View File

@ -1,27 +1,20 @@
{-# LANGUAGE RecordWildCards #-}
module Main where
import Diff
import Interpreter
import qualified Parsers as P
import Syntax
import Range
import qualified PatchOutput
import Renderer
import Split
import Term
import Unified
import Source
import Control.Comonad.Cofree
import qualified Data.ByteString.Char8 as B1
import Options.Applicative
import System.Directory
import System.FilePath
import qualified Data.ByteString.Char8 as B1
import qualified Data.Text as T
import qualified Data.Text.Lazy.IO as TextIO
import qualified System.IO as IO
import qualified Data.Text.ICU.Detect as Detect
import qualified Data.Text.ICU.Convert as Convert
import Data.Bifunctor.Join
import Git.Libgit2
import Git.Types
@ -29,6 +22,7 @@ import Git.Repository
import Data.Tagged
import Control.Monad.Reader
import System.Environment
import DiffOutput
-- | The available types of diff rendering.
data Format = Unified | Split | Patch
@ -56,8 +50,8 @@ main = do
sources <- sequence $ fetchFromGitRepo gitDir filepath <$> shas
let parse = (P.parserForType . T.pack . takeExtension) filepath
terms <- sequence $ parse <$> sources
let replaceLeaves = P.breakDownLeavesByWord <$> sources
printDiff arguments filepath (uncurry diffTerms . runJoin $ replaceLeaves <*> terms) (runJoin sources)
let replaceLeaves = breakDownLeavesByWord <$> sources
printDiff arguments filepath (uncurry diffTerms . runJoin $ replaceLeaves <*> terms) (runJoin sources)
where opts = info (helper <*> arguments)
(fullDesc <> progDesc "Diff some things" <> header "semantic-diff - diff semantically")
@ -93,10 +87,3 @@ printDiff arguments filepath diff sources = case format arguments of
else path
IO.withFile outputPath IO.WriteMode (flip TextIO.hPutStr rendered)
Patch -> putStr $ PatchOutput.patch diff sources
-- | Transcode a file to a unicode source.
transcode :: B1.ByteString -> IO (Source Char)
transcode text = fromText <$> do
match <- Detect.detectCharset text
converter <- Convert.open match Nothing
return $ Convert.toUnicode converter text