{-# 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
',')