share diff and breakDownLeavesByWord between SemanticDiff and Main

app/Main.hs

@@ -43,7 +43,7 @@ main = do
   sources <- sequence $ readAndTranscodeFile <$> Join (sourceAPath, sourceBPath)
   let parse = (P.parserForType . T.pack . takeExtension) sourceAPath
   terms <- sequence $ parse <$> sources
-  let replaceLeaves = breakDownLeavesByWord <$> sources
+  let replaceLeaves = P.breakDownLeavesByWord <$> sources
   printDiff arguments (runJoin sources) (runJoin $ replaceLeaves <*> terms)
   where opts = info (helper <*> arguments)
           (fullDesc <> progDesc "Diff some things" <> header "semantic-diff - diff semantically")
@@ -64,17 +64,9 @@ printDiff arguments (aSource, bSource) (aTerm, bTerm) = case renderer arguments
         IO.withFile outputPath IO.WriteMode (write rendered)
       Nothing -> TextIO.putStr rendered
   Patch -> putStr $ PatchOutput.patch diff (aSource, bSource)
-  where diff = interpret comparable aTerm bTerm
+  where diff = diffTerms aTerm bTerm
         write rendered h = TextIO.hPutStr h rendered
 
-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) (toList $ slice range source)
-    makeLeaf categories (range, substring) = Info range categories :< Leaf (T.pack substring)
-
 readAndTranscodeFile :: FilePath -> IO (Source Char)
 readAndTranscodeFile path = fromText <$> do
   text <- B1.readFile path

app/Parsers.hs

@@ -9,6 +9,7 @@ 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
@@ -24,3 +25,13 @@ lineByLineParser input = return . root . Indexed $ case foldl' annotateLeaves ([
       (accum ++ [ leaf charIndex (toText line) ]
       , 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)
+

app/SemanticDiff.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE RecordWildCards #-}
 module Main where
 
-import Categorizable
 import Diff
 import Interpreter
 import qualified Parsers as P
@@ -57,8 +56,8 @@ main = do
     sources <- sequence $ fetchFromGitRepo gitDir filepath <$> shas
     let parse = (P.parserForType . T.pack . takeExtension) filepath
     terms <- sequence $ parse <$> sources
-    let replaceLeaves = breakDownLeavesByWord <$> sources
-    printDiff arguments filepath (uncurry diff . runJoin $ replaceLeaves <*> terms) (runJoin sources) 
+    let replaceLeaves = P.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")
 
@@ -80,10 +79,6 @@ fetchFromGitRepo repoPath path sha = join $ withRepository lgFactory repoPath $
                    return s
     return $ transcode bytestring
 
--- | Diff two terms.
-diff :: (Eq a, Eq annotation, Categorizable annotation) => Term a annotation -> Term a annotation -> Diff a annotation
-diff = interpret comparable
-
 -- | Return a renderer from the command-line arguments that will print the diff.
 printDiff :: Arguments -> FilePath -> Renderer T.Text (IO ())
 printDiff arguments filepath diff sources = case format arguments of
@@ -99,15 +94,6 @@ printDiff arguments filepath diff sources = case format arguments of
         IO.withFile outputPath IO.WriteMode (flip TextIO.hPutStr rendered)
   Patch -> putStr $ PatchOutput.patch diff sources
 
--- | 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) (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

src/Interpreter.hs

@@ -1,4 +1,4 @@
-module Interpreter (interpret, Comparable) where
+module Interpreter (interpret, Comparable, diffTerms) where
 
 import Prelude hiding (lookup)
 import Algorithm
@@ -8,6 +8,7 @@ import Patch
 import SES
 import Syntax
 import Term
+import Categorizable
 import Control.Monad.Free
 import Control.Comonad.Cofree hiding (unwrap)
 import qualified Data.OrderedMap as Map
@@ -20,6 +21,10 @@ import Data.Maybe
 -- | Returns whether two terms are comparable
 type Comparable a annotation = Term a annotation -> Term a annotation -> Bool
 
+-- | Diff two terms.
+diffTerms :: (Eq a, Eq annotation, Categorizable annotation) => Term a annotation -> Term a annotation -> Diff a annotation
+diffTerms = interpret comparable
+
 interpret :: (Eq a, Eq annotation) => Comparable a annotation -> Term a annotation -> Term a annotation -> Diff a annotation
 interpret comparable a b = fromMaybe (Pure $ Replace a b) $ constructAndRun comparable a b