Overhaul catFile.

semantic.cabal

@@ -68,6 +68,7 @@ common dependencies
                      , semilattices ^>= 0.0.0.3
                      , shelly >= 1.5 && <2
                      , streaming ^>= 0.2.2.0
+                     , streaming-bytestring ^>= 0.1.6
                      , text ^>= 1.2.3.1
                      , these >= 0.7 && <1
                      , unix ^>= 2.7.2.2
@@ -311,6 +312,7 @@ library
                      , semantic-tags ^>= 0
                      , semigroupoids ^>= 5.3.2
                      , split ^>= 0.2.3.3
+                     , streaming-process ^>= 0.1
                      , stm-chans ^>= 3.0.0.4
                      , template-haskell ^>= 2.14
                      , time ^>= 1.8.0.2
@@ -410,15 +412,16 @@ test-suite parse-examples
                      , foldl ^>= 1.4.5
                      , resourcet ^>= 1.2
                      , streaming
-                     , streaming-bytestring ^>= 0.1.6
+                     , streaming-bytestring
                      , tasty
                      , tasty-hunit
 
 benchmark evaluation
   import:              haskell, dependencies, executable-flags
-  hs-source-dirs:      bench/evaluation
+  hs-source-dirs:      bench
   type:                exitcode-stdio-1.0
   main-is:             Main.hs
+  other-modules:       Evaluation
   ghc-options:         -static
   build-depends:       base
                      , algebraic-graphs

src/Data/Blob/IO.hs

@@ -58,7 +58,7 @@ readBlobsFromGitRepo path oid excludePaths includePaths = liftIO . fmap catMaybe
       , not (pathIsMinified path)
       , path `notElem` excludePaths
       , null includePaths || path `elem` includePaths
-      = Just . sourceBlob' path lang oid . Source.fromText <$> Git.catFile gitDir oid
+      = Just . sourceBlob' path lang oid <$> Git.catFile gitDir oid
     blobFromTreeEntry _ _ = pure Nothing
 
     sourceBlob' filepath language (Git.OID oid) source = makeBlob source filepath language oid

src/Semantic/Git.hs

@@ -15,23 +15,34 @@ module Semantic.Git
   , parseEntry
   ) where
 
-import Control.Monad.IO.Class
-import Data.Attoparsec.Text   (Parser)
-import Data.Attoparsec.Text   as AP
-import Data.Char
-import Data.Either            (fromRight)
-import Data.Text              as Text
-import Shelly                 hiding (FilePath)
+import Prologue
+
+import           Data.Attoparsec.Text (Parser)
+import           Data.Attoparsec.Text as AP
+import qualified Data.ByteString.Streaming as ByteStream
+import           Data.Char
+import           Data.Either (fromRight)
+import           Data.Text as Text
+import           Shelly hiding (FilePath)
+import           Streaming hiding (run)
+import qualified Streaming.Process
+import           System.Exit
+import qualified System.Process as Process (proc)
+import qualified Source.Source as Source
 
 -- | git clone --bare
 clone :: Text -> FilePath -> IO ()
 clone url path = sh $ do
   run_ "git" ["clone", "--bare", url, pack path]
 
--- | git cat-file -p
-catFile :: FilePath -> OID -> IO Text
-catFile gitDir (OID oid) = sh $ do
-  run "git" ["-C", pack gitDir, "cat-file", "-p", oid]
+-- | Runs @git cat-file -p@. Throws 'ProcessExitedUnsuccessfully' if the
+-- underlying git command returns a nonzero exit code. Loads the contents
+-- of the file into memory all at once and strictly.
+catFile :: FilePath -> OID -> IO Source.Source
+catFile gitDir (OID oid) =
+  let process = Process.proc "git" ["-C", gitDir, "cat-file", "-p", Text.unpack oid]
+      consumeStdout stream = Streaming.Process.withProcessOutput stream ByteStream.toStrict_
+  in Source.fromUTF8 <$> Streaming.Process.withStreamProcess process consumeStdout
 
 -- | git ls-tree -rz
 lsTree :: FilePath -> OID -> IO [TreeEntry]