{-# LANGUAGE OverloadedStrings #-}
------------------------------------------------------------------------------
-- | Module: Main
-- Copyright: Martin Grabmueller
-- License: BSD3
--
-- Maintainer: martin@grabmueller.de
-- Stability: provisional
-- Portability: GHC and Linux only
--
-- This file contains an example on using the
-- pipes-attoparsec-streaming package.
--
-- Part of this code was adapted from Bryan O'Sullivan's HTTP parser
-- example on his blog.
--
-- Currently, this parser only recognizes headers (like in e-mails),
-- the end-of-header empty line and the parser chunks the remainder of
-- the input into suitable pieces.
------------------------------------------------------------------------------
module Main(main) where

import Control.Pipe.Attoparsec.Stream

import Data.Word
import Control.Pipe
import Control.Pipe.Combinators as Combinators
import Data.Attoparsec(Parser)
import qualified Data.Attoparsec as A
import qualified Data.Attoparsec.Char8 as A8
import Data.ByteString(ByteString)
import qualified Data.ByteString as B
import Control.Applicative
import Control.Monad.Trans.Class(lift)


------------------------------------------------------------------------------
-- First, we start with some useful utility parsers.
------------------------------------------------------------------------------

-- Predicate for testing whether a byte may appear in a MIME token.
--
isToken :: Word8 -> Bool
isToken w = w <= 127 && A.notInClass "\0-\31()<>@,;:\\\"/[]?={} \t" w

-- Skip horizontal space.  At least one space must be
-- available. Return the skipped whitespace.
--
takeSpaces :: Parser ByteString
takeSpaces = B.cons <$> A.satisfy A8.isHorizontalSpace <*> A.takeWhile A8.isHorizontalSpace

-- Recognize and return an end-of-line sequence, which must be either
-- a single newline or a carriage-newline combination.
--
endOfLine :: Parser ByteString
endOfLine = (A.word8 10 >> return "\n") <|> A.string "\r\n"

-- Return @n@ bytes, or less if the end of input is reached.
takeAtMost :: Int -> Parser ByteString
takeAtMost n = A.scan n (\ n' _ -> if n' == 0 then Nothing else (Just (n' - 1)))


------------------------------------------------------------------------------
-- Events.  These are the parse results that are streamed.
------------------------------------------------------------------------------

-- | The generated events. 
--
-- Each event contains exactly the bytes which were parsed, so that
-- the original input can be reconstructed from the events.
--
data Event
  = Header ByteString ByteString [(ByteString, ByteString, ByteString)]
  | EndOfHeader ByteString
  | BodyChunk ByteString
  | EndOfInput
  deriving (Show)


------------------------------------------------------------------------------
-- The parser.
------------------------------------------------------------------------------

-- | Parse a single message header, including continuation lines.
--
messageHeader :: Parser (PartialResult Event)
messageHeader = do
  -- Header name.
  header <- B.cons <$> A.satisfy isToken <*> A.takeWhile isToken
  
  -- Delimiter.
  delim <- B.snoc <$> A.takeWhile A8.isHorizontalSpace <*> A8.char8 ':'
  
  -- Parse the first line of the header value.
  body <-  (,,) <$> A.takeWhile A8.isHorizontalSpace <*>
                    A.takeTill A8.isEndOfLine <*> endOfLine
                    
  -- Parse the remaining lines of the header value. Each one must
  -- begin with at least one horizontal space.
  bodies <- many $ (,,) <$> takeSpaces <*> A.takeTill A8.isEndOfLine <*> endOfLine
  
  -- Return the parsed header and return ourself as the continuation,
  -- to parse more headers.
  return (PartialResult (Just (Header header delim (body:bodies))) (Just messageHeader))

 <|>

  -- When no header can be parsed, return no result and set the
  -- @headerEnd@ parser as the continuation.
  return (PartialResult Nothing (Just headerEnd))


-- | Parse the end-of-header marker (an empty line).
--
headerEnd :: Parser (PartialResult Event)
headerEnd = do
  -- This one is easy.
  s <- endOfLine
  
  -- Continue with a body chunk.
  return $! PartialResult (Just (EndOfHeader s)) (Just bodyChunk)


-- | Parse a chunk of message body data.
--
bodyChunk :: Parser (PartialResult Event)
bodyChunk = do
  -- Parse a small chunk.
  s <- takeAtMost 10
  if B.null s
    -- When end-of-input is reached, indicate that with the correct
    -- event and don't return a continuation.
    then return $ PartialResult (Just EndOfInput) Nothing
         
    -- Return the chunk and try again.
    else return $ PartialResult (Just (BodyChunk s)) (Just bodyChunk)


------------------------------------------------------------------------------
-- Example invocation.
------------------------------------------------------------------------------

-- | Tiny example message.
--
msg :: ByteString
msg =
  "Received  : foo\r\n  cont'd\r\nDate: now\r\n\r\nblabla\r\nsecond line - longer"


-- | Small helper for printing the parsed events.
--
dump :: Pipe Event Void IO ()
dump = go
 where
   go = do
     e <- await
     lift $ print e
     go


-- | Main program. Run the parser on a small example and print the
-- streamed parsing results.
--
main :: IO ()
main = do
  runPipe $ fromList [msg] >+> parse messageHeader >+> dump