{-# LANGUAGE BangPatterns #-}
-- | HELPERS for working with 'String's
module Hpp.String (
  stringify
  , unquote
  , stripAngleBrackets
  , trimSpaces
  , breakOn
  , cons
  )
  where
import Data.Char (isSpace)
import Data.List (isPrefixOf, find)

-- | Stringification puts double quotes around a string and
-- backslashes before existing double quote characters and backslash
-- characters.
stringify :: String -> String
stringify :: String -> String
stringify String
s = Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
aux (String -> String
strip String
s) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
  where aux :: Char -> String
aux Char
'\\' = String
"\\\\"
        aux Char
'"' = String
"\\\""
        aux Char
c = [Char
c]
        strip :: String -> String
strip = String -> String
trimSpaces (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace

-- | Remove double quote characters from the ends of a string.
unquote :: String -> String
unquote :: String -> String
unquote = Char -> Char -> String -> String
stripEnds Char
'"' Char
'"'

-- | Remove angle brackets from the ends of a string.
stripAngleBrackets :: String -> String
stripAngleBrackets :: String -> String
stripAngleBrackets = Char -> Char -> String -> String
stripEnds Char
'<' Char
'>'

stripEnds :: Char -> Char -> String -> String
stripEnds :: Char -> Char -> String -> String
stripEnds Char
start Char
end String
s =
  case String
s of
    (Char
start':String
rest)
      | Char
start Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
start' -> String -> String
go String
rest
    String
_ -> String
s
  where go :: String -> String
go (Char
c:[])
          | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
end = []
        go [] = []
        go (Char
c:String
cs) = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
cs

-- | Trim trailing spaces from a 'String'
trimSpaces :: String -> String
trimSpaces :: String -> String
trimSpaces = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
trimEnd Char -> Bool
isSpace

-- | Remove a suffix of a list all of whose elements satisfy the given
-- predicate.
trimEnd :: (a -> Bool) -> [a] -> [a]
trimEnd :: (a -> Bool) -> [a] -> [a]
trimEnd a -> Bool
p = ([a] -> [a]) -> [a] -> [a]
go [a] -> [a]
forall a. a -> a
id
  where go :: ([a] -> [a]) -> [a] -> [a]
go [a] -> [a]
_ [] = []
        go [a] -> [a]
acc (a
c:[a]
cs)
          | a -> Bool
p a
c = ([a] -> [a]) -> [a] -> [a]
go ([a] -> [a]
acc ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
ca -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) [a]
cs
          | Bool
otherwise = [a] -> [a]
acc (a
c a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ([a] -> [a]) -> [a] -> [a]
go [a] -> [a]
forall a. a -> a
id [a]
cs)

-- | 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 :: [(String,t)] -> String -> Maybe (t, String, String)
breakOn :: [(String, t)] -> String -> Maybe (t, String, String)
breakOn [(String, t)]
needles String
haystack = Int -> String -> Maybe (t, String, String)
go Int
0 String
haystack
  where go :: Int -> String -> Maybe (t, String, String)
go Int
_ [] = Maybe (t, String, String)
forall a. Maybe a
Nothing
        go !Int
i xs :: String
xs@(Char
_:String
xs') =
          case ((String, t) -> Bool) -> [(String, t)] -> Maybe (String, t)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((String -> String -> Bool) -> String -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
xs (String -> Bool) -> ((String, t) -> String) -> (String, t) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, t) -> String
forall a b. (a, b) -> a
fst) [(String, t)]
needles of
            Maybe (String, t)
Nothing -> Int -> String -> Maybe (t, String, String)
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
xs'
            Just (String
n,t
tag) -> (t, String, String) -> Maybe (t, String, String)
forall a. a -> Maybe a
Just (t
tag, Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
i String
haystack, Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
n) String
xs)
{-# INLINE breakOn #-}

-- | Used to make switching to the @text@ package easier.
cons :: a -> [a] -> [a]
cons :: a -> [a] -> [a]
cons a
x [a]
xs = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs