module Text.HPaco.Readers.Paco.Basics
    ( module Text.Parsec.Combinator
    , module Text.Parsec.Char
    , module Text.Parsec.Prim
    , module Text.Parsec.String
    , ss, ss_
    , braces
    , identifier
    , anyQuotedString, singleQuotedString, doubleQuotedString
    , discard
    , manySepBy
    , assertStartOfLine, assertStartOfInput
    )
where

import Text.HPaco.Readers.Paco.ParserInternals
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

-- Auxiliary parsers

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

ss_ :: Parser ()
ss_ = ss ()

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

identifier :: Parser 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 Char
escapedChar = do
    char '\\'
    c2 <- anyChar
    return $ case c2 of
                'n' -> '\n'
                'r' -> '\r'
                'b' -> '\b'
                't' -> '\t'
                otherwise -> c2

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

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

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

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