Merge branch 'master' into 🔥-ts-parse

Author: robrix

semantic.cabal

@@ -66,7 +66,6 @@ common dependencies
                      , safe-exceptions ^>= 0.1.7.0
                      , semantic-source ^>= 0.0
                      , semilattices ^>= 0.0.0.3
-                     , shelly >= 1.5 && <2
                      , streaming ^>= 0.2.2.0
                      , streaming-bytestring ^>= 0.1.6
                      , text ^>= 1.2.3.1
@@ -290,10 +289,12 @@ library
                      , semantic-tags ^>= 0
                      , semigroupoids ^>= 5.3.2
                      , split ^>= 0.2.3.3
+                     , streaming-attoparsec ^>= 1.0.0.1
                      , streaming-process ^>= 0.1
                      , stm-chans ^>= 3.0.0.4
                      , template-haskell ^>= 2.14
                      , time ^>= 1.8.0.2
+                     , utf8-string ^>= 1.0.1.1
                      , unliftio-core ^>= 0.1.2.0
                      , unordered-containers ^>= 0.2.9.0
                      , vector ^>= 0.12.0.2
@@ -362,6 +363,7 @@ test-suite test
                      , hspec >= 2.6 && <3
                      , hspec-core >= 2.6 && <3
                      , hspec-expectations ^>= 0.8.2
+                     , shelly >= 1.5 && <2
                      , tasty ^>= 1.2.3
                      , tasty-golden ^>= 2.3.2
                      , tasty-hedgehog ^>= 1.0.0.1

src/Data/Blob/IO.hs

@@ -13,13 +13,14 @@ module Data.Blob.IO
 
 import Prologue
 
-import Data.Blob
-import Data.Language
-import Semantic.IO
-import qualified Source.Source as Source
-import qualified Semantic.Git as Git
 import qualified Control.Concurrent.Async as Async
+import           Data.Blob
 import qualified Data.ByteString as B
+import           Data.Language
+import           Data.Text.Encoding (decodeUtf8)
+import qualified Semantic.Git as Git
+import           Semantic.IO
+import qualified Source.Source as Source
 import qualified System.Path as Path
 import qualified System.Path.PartClass as Part
 
@@ -61,7 +62,7 @@ readBlobsFromGitRepo path oid excludePaths includePaths = liftIO . fmap catMaybe
       = Just . sourceBlob' path lang oid <$> Git.catFile gitDir oid
     blobFromTreeEntry _ _ = pure Nothing
 
-    sourceBlob' filepath language (Git.OID oid) source = makeBlob source filepath language oid
+    sourceBlob' filepath language (Git.OID oid) source = makeBlob source filepath language (decodeUtf8 oid)
 
 readFilePair :: MonadIO m => File -> File -> m BlobPair
 readFilePair a b = do

src/Semantic/CLI.hs

@@ -6,6 +6,7 @@ import           Control.Effect.Reader
 import           Control.Exception as Exc (displayException)
 import           Data.Blob
 import           Data.Blob.IO
+import qualified Data.ByteString.Char8 as B
 import           Data.Handle
 import qualified Data.Language as Language
 import           Data.List (intercalate)
@@ -180,7 +181,7 @@ graphCommand = command "graph" (info graphArgumentsParser (progDesc "Compute a g
 shaReader :: ReadM Git.OID
 shaReader = eitherReader parseSha
   where parseSha arg = if length arg == 40 || arg == "HEAD"
-          then Right (Git.OID (T.pack arg))
+          then Right (Git.OID (B.pack arg))
           else Left (arg <> " is not a valid sha1")
 
 filePathReader :: ReadM File

src/Semantic/Git.hs

@@ -17,62 +17,74 @@ module Semantic.Git
 
 import Prologue
 
-import           Data.Attoparsec.Text (Parser)
-import           Data.Attoparsec.Text as AP
+import           Data.Attoparsec.ByteString (Parser)
+import           Data.Attoparsec.ByteString as AP
+import           Data.ByteString (ByteString)
+import           Data.ByteString.Internal (w2c)
+import qualified Data.ByteString.UTF8 as UTF8
+import qualified Data.ByteString as B
 import qualified Data.ByteString.Streaming as ByteStream
+import qualified Data.Attoparsec.ByteString.Streaming as AP.Streaming
 import           Data.Char
 import           Data.Either (fromRight)
 import           Data.Text as Text
-import           Shelly hiding (FilePath)
+import           Text.Parser.Combinators (sepEndBy)
 import qualified Streaming.Process
-import qualified System.Process as Process (proc)
+import qualified System.Process as Process
 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]
+clone url path = Process.callProcess "git"
+  ["clone", "--bare", Text.unpack url, path]
 
 -- | 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]
+  let process = Process.proc "git" ["-C", gitDir, "cat-file", "-p", UTF8.toString 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]
-lsTree gitDir (OID sha) = sh $ parseEntries <$> run "git" ["-C", pack gitDir, "ls-tree", "-rz", sha]
+lsTree gitDir (OID sha) =
+  let process        = Process.proc "git" ["-C", gitDir, "ls-tree", "-rz", UTF8.toString sha]
+      allEntries     = (entryParser `sepEndBy` AP.word8 0) <* AP.endOfInput
+      ignoreFailures = fmap (fromRight [] . fst)
+  in Streaming.Process.withStreamProcess process $
+     \stream -> Streaming.Process.withProcessOutput stream (ignoreFailures . AP.Streaming.parse allEntries)
 
-sh :: MonadIO m => Sh a -> m a
-sh = shelly . silently
 
 -- | Parses an list of entries separated by \NUL, and on failure return []
-parseEntries :: Text -> [TreeEntry]
+parseEntries :: ByteString -> [TreeEntry]
 parseEntries = fromRight [] . AP.parseOnly everything
   where
-    everything = AP.sepBy entryParser "\NUL" <* "\NUL\n" <* AP.endOfInput
+    everything = AP.sepBy entryParser (AP.word8 0)
 
 -- | Parse the entire input with entryParser, and on failure return a default
 -- For testing purposes only
-parseEntry :: Text -> Either String TreeEntry
+parseEntry :: ByteString -> Either String TreeEntry
 parseEntry = AP.parseOnly (entryParser <* AP.endOfInput)
 
 -- | Parses a TreeEntry
 entryParser :: Parser TreeEntry
 entryParser = TreeEntry
-  <$> modeParser <* AP.char ' '
-  <*> typeParser <* AP.char ' '
-  <*> oidParser <* AP.char '\t'
-  <*> (unpack <$> AP.takeWhile (/= '\NUL'))
+  <$> modeParser <* AP.word8 space
+  <*> typeParser <* AP.word8 space
+  <*> oidParser <* AP.word8 tab
+  <*> (UTF8.toString <$> AP.takeWhile (/= nul))
     where
-      typeParser = AP.choice [BlobObject <$ "blob", TreeObject <$ "tree", OtherObjectType <$ AP.takeWhile isAlphaNum]
-      modeParser = AP.choice [NormalMode <$ "100644", ExecutableMode <$ "100755", SymlinkMode <$ "120000", TreeMode <$ "040000", OtherMode <$ AP.takeWhile isAlphaNum]
-      oidParser = OID <$> AP.takeWhile isHexDigit
+      char = fromIntegral @Int @Word8 . ord
+      space = char ' '
+      tab = char '\t'
+      nul = char '\NUL'
+      typeParser = AP.choice [BlobObject <$ "blob", TreeObject <$ "tree", OtherObjectType <$ AP.takeWhile (isAlphaNum . w2c)]
+      modeParser = AP.choice [NormalMode <$ "100644", ExecutableMode <$ "100755", SymlinkMode <$ "120000", TreeMode <$ "040000", OtherMode <$ AP.takeWhile (isAlphaNum . w2c)]
+      oidParser = OID <$> AP.takeWhile (isHexDigit . w2c)
 
-newtype OID = OID Text
+newtype OID = OID ByteString
   deriving (Eq, Show, Ord)
 
 data ObjectMode