{-# LANGUAGE Safe #-}
module Css3.Selector.Utils (
readIdentifier, encodeIdentifier
, isValidIdentifier, toIdentifier
, readCssString, encodeString, encodeText
) where
import Control.Arrow(first)
import Data.Char(chr, digitToInt, intToDigit, isAsciiLower, isAsciiUpper, isHexDigit, ord)
import Data.Text(Text, cons, pack, singleton, snoc)
import qualified Data.Text as T
_initLast :: [a] -> Maybe ([a], a)
_initLast :: [a] -> Maybe ([a], a)
_initLast [] = Maybe ([a], a)
forall a. Maybe a
Nothing
_initLast (a
a:[a]
as) = ([a], a) -> Maybe ([a], a)
forall a. a -> Maybe a
Just ([a] -> a -> ([a], a)
forall a. [a] -> a -> ([a], a)
go [a]
as a
a)
where go :: [a] -> a -> ([a], a)
go [] a
x = ([], a
x)
go (a
y:[a]
ys) a
x = ([a] -> [a]) -> ([a], a) -> ([a], a)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> a -> ([a], a)
go [a]
ys a
y)
_isQuote :: Char -> Bool
_isQuote :: Char -> Bool
_isQuote Char
'"' = Bool
True
_isQuote Char
'\'' = Bool
True
_isQuote Char
_ = Bool
False
readCssString :: String
-> String
readCssString :: String -> String
readCssString (Char
c:String
xs) | Char -> Bool
_isQuote Char
c = String
f
where f :: String
f | Just (String
vs, Char
c') <- String -> Maybe (String, Char)
forall a. [a] -> Maybe ([a], a)
_initLast String
xs = Char -> String -> String
g Char
c' String
vs
| Bool
otherwise = String
"The string literal should contain at least two quotation marks."
where g :: Char -> String -> String
g Char
c' String
vs | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c' = Char -> String -> String
_readCssString Char
c String
vs
| Bool
otherwise = String
"The start and end quotation mark should be the same."
readCssString String
_ = String -> String
forall a. HasCallStack => String -> a
error String
"The string should start with an \" or ' and end with the same quotation."
_readCssString :: Char -> String -> String
_readCssString :: Char -> String -> String
_readCssString Char
c' = String -> String
go
where go :: String -> String
go [] = []
go (Char
'\\':Char
'\n':String
xs) = String -> String
go String
xs
go (Char
'\\':ca :: String
ca@(Char
c:String
xs)) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c' = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
xs
| Bool
otherwise = let ~(Char
y,String
ys) = String -> (Char, String)
_parseEscape String
ca in Char
y Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
ys
go (Char
x:String
xs) | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c' = String -> String
forall a. HasCallStack => String -> a
error String
"The string can not contain a " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", you should escape it."
| Bool
otherwise = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
xs
readIdentifier :: String
-> String
readIdentifier :: String -> String
readIdentifier = Char -> String -> String
_readCssString Char
'\\'
_notEncode :: Char -> Bool
_notEncode :: Char -> Bool
_notEncode Char
x = Char -> Bool
isAsciiLower Char
x Bool -> Bool -> Bool
|| Char -> Bool
isAsciiUpper Char
x
encodeString :: Char
-> String
-> String
encodeString :: Char -> String -> String
encodeString Char
c' = (Char
c' Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
go
where go :: String -> String
go [] = [Char
c']
go (Char
c:String
cs) | Char -> Bool
_notEncode Char
c = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
cs
| Bool
otherwise = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String -> String
_showHex (Char -> Int
ord Char
c) (String -> String
go String
cs)
encodeText :: Char
-> Text
-> Text
encodeText :: Char -> Text -> Text
encodeText Char
c' Text
t = Char -> Text -> Text
cons Char
c' (Text -> Char -> Text
snoc ((Char -> Text) -> Text -> Text
T.concatMap Char -> Text
_encodeCharacter Text
t) Char
c')
_encodeCharacter :: Char -> Text
_encodeCharacter :: Char -> Text
_encodeCharacter Char
c
| Char -> Bool
_notEncode Char
c = Char -> Text
singleton Char
c
| Bool
otherwise = Char -> Text -> Text
cons Char
'\\' (String -> Text
pack (Int -> String -> String
_showHex (Char -> Int
ord Char
c) String
""))
encodeIdentifier :: Text
-> Text
encodeIdentifier :: Text -> Text
encodeIdentifier = (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
_encodeCharacter
_showHex :: Int -> ShowS
_showHex :: Int -> String -> String
_showHex = Int -> Int -> String -> String
forall t. (Eq t, Num t) => t -> Int -> String -> String
go (Int
6 :: Int)
where go :: t -> Int -> String -> String
go t
0 Int
_ String
s = String
s
go t
k Int
n String
rs = t -> Int -> String -> String
go (t
kt -> t -> t
forall a. Num a => a -> a -> a
-t
1) Int
q (Int -> Char
intToDigit Int
r Char -> String -> String
forall a. a -> [a] -> [a]
: String
rs)
where ~(Int
q, Int
r) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
quotRem Int
n Int
16
_parseEscape :: String -> (Char, String)
_parseEscape :: String -> (Char, String)
_parseEscape = Int -> Int -> String -> (Char, String)
forall t. (Eq t, Num t) => t -> Int -> String -> (Char, String)
go (Int
6 :: Int) Int
0
where go :: t -> Int -> String -> (Char, String)
go t
0 Int
n String
cs = Int -> String -> (Char, String)
forall b. Int -> b -> (Char, b)
yield Int
n String
cs
go t
_ Int
n String
"" = Int -> String -> (Char, String)
forall b. Int -> b -> (Char, b)
yield Int
n String
""
go t
i Int
n ca :: String
ca@(Char
c:String
cs) | Char -> Bool
isHexDigit Char
c = t -> Int -> String -> (Char, String)
go (t
it -> t -> t
forall a. Num a => a -> a -> a
-t
1) (Int
16Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Char -> Int
digitToInt Char
c) String
cs
| Bool
otherwise = Int -> String -> (Char, String)
forall b. Int -> b -> (Char, b)
yield Int
n String
ca
yield :: Int -> b -> (Char, b)
yield Int
n b
s = (Int -> Char
chr Int
n, b
s)
isValidIdentifier :: String
-> Bool
isValidIdentifier :: String -> Bool
isValidIdentifier = Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
toIdentifier :: (Text -> a)
-> String
-> a
toIdentifier :: (Text -> a) -> String -> a
toIdentifier Text -> a
f String
ident | String -> Bool
isValidIdentifier String
ident = Text -> a
f (String -> Text
pack String
ident)
| Bool
otherwise = String -> a
forall a. HasCallStack => String -> a
error (String
"The identifier " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
ident String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" is not a valid identifier.")