module HappyDot.Parser where

import Control.Monad.Trans.State
import Data.Char
import Data.Maybe

consumeWhile :: (Char -> Bool) -> State (String, Int) String
consumeWhile f = do
  (str, ln) <- get
  let (x,r) = span f str
      ln' = ln + (length $ filter (=='\n') x)
  put $ (r, ln')
  return x

consumeOnce :: (Char -> Bool) -> State (String, Int) String
consumeOnce f = do
  (str, ln) <- get
  case str of
    (c:cs) -> if f c then put (cs, ln + if c == '\n' then 1 else 0) >> return [c] else return ""
    [] -> return ""

-- | Consumes a quoted string. Quotes can be escaped with '\'.
--   It is assumed the opening quote was already consumed.
-- | Returns the quoted string without the quotes and the number of lines read.
consumeQuotedString :: State (String, Int) (Either String String)
consumeQuotedString = do
  str <- consumeWhile (\c -> not $ c `elem` "\\\"\n")
  (cs, ln) <- get
  case cs of
    '\\':'\n':ss -> do
      put (ss, ln+1)
      str1 <- consumeQuotedString
      return $ fmap (str ++) str1
    '\\':'"':ss -> do
      put (ss, ln)
      str1 <- consumeQuotedString
      return $ str1 >>= \s1 -> return (str ++ ('"':s1))
    '\"':ss -> do
      put (ss, ln)
      return $ Right str
    '\n':ss -> do
      put (ss, ln+1)
      return $ Left "String was open when newline was found. Either close the string with a \" or add a \\ to the end of the line to continue the string on the next line."
    '\\':c:ss -> do
      put (ss, ln)
      str1 <- consumeQuotedString
      return $ str1 >>= \s1 -> return (str ++ ('\\':c:s1))
    [] -> return $ Right str

consumeProcessing = do
  (s0, ln) <- get
  case s0 of
    '<':'?':cs -> do
      put (cs, ln)
      consumeProcessing'
    _ -> return []

consumeProcessing' = do
  t <- consumeWhile (/='?')
  (s1, ln) <- get
  case s1 of
    '?':'>':cs -> do
      put (cs, ln)
      return $ '<':'?':(t ++ "?>")
    c:cs -> do
      put (cs, ln)
      consumeProcessing'
    [] -> do
      return []

consumeComment = do
  consumeWhile (/='*')
  (str, ln) <- get
  case str of
    ('*':'/':str') -> put (str', ln)
    (_:str') -> do
      put (str', ln)
      consumeComment

consumeXMLComment = do
  consumeWhile (/='-')
  (str, ln) <- get
  case str of
    ('-':'-':'>':str') -> put (str', ln)
    (_:str') -> do
      put (str', ln)
      consumeXMLComment

consumeSomeString strings = do
  str <- get
  let ss = filter isJust $ map
        (\(s,r) ->
          do
            str' <- spanStr s str
            return (r, str'))
        strings
  if null ss then return Nothing
    else let Just (r, str') = head ss in put str' >> return (Just r)

consumeTag = do
  tag <- consumeWhile (/='>')
  consumeOnce (=='>')
  return tag

spanStr [] str = Just str
spanStr _ [] = Nothing
spanStr (p:pattern) (s:str)
  | p == s = spanStr pattern str
  | otherwise = Nothing