IntegrationSpec no longer uses runCommand

test/IntegrationSpec.hs

@@ -2,7 +2,6 @@
 module IntegrationSpec where
 
 import Command
-import Command.Parse
 import Data.Functor.Both
 import Data.List (union, concat, transpose)
 import Data.Record
@@ -110,23 +109,14 @@ normalizeName path = dropExtension $ dropExtension path
 
 testParse :: FilePath -> FilePath -> Expectation
 testParse path expectedOutput = do
-  source <- readFileToUnicode path
-  let blob = sourceBlob source path
-  term <- parserForFilePath path blob
-  let actual = (Verbatim . stripWhitespace) $ printTerm term 0 TreeOnly
-  expected <- (Verbatim . stripWhitespace) <$> B.readFile expectedOutput
+  actual <- verbatim <$> parseFile path
+  expected <- verbatim <$> B.readFile expectedOutput
   actual `shouldBe` expected
 
 testDiff :: (Both SourceBlob -> Diff (Syntax Text) (Record DefaultFields) -> ByteString) -> Both FilePath -> FilePath -> Expectation
 testDiff renderer paths expectedOutput = do
-  (blobs, diff') <- runCommand $ do
-    blobs <- traverse readFile paths
-    terms <- traverse (traverse parseBlob) blobs
-    Just diff' <- maybeDiff terms
-    return (fromMaybe . emptySourceBlob <$> paths <*> blobs, diff')
-  let diffOutput = renderer blobs diff'
-  let actual = Verbatim (stripWhitespace diffOutput)
-  expected <- Verbatim . stripWhitespace <$> B.readFile expectedOutput
+  actual <- verbatim <$> diffPaths paths
+  expected <- verbatim <$> B.readFile expectedOutput
   actual `shouldBe` expected
 
 stripWhitespace :: ByteString -> ByteString
@@ -140,3 +130,6 @@ newtype Verbatim = Verbatim ByteString
 
 instance Show Verbatim where
   showsPrec _ (Verbatim byteString) = ('\n':) . (T.unpack (decodeUtf8 byteString) ++)
+
+verbatim :: ByteString -> Verbatim
+verbatim = Verbatim . stripWhitespace

test/SpecHelpers.hs

@@ -1,21 +1,75 @@
-module SpecHelpers where
+{-# LANGUAGE DataKinds, GADTs, ScopedTypeVariables, TypeFamilies, TypeOperators #-}
+{-# OPTIONS_GHC -Wno-deprecations #-}
+module SpecHelpers
+( diffPaths
+, parseFile
+, readFileToUnicode
+, parserForFilePath
+) where
 
+import Data.Functor.Both
+import Data.Record
+import Info
+import Language
+import Parser
+import Parser.Language hiding (parserForFilePath)
 import Prologue
 import qualified Data.ByteString as B
 import qualified Data.Text.ICU.Convert as Convert
 import qualified Data.Text.ICU.Detect as Detect
+import Renderer.SExpression
 import Source
-import Info
-import Data.Record
 import Syntax
-import Language
-import Parser
-import Parser.Language
+import Interpreter
+import Data.RandomWalkSimilarity
+import Term
+import Diff
 import System.FilePath
+import Patch
 
 -- TODO: Write helper functions for parse file and diff files that don't depend on Command.
 
--- | Read a file and convert it to Unicode.
+-- testDiff :: Both SourceBlob -> IO (Diff (Syntax Text) (Record DefaultFields))
+
+-- | Returns an s-expression formatted diff for the specified FilePath pair.
+diffPaths :: Both FilePath -> IO ByteString
+diffPaths paths = do
+  blobs <- traverse readFileToSourceBlob paths
+  terms' <- traverse (traverse parseBlob) blobs
+  let diff = runDiff terms'
+  pure $ renderer (fromMaybe . emptySourceBlob <$> paths <*> blobs) diff
+  where
+    renderer = sExpression TreeOnly
+    runDiff :: HasField fields Category => Both (Maybe (Term (Syntax Text) (Record fields))) -> Diff (Syntax Text) (Record fields)
+    runDiff terms = case runJoin terms of
+      (Just left, Nothing) -> pure $ Delete left
+      (Nothing, Just right) -> pure $ Insert right
+      (Just left, Just right) -> stripDiff (runBothWith diffTerms (fmap decorate (both left right)))
+      _ -> error "nothing to diff"
+      where
+        decorate = defaultFeatureVectorDecorator getLabel
+        getLabel :: HasField fields Category => TermF (Syntax Text) (Record fields) a -> (Category, Maybe Text)
+        getLabel (h :< t) = (Info.category h, case t of
+          Leaf s -> Just s
+          _ -> Nothing)
+
+-- | Returns an s-expression parse tree for the specified FilePath.
+parseFile :: FilePath -> IO ByteString
+parseFile path = do
+  source <- readFileToUnicode path
+  term <- parseBlob $ sourceBlob source path
+  pure $ printTerm term 0 TreeOnly
+
+parseBlob :: SourceBlob -> IO (Term (Syntax Text) (Record DefaultFields))
+parseBlob blob@SourceBlob{..} = parserForFilePath path blob
+
+-- | Read a file to a SourceBlob
+readFileToSourceBlob :: FilePath -> IO (Maybe SourceBlob)
+readFileToSourceBlob path = do
+  source <- (Just <$> readFileToUnicode path) `catch` (const (pure Nothing) :: IOException -> IO (Maybe Source))
+  pure $ flip sourceBlob path <$> source
+
+-- | Read a file, convert it's contents unicode and return it wrapped in Source.
 readFileToUnicode :: FilePath -> IO Source
 readFileToUnicode path = B.readFile path >>= transcode
   where