use String not Text

On second thought, git passes filepaths, which may not be valid utf8, so
can't use Text here.

String will be a little bit slower, but not enough to worry about.
This commit is contained in:
Joey Hess 2018-08-13 13:37:56 -04:00
parent c9866c7612
commit d963d40815
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 34 additions and 38 deletions

View file

@ -6,14 +6,13 @@
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings, LambdaCase #-}
{-# LANGUAGE LambdaCase #-}
module Git.Protocol.LongRunningProcess where
import Git.Protocol.PktLine
import qualified Data.Text as T
import Data.ByteString.Builder
import Data.List
import Data.Monoid
import Control.Applicative
import System.IO
@ -21,31 +20,30 @@ import System.IO
data ClientServer = Client | Server
deriving (Show)
clientServerSuffix :: ClientServer -> T.Text
clientServerSuffix :: ClientServer -> String
clientServerSuffix Client = "-client"
clientServerSuffix Server = "-server"
data Role = Role ClientServer T.Text
data Role = Role ClientServer String
deriving (Show)
parseRole :: T.Text -> Maybe Role
parseRole t = go Client <|> go Server
parseRole :: String -> Maybe Role
parseRole s = go Client <|> go Server
where
go cs =
let suffix = clientServerSuffix cs
in if suffix `T.isSuffixOf` t
in if suffix `isSuffixOf` s
then Just $ Role cs $
T.take (T.length t - T.length suffix) t
take (length s - length suffix) s
else Nothing
pktRole :: PktLine -> Maybe Role
pktRole = either (const Nothing) parseRole
. pktLineText
pktRole = parseRole . pktLineString
rolePkt :: Role -> Maybe PktLine
rolePkt (Role cs t) = textPktLine $ t <> clientServerSuffix cs
rolePkt (Role cs t) = stringPktLine $ t <> clientServerSuffix cs
newtype Capability = Capability { fromCapability :: T.Text }
newtype Capability = Capability { fromCapability :: String }
deriving (Show, Eq)
pktCapability :: PktLine -> Maybe Capability
@ -54,7 +52,7 @@ pktCapability = parseKV "capability" Capability
capabilityPkt :: Capability -> Maybe PktLine
capabilityPkt = formatKV "capability" fromCapability
newtype Version = Version { fromVersion :: T.Text }
newtype Version = Version { fromVersion :: String }
deriving (Show, Eq)
pktVersion :: PktLine -> Maybe Version
@ -126,15 +124,15 @@ handshake selectrole selectcapability input output =
sendpkts capabilityPkt mycaps $
cnt mycaps
formatKV :: T.Text -> (v -> T.Text ) -> v -> Maybe PktLine
formatKV k f v = textPktLine $ k <> "=" <> f v
formatKV :: String -> (v -> String) -> v -> Maybe PktLine
formatKV k f v = stringPktLine $ k <> "=" <> f v
parseKV :: T.Text -> (T.Text -> v) -> PktLine -> Maybe v
parseKV k mkv = either (const Nothing) go . pktLineText
parseKV :: String -> (String -> v) -> PktLine -> Maybe v
parseKV k mkv = go . pktLineString
where
kprefix = k <> "="
go t
| kprefix `T.isPrefixOf` t = Just $ mkv $
T.drop (T.length kprefix) t
| kprefix `isPrefixOf` t = Just $ mkv $
drop (length kprefix) t
| otherwise = Nothing

View file

@ -11,8 +11,8 @@
module Git.Protocol.PktLine (
PktLine,
flushPkt,
textPktLine,
pktLineText,
stringPktLine,
pktLineString,
streamPktLine,
encodePktLine,
parsePktLine,
@ -28,13 +28,13 @@ import Data.Attoparsec.ByteString as A
import Data.Attoparsec.ByteString.Char8 as A
import Data.Attoparsec.ByteString.Lazy as AL
import Data.ByteString.Builder
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.Text.Encoding.Error as E
import Data.Monoid
import Data.Word
import System.IO
import Utility.PartialPrelude
import Utility.FileSystemEncoding
-- | A pkt-line encodes a variable length binary string with a maximum size.
--
-- This module only exports smart constructors for legal pkt-lines.
@ -55,26 +55,24 @@ maxPktLineLength = 65520
flushPkt :: PktLine
flushPkt = PktLine S.empty
-- | Encodes a Text as a PktLine. Fails if the Text it too large.
-- | Encodes a String as a PktLine. Fails if the String is too large.
--
-- A trailing newline is included after it, as the protocol recommends
-- doing for non-binary data.
textPktLine :: T.Text -> Maybe PktLine
textPktLine t =
let b = E.encodeUtf8 t <> "\n"
stringPktLine :: String -> Maybe PktLine
stringPktLine s =
let b = encodeBSS s <> "\n"
in if S.length b > fromIntegral maxPktLineContent
then Nothing
else Just (PktLine b)
-- | Extracts Text from a PktLine. Any trailing newline is removed.
pktLineText :: PktLine -> Either E.UnicodeException T.Text
pktLineText (PktLine b) = case E.decodeUtf8' b of
Left e -> Left e
Right t ->
let (t', end) = T.splitAt (T.length t - 1) t
in if end == "\n"
then Right t'
else Right t
-- | Extracts a String from a PktLine. Any trailing newline is removed.
pktLineString :: PktLine -> String
pktLineString (PktLine b) =
let s = decodeBSS b
in if end s == "\n"
then beginning s
else s
-- | Creates a stream of PktLines encoding a lazy ByteString of any size.
-- Note that the stream is not terminated with a flushPkt.