{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} module Text.HSmarty.Parser.Util where import Control.Applicative import Data.Attoparsec.Text import Data.Char import Numeric (readHex) import Prelude hiding (takeWhile) import qualified Data.Text as T eolP :: Parser T.Text eolP :: Parser Text eolP = Text "\n" Text -> Parser Text -> Parser Text forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ (Text -> Parser Text string Text "\r\n" Parser Text -> Parser Text -> Parser Text forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Text -> Parser Text string Text "\n" Parser Text -> Parser Text -> Parser Text forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Text -> Parser Text string Text "\r") Parser Text -> Parser Text -> Parser Text forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Text "" Text -> Parser Text () -> Parser Text forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ Parser Text () forall t. Chunk t => Parser t () endOfInput boolP :: Parser Bool boolP :: Parser Bool boolP = Bool True Bool -> Parser Text -> Parser Bool forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ Text -> Parser Text string Text "true" Parser Bool -> Parser Bool -> Parser Bool forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Bool False Bool -> Parser Text -> Parser Bool forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ Text -> Parser Text string Text "false" stringP :: Parser T.Text stringP :: Parser Text stringP = (Char -> Parser Text quotedString Char '"' Parser Text -> Parser Text -> Parser Text forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Char -> Parser Text quotedString Char '\'') Parser Text -> String -> Parser Text forall i a. Parser i a -> String -> Parser i a <?> String "stringP" identP :: (Char -> Bool) -> (Char -> Bool) -> Parser T.Text identP :: (Char -> Bool) -> (Char -> Bool) -> Parser Text identP Char -> Bool first Char -> Bool rest = (Char -> Text -> Text T.cons (Char -> Text -> Text) -> Parser Text Char -> Parser Text (Text -> Text) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Char -> Bool) -> Parser Text Char satisfy Char -> Bool first Parser Text (Text -> Text) -> Parser Text -> Parser Text forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> (Char -> Bool) -> Parser Text takeWhile Char -> Bool rest) Parser Text -> String -> Parser Text forall i a. Parser i a -> String -> Parser i a <?> String "identP" stripSpace :: forall c. Parser c -> Parser c stripSpace :: Parser c -> Parser c stripSpace = Parser Text () -> Parser Text () -> Parser c -> Parser c forall a b c. Parser a -> Parser b -> Parser c -> Parser c between Parser Text () optSpace_ Parser Text () optSpace_ space_ :: Parser () space_ :: Parser Text () space_ = (Char -> Bool) -> Parser Text () skipWhile1 Char -> Bool isSpace optSpace_ :: Parser () optSpace_ :: Parser Text () optSpace_ = (Char -> Bool) -> Parser Text () skipWhile Char -> Bool isSpace between :: Parser a -> Parser b -> Parser c -> Parser c between :: Parser a -> Parser b -> Parser c -> Parser c between Parser a left Parser b right Parser c main = Parser a left Parser a -> Parser c -> Parser c forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> Parser c main Parser c -> Parser b -> Parser c forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* Parser b right skipWhile1 :: (Char -> Bool) -> Parser () skipWhile1 :: (Char -> Bool) -> Parser Text () skipWhile1 Char -> Bool p = (() () -> Parser Text -> Parser Text () forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ (Char -> Bool) -> Parser Text takeWhile1 Char -> Bool p) Parser Text () -> String -> Parser Text () forall i a. Parser i a -> String -> Parser i a <?> String "skipWhile1" quotedString :: Char -> Parser T.Text quotedString :: Char -> Parser Text quotedString Char c = String -> Text T.pack (String -> Text) -> Parser Text String -> Parser Text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Text Char -> Parser Text Char -> Parser Text String -> Parser Text String forall a b c. Parser a -> Parser b -> Parser c -> Parser c between (Char -> Parser Text Char char Char c) (Char -> Parser Text Char char Char c) (Parser Text Char -> Parser Text String forall (f :: * -> *) a. Alternative f => f a -> f [a] many Parser Text Char innerChar) where innerChar :: Parser Text Char innerChar = Char -> Parser Text Char char Char '\\' Parser Text Char -> Parser Text Char -> Parser Text Char forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> (Parser Text Char escapeSeq Parser Text Char -> Parser Text Char -> Parser Text Char forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Parser Text Char unicodeSeq) Parser Text Char -> Parser Text Char -> Parser Text Char forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> (Char -> Bool) -> Parser Text Char satisfy (Char -> String -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `notElem` [Char c,Char '\\']) escapeSeq :: Parser Char escapeSeq :: Parser Text Char escapeSeq = [Parser Text Char] -> Parser Text Char forall (f :: * -> *) a. Alternative f => [f a] -> f a choice ((Char -> Char -> Parser Text Char) -> String -> String -> [Parser Text Char] forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] zipWith Char -> Char -> Parser Text Char forall a. Char -> a -> Parser Text a decode String "bnfrt\\\"'" String "\b\n\f\r\t\\\"'") where decode :: Char -> a -> Parser Text a decode Char c a r = a r a -> Parser Text Char -> Parser Text a forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ Char -> Parser Text Char char Char c unicodeSeq :: Parser Char unicodeSeq :: Parser Text Char unicodeSeq = Char -> Parser Text Char char Char 'u' Parser Text Char -> Parser Text Char -> Parser Text Char forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> (Integer -> Char intToChar (Integer -> Char) -> (String -> Integer) -> String -> Char forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Integer decodeHexUnsafe (String -> Char) -> Parser Text String -> Parser Text Char forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Int -> Parser Text Char -> Parser Text String forall (m :: * -> *) a. Monad m => Int -> m a -> m [a] count Int 4 Parser Text Char hexDigit) where intToChar :: Integer -> Char intToChar = Int -> Char forall a. Enum a => Int -> a toEnum (Int -> Char) -> (Integer -> Int) -> Integer -> Char forall b c a. (b -> c) -> (a -> b) -> a -> c . Integer -> Int forall a b. (Integral a, Num b) => a -> b fromIntegral decodeHexUnsafe :: String -> Integer decodeHexUnsafe :: String -> Integer decodeHexUnsafe String hex = [Integer] -> Integer forall a. [a] -> a head ([Integer] -> Integer) -> [Integer] -> Integer forall a b. (a -> b) -> a -> b $ ((Integer, String) -> Integer) -> [(Integer, String)] -> [Integer] forall a b. (a -> b) -> [a] -> [b] map (Integer, String) -> Integer forall a b. (a, b) -> a fst ([(Integer, String)] -> [Integer]) -> [(Integer, String)] -> [Integer] forall a b. (a -> b) -> a -> b $ ReadS Integer forall a. (Eq a, Num a) => ReadS a readHex String hex hexDigitUpper :: Parser Char hexDigitUpper :: Parser Text Char hexDigitUpper = (Char -> Bool) -> Parser Text Char satisfy (String -> Char -> Bool inClass String "0-9A-F") hexDigit :: Parser Char hexDigit :: Parser Text Char hexDigit = (Char -> Bool) -> Parser Text Char satisfy (String -> Char -> Bool inClass String "0-9a-fA-F") braced :: Parser l -> Parser r -> Parser a -> Parser a braced :: Parser l -> Parser r -> Parser a -> Parser a braced Parser l l Parser r r = Parser Text () -> Parser r -> Parser a -> Parser a forall a b c. Parser a -> Parser b -> Parser c -> Parser c between (Parser l l Parser l -> Parser Text () -> Parser Text () forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> Parser Text () optSpace_) (Parser Text () optSpace_ Parser Text () -> Parser r -> Parser r forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> Parser r r) listLike :: Parser l -> Parser r -> Parser s -> Parser a -> Parser [a] listLike :: Parser l -> Parser r -> Parser s -> Parser a -> Parser [a] listLike Parser l l Parser r r Parser s sep Parser a inner = Parser l -> Parser r -> Parser [a] -> Parser [a] forall a b c. Parser a -> Parser b -> Parser c -> Parser c braced Parser l l Parser r r (Parser a -> Parser s -> Parser [a] forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a] sepBy Parser a inner (Parser s -> Parser s forall c. Parser c -> Parser c stripSpace Parser s sep)) tupleP :: Parser p -> Parser [p] tupleP :: Parser p -> Parser [p] tupleP = Parser Text Char -> Parser Text Char -> Parser Text Char -> Parser p -> Parser [p] forall l r s a. Parser l -> Parser r -> Parser s -> Parser a -> Parser [a] listLike (Char -> Parser Text Char char Char '(') (Char -> Parser Text Char char Char ')') (Char -> Parser Text Char char Char ',')