From 3e72417c77b6c2223d9bf56eb59ee289cc2e0006 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 20 Jan 2016 11:43:31 -0500 Subject: [PATCH] Move shared IO to DiffOutput --- app/DiffOutput.hs | 33 +++++++++++++++++++++++++++++++++ app/Main.hs | 10 ++-------- app/Parsers.hs | 10 ---------- app/SemanticDiff.hs | 21 ++++----------------- 4 files changed, 39 insertions(+), 35 deletions(-) create mode 100644 app/DiffOutput.hs diff --git a/app/DiffOutput.hs b/app/DiffOutput.hs new file mode 100644 index 000000000..4dfb66347 --- /dev/null +++ b/app/DiffOutput.hs @@ -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 diff --git a/app/Main.hs b/app/Main.hs index a223cc314..766b002e5 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/app/Parsers.hs b/app/Parsers.hs index f852b47fc..12ee24ac2 100644 --- a/app/Parsers.hs +++ b/app/Parsers.hs @@ -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) - diff --git a/app/SemanticDiff.hs b/app/SemanticDiff.hs index fe3eeabc9..b3619d7e9 100644 --- a/app/SemanticDiff.hs +++ b/app/SemanticDiff.hs @@ -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