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:
parent
c9866c7612
commit
d963d40815
2 changed files with 34 additions and 38 deletions
|
@ -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
|
||||
|
||||
|
|
|
@ -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.
|
||||
|
|
Loading…
Add table
Reference in a new issue