Main.hs

{ # LANGUAGE OverloadedStrings #-}

module Main where

import qualified RFC2616
import           Control.Applicative
import           Control.Monad
import           Control.Proxy                    ((>->), request, respond, lift)
import qualified Control.Proxy                    as P
import qualified Control.Proxy.Attoparsec         as PA
import qualified Control.Proxy.ByteString         as PB
import           Control.Proxy.Network            (runTCPServer)
import           Data.Monoid
import qualified Data.Attoparsec.ByteString.Char8 as AB
import qualified Data.ByteString.Char8            as B


data InquiryPart = Who  B.ByteString
                 | What B.ByteString
                 deriving (Show)

who :: AB.Parser InquiryPart
who = fmap Who $ AB.skipSpace *> AB.string "Ask " *> AB.takeTill (==':') <* AB.string ":"

what :: AB.Parser InquiryPart
what = fmap What $ AB.skipSpace *> AB.takeTill (=='?')


parseInquiry :: (P.Proxy p)
             => () -> p () B.ByteString () (Maybe InquiryPart) IO r
parseInquiry = P.runIdentityK . P.foreverK $ loop Nothing
  where
    loop = parseWho

    parseWho lo () = do
      (lo', e) <- PA.parsingWith who lo $ do
        lift $ putStrLn "(Requesting)"
        request ()
      case e of
        Left  _ -> respond (Nothing) >> loop Nothing ()  -- ^Failed. Restart the loop droping leftovers.
        Right r -> respond (Just r)  >> parseWhat lo' () -- ^Success. Try to parse What, use leftovers.

    parseWhat lo () = do
      (lo', e) <- PA.parsingWith what lo $ do
        lift $ putStrLn "(Requesting) "
        request ()
      case e of
        Left  _ -> respond (Nothing) >> loop Nothing ()  -- ^Failed. Restart the loop droping leftovers.
        Right r -> respond (Just r)  >> loop lo' () -- ^Success. Restart the loop, use leftovers.


printInquiry :: P.Proxy p => () ->  P.Consumer p (Maybe InquiryPart) IO r
printInquiry () = P.runIdentityP . forever $ loop
  where
    loop = request () >>= lift . B.putStrLn . msg

    msg (Just (Who r))  = "> Hello " <> r <> ", I have a question for you:"
    msg (Just (What r)) = "> The question is: " <> (B.unwords . B.lines $ r) <> "???"
    msg Nothing         = "> Ohh.. sorry, I just forgot the question."


main = P.runProxy $ PB.stdinS >-> parseInquiry >-> printInquiry