1
1
mirror of https://github.com/github/semantic.git synced 2024-12-25 07:55:12 +03:00

Merge pull request #312 from github/remove-shelly

Remove shelly in favor of streaming-bytestring and utf8-string.
This commit is contained in:
Patrick Thomson 2019-10-08 17:58:59 -04:00 committed by GitHub
commit 2036569a09
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 45 additions and 29 deletions

View File

@ -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
@ -291,10 +290,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
@ -363,6 +364,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

View File

@ -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

View File

@ -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)
@ -200,7 +201,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

View File

@ -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