-- | A complete example for the library
module Main where

import           GHC.Stack
import           Control.Eff
import           Control.Monad
import           Data.Dynamic
import           Control.Eff.Concurrent
import           Control.Eff.Concurrent.Protocol.Server
import qualified Control.Exception             as Exc
import qualified Data.Text as T
import           Control.DeepSeq
import           Data.Type.Pretty

data TestProtocol
  deriving Typeable

type instance ToPretty TestProtocol = PutStr "test"

data instance Pdu TestProtocol x where
  SayHello :: String -> Pdu TestProtocol ('Synchronous Bool)
  Shout :: String -> Pdu TestProtocol 'Asynchronous
  Terminate :: Pdu TestProtocol ('Synchronous ())
  TerminateError :: String -> Pdu TestProtocol ('Synchronous ())
  deriving (Typeable)

instance NFData (Pdu TestProtocol x) where
  rnf (SayHello s) = rnf s
  rnf (Shout s) = rnf s
  rnf Terminate = ()
  rnf (TerminateError s) = rnf s


data MyException = MyException
    deriving Show

instance Exc.Exception MyException

deriving instance Show (Pdu TestProtocol x)

main :: IO ()
main = defaultMain example

mainProcessSpawnsAChildAndReturns :: HasCallStack => Eff InterruptableProcEff ()
mainProcessSpawnsAChildAndReturns = void (spawn (void receiveAnyMessage))

example:: HasCallStack => Eff InterruptableProcEff ()
example = do
  me <- self
  logInfo (T.pack ("I am " ++ show me))
  server <- testServerLoop
  logInfo (T.pack ("Started server " ++ show server))
  let go = do
        lift (putStr "Enter something: ")
        x <- lift getLine
        case x of
          ('K' : rest) -> do
            call server (TerminateError rest)
            go
          ('S' : _) -> do
            call server Terminate
            go
          ('C' : _) -> do
            cast server (Shout x)
            go
          ('R' : rest) -> do
            replicateM_ (read rest) (cast server (Shout x))
            go
          ('q' : _) -> logInfo "Done."
          _         -> do
            res <- call server (SayHello x)
            logInfo (T.pack ("Result: " ++ show res))
            go
  go

type instance GenServerProtocol TestProtocol = TestProtocol

testServerLoop :: Eff InterruptableProcEff (Endpoint TestProtocol)
testServerLoop = start (statelessGenServer handleReq "test-server-1")
 where
  handleReq :: GenServerId TestProtocol -> Event TestProtocol -> Eff (ToStatelessEffects InterruptableProcEff) ()
  handleReq _myId (OnRequest (Call orig Terminate)) = do
    me <- self
    logInfo (T.pack (show me ++ " exiting"))
    sendReply orig ()
    interrupt NormalExitRequested

  handleReq _myId (OnRequest (Call orig (TerminateError e))) = do
    me <- self
    logInfo (T.pack (show me ++ " exiting with error: " ++ e))
    sendReply orig ()
    interrupt (ErrorInterrupt e)

  handleReq _myId (OnRequest (Call orig (SayHello mx))) =
    case mx of
      "e1" -> do
        me <- self
        logInfo (T.pack (show me ++ " raising an error"))
        interrupt (ErrorInterrupt "No body loves me... :,(")

      "e2" -> do
        me <- self
        logInfo (T.pack (show me ++ " throwing a MyException "))
        void (lift (Exc.throw MyException))

      "self" -> do
        me <- self
        logInfo (T.pack (show me ++ " casting to self"))
        cast (asEndpoint @TestProtocol me) (Shout "from me")
        sendReply orig False

      "stop" -> do
        me <- self
        logInfo (T.pack (show me ++ " stopping me"))
        sendReply orig False
        interrupt (ErrorInterrupt "test error")

      x -> do
        me <- self
        logInfo (T.pack (show me ++ " Got Hello: " ++ x))
        sendReply orig (length x > 3)

  handleReq _myId (OnRequest (Cast (Shout x))) = do
    me <- self
    logInfo (T.pack (show me ++ " Shouting: " ++ x))

  handleReq _myId (OnInterrupt msg) = do
    me <- self
    logInfo (T.pack (show me ++ " is exiting: " ++ show msg))
    logProcessExit msg
    interrupt msg

  handleReq _myId wtf = do
    me <- self
    logCritical (T.pack (show me ++ " WTF: " ++ show wtf))