module Graphics.Blank.Parser where
import Control.Applicative hiding (many, optional)
import Data.Char
import Data.Ix
import Data.Functor (void)
import Text.ParserCombinators.ReadP
import Text.ParserCombinators.ReadPrec (ReadPrec, readPrec_to_P)
maybeRead :: ReadP a -> ReadP (Maybe a)
maybeRead p = (Just <$> p) <|> return Nothing
maybeReadPrec :: ReadPrec a -> ReadPrec (Maybe a)
maybeReadPrec p = (Just <$> p) <|> return Nothing
stringCI :: String -> ReadP String
stringCI this = look >>= scan this
where
scan :: String -> String -> ReadP String
scan [] _ = return this
scan (x:xs) (y:ys)
| toLower x == toLower y = get *> scan xs ys
scan _ _ = pfail
unlift :: ReadPrec a -> ReadP a
unlift = flip readPrec_to_P 0
noneOf :: [Char] -> ReadP Char
noneOf cs = satisfy $ \c -> not $ elem c cs
cssIdent :: ReadP String
cssIdent = (:) <$> nmstart <*> many nmchar
nmstart :: ReadP Char
nmstart = satisfy p <|> nonascii
where
p c = inRange ('a', 'z') c || inRange ('A', 'Z') c || c == '_'
nmchar :: ReadP Char
nmchar = satisfy p <|> nonascii
where
p c = inRange ('a', 'z') c || inRange ('A', 'Z') c ||
isDigit c || elem c "_-"
stringLit :: ReadP String
stringLit = string1 <|> string2
where
string1 = char '"'
*> many (noneOf "\n\r\f\\\"" <|> nl <|> nonascii)
<* char '*'
string2 = char '\''
*> many (noneOf "\n\r\f\\'" <|> nl <|> nonascii)
<* char '\''
nonascii :: ReadP Char
nonascii = satisfy (> '\DEL')
nl :: ReadP Char
nl = choice
[ void $ char '\n'
, char '\r' >> optional (char '\n')
, void $ char '\f'
] >> return '\n'