{-# LANGUAGE OverloadedStrings #-}
module Text.ICalendar.Parser.Content where

import           Control.Applicative
import           Control.Monad
import           Data.ByteString.Lazy         (ByteString)
import qualified Data.ByteString.Lazy.Builder as Bu
import           Data.CaseInsensitive         (CI)
import           Data.Char
import           Data.Monoid
import           Data.Text.Lazy               (Text)

import qualified Text.Parsec                 as P
import           Text.Parsec.ByteString.Lazy ()
import           Text.Parsec.Combinator      hiding (optional)
import           Text.Parsec.Prim            hiding (many, (<|>))
import           Text.Parsec.Text.Lazy       ()

import Text.ICalendar.Parser.Common

parseToContent :: TextParser [Content]
parseToContent = do content <- sepEndBy1 contentline newline
                    f <- dfBS2IText <$> getState
                    return $ componentalize f content

newline :: TextParser ()
newline = (char '\r' >> void (optional $ char '\n')) <|> void (char '\n')


componentalize :: (ByteString -> CI Text) -> [Content] -> [Content]
componentalize f (ContentLine p "BEGIN" [] n:xs) =
    let (com, rest) = break g xs
        g (ContentLine _ "END" [] en) | f en == n' = True
        g _ = False
        n' = f n
     in Component p n' (componentalize f com)
                : componentalize f (drop 1 rest)
componentalize f (x:xs) = x:componentalize f xs
componentalize _ _ = []


-- | Specialized scan function which unfolds lines.
scan :: s -- ^ Initial state.
     -> (s -> Maybe Char -> Maybe (Maybe s))
     -- ^ Nothing: Fail.
     -- Just Nothing: Done, don't use last char.
     -- Just (Just state): Continue, collecting char unless EOF.
     -> TextParser ByteString
scan state f = go state mempty
  where go st buf = do
            _ <- many (try unfold)
            c <- lookAhead (Just <$> P.anyChar <|> Nothing <$ P.eof)
            case (c, f st c) of
                 (_, Nothing) -> mzero
                 (Just c', Just (Just st')) ->
                    P.anyChar *> go st' (buf <> Bu.char8 c')
                 (_, _) -> return $ Bu.toLazyByteString buf

        unfold = (P.char '\r' >> optional (P.char '\n') >> P.oneOf " \t")
             <|> (P.char '\n' >> P.oneOf " \t")

takeWhile1 :: (Char -> Bool) -> TextParser ByteString
takeWhile1 p = scan False f <?> "takeWhile1 ..."
  where f g (Just x) | p x       = Just (Just True)
                     | g         = Just Nothing
                     | otherwise = Nothing
        f g _        | g         = Just Nothing
                     | otherwise = Nothing

char :: Char -> TextParser ByteString
char c = scan True f <?> show c
  where f True x = if Just c == x then Just (Just False) else Nothing
        f False _ = Just Nothing


isControl', isSafe, isValue, isQSafe, isName :: Char -> Bool
isControl' c = c /= '\t' && isControl c
isSafe c = not (isControl' c) && c `notElem` "\";:,"
isValue c = let n = fromEnum c in n == 32 || n == 9 || (n >= 0x21 && n /= 0x7F)
isQSafe c = isValue c && c /= '"'
isName c = isAsciiUpper c || isAsciiLower c || isDigit c || c == '-'

contentline :: TextParser Content
contentline = do pos <- getPosition
                 n <- name
                 ps <- many (char ';' >> param)
                 _ <- char ':'
                 val <- value <|> return mempty
                 return $ ContentLine pos n ps val
  where value :: TextParser ByteString
        value = takeWhile1 isValue <?> "value"

        param :: TextParser (CI Text, [Text])
        param = do n <- name
                   _ <- char '='
                   vs <- sepBy1 paramValue (char ',')
                   return (n, vs)

        name :: TextParser (CI Text)
        name = dfBS2IText <$> getState <*> takeWhile1 isName <?> "name"

        paramValue :: TextParser Text
        paramValue = paramtext <|> quotedString

        paramtext :: TextParser Text
        paramtext = dfBS2Text <$> getState <*> takeWhile1 isSafe <?> "paramtext"

        quotedString :: TextParser Text
        quotedString = (do
            _ <- char '"'
            s <- takeWhile1 isQSafe <|> return mempty
            _ <- char '"'
            dfBS2Text <$> getState <*> pure s) <?> "quoted string"