module Bytor.Parse where

import           Control.Applicative
import           Control.Monad (void)
import           Data.ByteString (ByteString)
import qualified Data.ByteString as B
import           Data.Attoparsec.ByteString (Parser)
import qualified Data.Attoparsec.ByteString as Atto
import           Data.Sequence (Seq)
import           Data.Time.Clock (UTCTime)
import           Data.Word (Word8)
import           System.Directory (listDirectory)

import           Bytor.Types

pPhrase :: Parser ByteString
pPhrase = undefined

pMailbox :: Parser Mailbox
pMailbox = nameAddr <|> (Mailbox Nothing <$> pAddrSpec)
  where nameAddr =
          Mailbox <$> (Just <$> pPhrase)
                  <*> (Atto.word8 60 *> pAddrSpec <* Atto.word8 62)

pDotAtom :: Parser ByteString
pDotAtom = Atto.takeWhile (\ c -> atext c || c == 46)

pAddrSpec :: Parser Address
pAddrSpec = Address <$> pLocalPart <*> (Atto.word8 64 *> pDomain)
  where pLocalPart = pDotAtom
        pDomain = pDotAtom

atext :: Word8 -> Bool
atext c = c < 128 && c /= 40 && c /= 41
                && c /= 58 && c /= 59
                && c /= 60 && c /= 62
                && c /= 64 && c /= 91
                && c /= 92 && c /= 93
                && c /= 34

newtype MessageId = MessageId { _fromMessageId :: ByteString }
  deriving (Eq, Show, Read)

getSubject :: RawEmail -> ByteString
getSubject RawEmail { reHeaders = hs } =
  head [ subj | HeaderSubject subj <- hs ]

data RawEmail = RawEmail
  { reHeaders :: [Header]
  , reBodies  :: [ByteString]
  } deriving (Eq, Show)

readBox :: FilePath -> IO [(FilePath, Either String RawEmail)]
readBox fp = do
  paths <- listDirectory fp
  let files = [ fp ++ "/" ++ p | p <- paths ]
  raws <- sequence [ (,) f `fmap` B.readFile f | f <- files ]
  return [ (f, Atto.parseOnly pEmail r) | (f, r) <- raws ]

pEmail :: Parser RawEmail
pEmail = do
  headers <- Atto.manyTill pHeader pCrlf
  body <- pBody
  return (RawEmail headers [body])

pHeader :: Parser Header
pHeader = do
  name <- Atto.takeWhile1 (\ c -> c /= 58 && not (isSpace c))
  void $ Atto.word8 58
  case name of
    "OrigDate" -> HeaderOther "arglbargl" <$> foldingHeader
    "Subject"  -> HeaderSubject <$> foldingHeader
    "Comments" -> HeaderComments <$> foldingHeader
    "Keywords" -> HeaderKeywords <$> foldingHeader
    _          -> HeaderOther name <$> foldingHeader

pDateTime :: Parser UTCTime
pDateTime = undefined

foldingHeader :: Parser ByteString
foldingHeader = do
  skipSpace
  line <- Atto.takeTill (== 10)
  void $ Atto.word8 10
  next <- Atto.peekWord8'
  if isSpace next
    then skipSpace *> (B.append line <$> foldingHeader)
    else return line

skipSpace :: Parser ()
skipSpace = void $ Atto.takeWhile isSpace

isSpace :: (Num a, Eq a) => a -> Bool
isSpace c = c == 32 || c == 9

pCrlf :: Parser ()
pCrlf = void (Atto.word8 10)

pBody :: Parser ByteString
pBody = B.concat <$> Atto.many' (pText <* pCrlf)

pText :: Parser ByteString
pText = Atto.takeWhile (\ c -> c /= 10 && c /= 13)