module Text.HPaco.Readers.Common
    ( module Text.Parsec.Combinator
    , module Text.Parsec.Char
    , module Text.Parsec.Prim
    , module Text.Parsec.String
    , Parser
    , ss, ss_
    , discard, tryDiscard
    , manySepBy
    , braces
    , identifier
    , path
    , anyQuotedString, singleQuotedString, doubleQuotedString
    , assertStartOfInput, assertStartOfLine
    , assertEndOfWord, assertEndOfOperator
    , keyword, operatorKeyword
    )
where

import Text.Parsec.Char
import Text.Parsec.Combinator
import Text.Parsec.Pos (SourcePos, sourceLine, sourceColumn, sourceName)
import Text.Parsec.Prim
import Text.Parsec.String hiding (Parser)
import Control.Monad.IO.Class
import System.IO.Strict
import Data.Char

type Parser s a = ParsecT String s IO a

-- Auxiliary parsers

ss :: a -> Parser s a
ss a = skipMany space >> return a

ss_ :: Parser s ()
ss_ = ss ()

braces :: Parser s a -> Parser s a
braces inner = do
    char '{'
    ss_
    v <- inner
    ss_
    char '}'
    return v

identifier :: Parser s String
identifier = do
    x <- letter <|> char '_'
    xs <- many $ letter <|> digit <|> char '_'
    return $ x:xs

anyQuotedString = singleQuotedString <|> doubleQuotedString

singleQuotedString = quotedString '\''
doubleQuotedString = quotedString '"'

quotedString qc = do
    char qc
    str <- many $ quotedStringChar qc
    char qc
    return str

quotedStringChar qc =
    try escapedChar
    <|> noneOf [qc]

escapedChar :: Parser s Char
escapedChar = do
    char '\\'
    c2 <- anyChar
    case c2 of
        'n' -> return '\n'
        'r' -> return '\r'
        'b' -> return '\b'
        't' -> return '\t'
        'u' -> do
            ds <- count 4 (digit <|> oneOf "abcdef")
            return . chr . read $ "0x" ++ ds
        otherwise -> return c2

discard :: Parser s a -> Parser s ()
discard p = p >> return ()

tryDiscard :: Parser s a -> Parser s ()
tryDiscard = try . discard

manySepBy :: Parser s a -> Parser s b -> Parser s [a]
manySepBy elem sep = do
    h <- try elem
    t <- many (try $ sep >> elem)
    return $ h:t

assertStartOfInput :: Parser s ()
assertStartOfInput = do
    pos <- getPosition
    if sourceLine pos == 1 && sourceColumn pos == 1
        then return ()
        else unexpected "start of input"

assertStartOfLine :: Parser s ()
assertStartOfLine = do
    pos <- getPosition
    if sourceColumn pos == 1
        then return ()
        else unexpected "start of line"

path :: Parser s String
path = many1 $ try $ noneOf " \t\r\n%()"

keyword :: String -> Parser s ()
keyword str = do
    string str
    assertEndOfWord

assertEndOfWord :: Parser s ()
assertEndOfWord = notFollowedBy $ letter <|> digit <|> char '_'

operatorKeyword :: String -> Parser s ()
operatorKeyword str = do
    string str
    assertEndOfOperator

assertEndOfOperator :: Parser s ()
assertEndOfOperator = notFollowedBy $ oneOf "!@#$%^&*_-+=;:,./?\\|<>~`"