{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, OverloadedStrings,
             PatternSynonyms, TypeSynonymInstances, ViewPatterns #-}
-- | Defines a signature, 'Stringy', for string-like types that we may
-- want to use.
module Hpp.StringSig where
import Data.Char
import qualified Data.List as L
import Data.Maybe (isJust)
#if __GLASGOW_HASKELL__ < 804
import Data.Semigroup (Semigroup)
#endif
import Data.String (IsString)
import qualified Hpp.String as S
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as BL
import System.IO (Handle, hPutStr)

data CharOrSub s = CharMatch !s !s | SubMatch !s !s | NoMatch

-- | A collection of operations relating to sequences of characters.
class (IsString s, Monoid s, Semigroup s) => Stringy s where
  -- | Stringification puts double quotes around a string and
  -- backslashes before existing double quote characters and backslash
  -- characters.
  stringify :: s -> s

  -- | Remove double quote characters from the ends of a string.
  unquote :: s -> s

  -- | Trim trailing spaces from a 'String'
  trimSpaces :: s -> s

  -- | Similar to the function of the same name in the @text@ package.
  --
  -- @breakOn needles haystack@ finds the first instance of an element
  -- of @needles@ in @haystack@. The first component of the result is
  -- the needle tag, the second component is the prefix of @haystack@
  -- before the matched needle, the third component is the remainder of
  -- the @haystack@ /after/ the needle..
  breakOn :: [(s,t)] -> s -> Maybe (t, s, s)

  -- | A special case of 'breakOn' in which we are looking for either
  -- a special character or a particular substring.
  breakCharOrSub :: Char -> s -> s -> CharOrSub s
  cons :: Char -> s -> s
  uncons :: s -> Maybe (Char, s)
  snoc :: s -> Char -> s
  unsnoc :: s -> Maybe (s, Char)
  sdrop :: Int -> s -> s
  sbreak :: (Char -> Maybe t) -> s -> Maybe (t,s,s)
  sall :: (Char -> Bool) -> s -> Bool
  sIsPrefixOf :: s -> s -> Bool
  isEmpty :: s -> Bool
  readLines :: FilePath -> IO [s]
  putStringy :: Handle -> s -> IO ()
  toChars :: s -> [Char]
  -- | An opportunity to copy a string to its own storage to help with GC
  copy :: s -> s

instance Stringy String where
  stringify :: String -> String
stringify = String -> String
S.stringify
  {-# INLINE stringify #-}
  unquote :: String -> String
unquote = String -> String
S.unquote
  {-# INLINE unquote  #-}
  trimSpaces :: String -> String
trimSpaces = String -> String
S.trimSpaces
  {-# INLINE trimSpaces #-}
  breakOn :: [(String, t)] -> String -> Maybe (t, String, String)
breakOn = [(String, t)] -> String -> Maybe (t, String, String)
forall t. [(String, t)] -> String -> Maybe (t, String, String)
S.breakOn
  {-# INLINE breakOn #-}
  breakCharOrSub :: Char -> String -> String -> CharOrSub String
breakCharOrSub Char
c String
sub String
str =
    case [(String, Bool)] -> String -> Maybe (Bool, String, String)
forall t. [(String, t)] -> String -> Maybe (t, String, String)
S.breakOn [([Char
c], Bool
True), (String
sub, Bool
False)] String
str of
      Maybe (Bool, String, String)
Nothing -> CharOrSub String
forall s. CharOrSub s
NoMatch
      Just (Bool
True, String
pre, String
pos) -> String -> String -> CharOrSub String
forall s. s -> s -> CharOrSub s
CharMatch String
pre String
pos
      Just (Bool
False, String
pre, String
pos) -> String -> String -> CharOrSub String
forall s. s -> s -> CharOrSub s
SubMatch String
pre String
pos
  {-# INLINE breakCharOrSub #-}
  cons :: Char -> String -> String
cons = Char -> String -> String
forall a. a -> [a] -> [a]
S.cons
  {-# INLINE cons #-}
  uncons :: String -> Maybe (Char, String)
uncons = String -> Maybe (Char, String)
forall a. [a] -> Maybe (a, [a])
L.uncons
  {-# INLINE uncons #-}
  snoc :: String -> Char -> String
snoc String
s Char
c = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c]
  {-# INLINE snoc #-}
  unsnoc :: String -> Maybe (String, Char)
unsnoc [] = Maybe (String, Char)
forall a. Maybe a
Nothing
  unsnoc String
s = (String, Char) -> Maybe (String, Char)
forall a. a -> Maybe a
Just (String -> String
forall a. [a] -> [a]
init String
s, String -> Char
forall a. [a] -> a
last String
s)
  {-# INLINE unsnoc #-}
  sdrop :: Int -> String -> String
sdrop = Int -> String -> String
forall a. Int -> [a] -> [a]
drop
  {-# INLINE sdrop #-}
  sbreak :: (Char -> Maybe t) -> String -> Maybe (t, String, String)
sbreak Char -> Maybe t
_ [] =  Maybe (t, String, String)
forall a. Maybe a
Nothing
  sbreak Char -> Maybe t
p (Char
x:String
xs') =
    case Char -> Maybe t
p Char
x of
      Maybe t
Nothing -> let res :: Maybe (t, String, String)
res = (Char -> Maybe t) -> String -> Maybe (t, String, String)
forall s t. Stringy s => (Char -> Maybe t) -> s -> Maybe (t, s, s)
sbreak Char -> Maybe t
p String
xs' in ((t, String, String) -> (t, String, String))
-> Maybe (t, String, String) -> Maybe (t, String, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> String) -> (t, String, String) -> (t, String, String)
forall t b a c. (t -> b) -> (a, t, c) -> (a, b, c)
_2 (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:)) Maybe (t, String, String)
res
      Just t
t -> (t, String, String) -> Maybe (t, String, String)
forall a. a -> Maybe a
Just (t
t, [], String
xs')
    where _2 :: (t -> b) -> (a, t, c) -> (a, b, c)
_2 t -> b
f (a
a,t
b,c
c) = (a
a, t -> b
f t
b, c
c)
  {-# INLINE sbreak #-}
  sall :: (Char -> Bool) -> String -> Bool
sall = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
  {-# INLINE sall #-}
  sIsPrefixOf :: String -> String -> Bool
sIsPrefixOf = String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
L.isPrefixOf
  isEmpty :: String -> Bool
isEmpty = String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
  {-# INLINE isEmpty #-}
  readLines :: String -> IO [String]
readLines = (String -> [String]) -> IO String -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> [String]
lines (IO String -> IO [String])
-> (String -> IO String) -> String -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
readFile
  putStringy :: Handle -> String -> IO ()
putStringy = Handle -> String -> IO ()
hPutStr
  toChars :: String -> String
toChars = String -> String
forall a. a -> a
id
  copy :: String -> String
copy = String -> String
forall a. a -> a
id

instance Stringy B.ByteString where
  stringify :: ByteString -> ByteString
stringify ByteString
s = Char -> ByteString -> ByteString
B.cons Char
'"' (ByteString -> Char -> ByteString
B.snoc ((Char -> ByteString) -> ByteString -> ByteString
B.concatMap Char -> ByteString
aux (ByteString -> ByteString
strip ByteString
s)) Char
'"')
    where aux :: Char -> ByteString
aux Char
'\\' = ByteString
"\\\\"
          aux Char
'"' = ByteString
"\\\""
          aux Char
c = Char -> ByteString
B.singleton Char
c
          strip :: ByteString -> ByteString
strip = ByteString -> ByteString
forall s. Stringy s => s -> s
trimSpaces (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
B.dropWhile Char -> Bool
isSpace
  {-# INLINE stringify #-}
  unquote :: ByteString -> ByteString
unquote ByteString
s = let s' :: ByteString
s' = case ByteString -> Maybe (Char, ByteString)
B.uncons ByteString
s of
                         Maybe (Char, ByteString)
Nothing -> ByteString
s
                         Just (Char
c, ByteString
rst) -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' then ByteString
rst else ByteString
s
              in case ByteString -> Maybe (ByteString, Char)
B.unsnoc ByteString
s' of
                   Maybe (ByteString, Char)
Nothing -> ByteString
s'
                   Just (ByteString
ini, Char
c) -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' then ByteString
ini else ByteString
s'
  {-# INLINE unquote #-}
  trimSpaces :: ByteString -> ByteString
trimSpaces ByteString
s = let go :: Int -> Int
go !Int
i = if Char -> Bool
isSpace (ByteString -> Int -> Char
B.index ByteString
s Int
i)
                             then Int -> Int
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                             else ByteString -> Int
B.length ByteString
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                 in Int -> ByteString -> ByteString
B.drop (Int -> Int
go (ByteString -> Int
B.length ByteString
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) ByteString
s
  {-# INLINE trimSpaces #-}
  breakOn :: [(ByteString, t)]
-> ByteString -> Maybe (t, ByteString, ByteString)
breakOn [!(!ByteString
n1,!t
t1)] ByteString
haystack =
    case ByteString -> ByteString -> (ByteString, ByteString)
B.breakSubstring ByteString
n1 ByteString
haystack of
      (ByteString
pre,ByteString
pos) | ByteString -> Bool
B.null ByteString
pos -> Maybe (t, ByteString, ByteString)
forall a. Maybe a
Nothing
                | Bool
otherwise -> (t, ByteString, ByteString) -> Maybe (t, ByteString, ByteString)
forall a. a -> Maybe a
Just (t
t1, ByteString
pre, Int -> ByteString -> ByteString
B.drop (ByteString -> Int
B.length ByteString
n1) ByteString
pos)

  breakOn [!(!ByteString
n1, !t
t1), !(ByteString
n2, !t
t2)] ByteString
haystack = Int -> ByteString -> Maybe (t, ByteString, ByteString)
go2 Int
0 ByteString
haystack
    where go2 :: Int -> ByteString -> Maybe (t, ByteString, ByteString)
go2 !Int
i !ByteString
h
            | ByteString -> Bool
B.null ByteString
h = Maybe (t, ByteString, ByteString)
forall a. Maybe a
Nothing
            | ByteString -> ByteString -> Bool
B.isPrefixOf ByteString
n1 ByteString
h = let !h' :: ByteString
h' = Int -> ByteString -> ByteString
B.drop (ByteString -> Int
B.length ByteString
n1) ByteString
h
                                      !pre :: ByteString
pre = Int -> ByteString -> ByteString
B.take Int
i ByteString
haystack
                                  in (t, ByteString, ByteString) -> Maybe (t, ByteString, ByteString)
forall a. a -> Maybe a
Just (t
t1, ByteString
pre, ByteString
h')
            | ByteString -> ByteString -> Bool
B.isPrefixOf ByteString
n2 ByteString
h = let !h' :: ByteString
h' = Int -> ByteString -> ByteString
B.drop (ByteString -> Int
B.length ByteString
n2) ByteString
h
                                      !pre :: ByteString
pre = Int -> ByteString -> ByteString
B.take Int
i ByteString
haystack
                                  in (t, ByteString, ByteString) -> Maybe (t, ByteString, ByteString)
forall a. a -> Maybe a
Just (t
t2, ByteString
pre, ByteString
h')
            | Bool
otherwise = Int -> ByteString -> Maybe (t, ByteString, ByteString)
go2 (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (ByteString -> ByteString
B.tail ByteString
h)
  breakOn [!(!ByteString
n1, !t
t1), !(ByteString
n2, !t
t2), !(!ByteString
n3, !t
t3)] ByteString
haystack = Int -> ByteString -> Maybe (t, ByteString, ByteString)
go3 Int
0 ByteString
haystack
    where go3 :: Int -> ByteString -> Maybe (t, ByteString, ByteString)
go3 !Int
i !ByteString
h
            | ByteString -> Bool
B.null ByteString
h = Maybe (t, ByteString, ByteString)
forall a. Maybe a
Nothing
            | ByteString -> ByteString -> Bool
B.isPrefixOf ByteString
n1 ByteString
h = let h' :: ByteString
h' = Int -> ByteString -> ByteString
B.drop (ByteString -> Int
B.length ByteString
n1) ByteString
h
                                  in (t, ByteString, ByteString) -> Maybe (t, ByteString, ByteString)
forall a. a -> Maybe a
Just (t
t1, Int -> ByteString -> ByteString
B.take Int
i ByteString
haystack, ByteString
h')
            | ByteString -> ByteString -> Bool
B.isPrefixOf ByteString
n2 ByteString
h = let h' :: ByteString
h' = Int -> ByteString -> ByteString
B.drop (ByteString -> Int
B.length ByteString
n2) ByteString
h
                                  in (t, ByteString, ByteString) -> Maybe (t, ByteString, ByteString)
forall a. a -> Maybe a
Just (t
t2, Int -> ByteString -> ByteString
B.take Int
i ByteString
haystack, ByteString
h')
            | ByteString -> ByteString -> Bool
B.isPrefixOf ByteString
n3 ByteString
h = let h' :: ByteString
h' = Int -> ByteString -> ByteString
B.drop (ByteString -> Int
B.length ByteString
n3) ByteString
h
                                  in (t, ByteString, ByteString) -> Maybe (t, ByteString, ByteString)
forall a. a -> Maybe a
Just (t
t3, Int -> ByteString -> ByteString
B.take Int
i ByteString
haystack, ByteString
h')
            | Bool
otherwise = Int -> ByteString -> Maybe (t, ByteString, ByteString)
go3 (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (ByteString -> ByteString
B.tail ByteString
h)
  breakOn [(ByteString, t)]
needles ByteString
haystack = Int -> ByteString -> Maybe (t, ByteString, ByteString)
go Int
0 ByteString
haystack
    where go :: Int -> ByteString -> Maybe (t, ByteString, ByteString)
go !Int
i !ByteString
h
            | ByteString -> Bool
B.null ByteString
h = Maybe (t, ByteString, ByteString)
forall a. Maybe a
Nothing
            | Bool
otherwise =
              case ((ByteString, t) -> Bool)
-> [(ByteString, t)] -> Maybe (ByteString, t)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((ByteString -> ByteString -> Bool)
-> ByteString -> ByteString -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> ByteString -> Bool
B.isPrefixOf ByteString
h (ByteString -> Bool)
-> ((ByteString, t) -> ByteString) -> (ByteString, t) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, t) -> ByteString
forall a b. (a, b) -> a
fst) [(ByteString, t)]
needles of
                Maybe (ByteString, t)
Nothing -> Int -> ByteString -> Maybe (t, ByteString, ByteString)
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (ByteString -> ByteString
B.tail ByteString
h)
                Just (ByteString
n,t
tag) -> let h' :: ByteString
h' = Int -> ByteString -> ByteString
B.drop (ByteString -> Int
B.length ByteString
n ) ByteString
h
                                in (t, ByteString, ByteString) -> Maybe (t, ByteString, ByteString)
forall a. a -> Maybe a
Just (t
tag, Int -> ByteString -> ByteString
B.take Int
i ByteString
haystack, ByteString
h')
  {-# INLINE breakOn #-}
  breakCharOrSub :: Char -> ByteString -> ByteString -> CharOrSub ByteString
breakCharOrSub Char
c ByteString
sub ByteString
str =
    case Char -> ByteString -> Maybe Int
B.elemIndex Char
c ByteString
str of
      Maybe Int
Nothing -> case ByteString -> ByteString -> (ByteString, ByteString)
B.breakSubstring ByteString
sub ByteString
str of
                   (ByteString
pre,ByteString
pos)
                     | ByteString -> Bool
B.null ByteString
pos -> CharOrSub ByteString
forall s. CharOrSub s
NoMatch
                     | Bool
otherwise -> ByteString -> ByteString -> CharOrSub ByteString
forall s. s -> s -> CharOrSub s
SubMatch ByteString
pre (Int -> ByteString -> ByteString
B.drop (ByteString -> Int
B.length ByteString
sub) ByteString
pos)
      Just Int
i ->
        case ByteString -> ByteString -> (ByteString, ByteString)
B.breakSubstring ByteString
sub ByteString
str of
          (ByteString
pre,ByteString
pos)
            | ByteString -> Bool
B.null ByteString
pos -> ByteString -> ByteString -> CharOrSub ByteString
forall s. s -> s -> CharOrSub s
CharMatch (Int -> ByteString -> ByteString
B.take Int
i ByteString
str) (Int -> ByteString -> ByteString
B.drop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ByteString
str)
            | ByteString -> Int
B.length ByteString
pre Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i -> ByteString -> ByteString -> CharOrSub ByteString
forall s. s -> s -> CharOrSub s
SubMatch ByteString
pre (Int -> ByteString -> ByteString
B.drop (ByteString -> Int
B.length ByteString
sub) ByteString
pos)
            | Bool
otherwise -> ByteString -> ByteString -> CharOrSub ByteString
forall s. s -> s -> CharOrSub s
CharMatch (Int -> ByteString -> ByteString
B.take Int
i ByteString
str) (Int -> ByteString -> ByteString
B.drop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ByteString
str)

  {-# INLINE breakCharOrSub #-}
  cons :: Char -> ByteString -> ByteString
cons = Char -> ByteString -> ByteString
B.cons
  uncons :: ByteString -> Maybe (Char, ByteString)
uncons = ByteString -> Maybe (Char, ByteString)
B.uncons
  snoc :: ByteString -> Char -> ByteString
snoc = ByteString -> Char -> ByteString
B.snoc
  unsnoc :: ByteString -> Maybe (ByteString, Char)
unsnoc = ByteString -> Maybe (ByteString, Char)
B.unsnoc
  sdrop :: Int -> ByteString -> ByteString
sdrop = Int -> ByteString -> ByteString
B.drop (Int -> ByteString -> ByteString)
-> (Int -> Int) -> Int -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  sbreak :: (Char -> Maybe t)
-> ByteString -> Maybe (t, ByteString, ByteString)
sbreak Char -> Maybe t
f ByteString
s = case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
B.break (Maybe t -> Bool
forall a. Maybe a -> Bool
isJust (Maybe t -> Bool) -> (Char -> Maybe t) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe t
f) ByteString
s of
                 (ByteString
h,ByteString
t) -> case ByteString -> Maybe (Char, ByteString)
B.uncons ByteString
t of
                            Maybe (Char, ByteString)
Nothing -> Maybe (t, ByteString, ByteString)
forall a. Maybe a
Nothing
                            Just (Char
c,ByteString
t') -> (t -> (t, ByteString, ByteString))
-> Maybe t -> Maybe (t, ByteString, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\t
r -> (t
r,ByteString
h,ByteString
t')) (Char -> Maybe t
f Char
c)
  {-# INLINE sbreak #-}
  sall :: (Char -> Bool) -> ByteString -> Bool
sall = (Char -> Bool) -> ByteString -> Bool
B.all
  sIsPrefixOf :: ByteString -> ByteString -> Bool
sIsPrefixOf = ByteString -> ByteString -> Bool
B.isPrefixOf
  isEmpty :: ByteString -> Bool
isEmpty = ByteString -> Bool
B.null
  readLines :: String -> IO [ByteString]
readLines = (ByteString -> [ByteString]) -> IO ByteString -> IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
stripR ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
BL.toStrict ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.lines) (IO ByteString -> IO [ByteString])
-> (String -> IO ByteString) -> String -> IO [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ByteString
BL.readFile
  {-# INLINE readLines #-}
  putStringy :: Handle -> ByteString -> IO ()
putStringy = Handle -> ByteString -> IO ()
B.hPutStr
  toChars :: ByteString -> String
toChars = ByteString -> String
B.unpack
  copy :: ByteString -> ByteString
copy = ByteString -> ByteString
B.copy

boolJust :: Bool -> Maybe ()
boolJust :: Bool -> Maybe ()
boolJust Bool
True = () -> Maybe ()
forall a. a -> Maybe a
Just ()
boolJust Bool
False = Maybe ()
forall a. Maybe a
Nothing
{-# INLINE boolJust #-}

predicateJust :: (a -> Bool) -> a -> Maybe a
predicateJust :: (a -> Bool) -> a -> Maybe a
predicateJust a -> Bool
f a
c = if a -> Bool
f a
c then a -> Maybe a
forall a. a -> Maybe a
Just a
c else Maybe a
forall a. Maybe a
Nothing
{-# INLINE predicateJust #-}

sdropWhile :: Stringy s => (Char -> Bool) -> s -> s
sdropWhile :: (Char -> Bool) -> s -> s
sdropWhile Char -> Bool
f s
s = case (Char -> Maybe ()) -> s -> Maybe ((), s, s)
forall s t. Stringy s => (Char -> Maybe t) -> s -> Maybe (t, s, s)
sbreak (Bool -> Maybe ()
boolJust (Bool -> Maybe ()) -> (Char -> Bool) -> Char -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
f) s
s of
                   Maybe ((), s, s)
Nothing -> s
s
                   Just (()
_, s
_, s
s') -> s
s'
{-# INLINE sdropWhile #-}

stripR :: ByteString -> ByteString
stripR :: ByteString -> ByteString
stripR ByteString
bs
  | Bool -> Bool
not (ByteString -> Bool
B.null ByteString
bs) Bool -> Bool -> Bool
&& ByteString -> Char
B.last ByteString
bs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' = ByteString -> ByteString
B.init ByteString
bs
  | Bool
otherwise = ByteString
bs
{-# INLINE stripR #-}

#if __GLASGOW_HASKELL__ >= 800
pattern (:.) :: Stringy s => Char -> s -> s
#else
pattern (:.) :: () => Stringy s => Char -> s -> s
#endif
pattern x $b:. :: Char -> s -> s
$m:. :: forall r s. Stringy s => s -> (Char -> s -> r) -> (Void# -> r) -> r
:. xs <- (uncons -> Just (x,xs)) where
  Char
x:.s
xs = Char -> s -> s
forall s. Stringy s => Char -> s -> s
cons Char
x s
xs
infixr 5 :.

#if __GLASGOW_HASKELL__ >= 800
pattern Nil :: Stringy s => s
#else
pattern Nil :: () => Stringy s => s
#endif
pattern $bNil :: s
$mNil :: forall r s. Stringy s => s -> (Void# -> r) -> (Void# -> r) -> r
Nil <- (isEmpty -> True) where
  Nil = s
forall a. Monoid a => a
mempty