{-# LANGUAGE BangPatterns #-}
module Hpp.String (
stringify
, unquote
, stripAngleBrackets
, trimSpaces
, breakOn
, cons
)
where
import Data.Char (isSpace)
import Data.List (isPrefixOf, find)
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
unquote :: String -> String
unquote :: String -> String
unquote = Char -> Char -> String -> String
stripEnds Char
'"' Char
'"'
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
trimSpaces :: String -> String
trimSpaces :: String -> String
trimSpaces = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
trimEnd Char -> Bool
isSpace
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)
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 #-}
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