{-

This file (TestDevice.hs) is an example of how to use Pontarius XPMN. The
contents of this file may be used freely, as if it is in the public domain.

-}

import Network.XMPP
import Media.XPMN.DeviceServer

import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
import Data.Maybe
import Data.XML.Types
import qualified Data.Text as DT
import System.Random

import qualified Data.Map as DM

data State = State { deviceServer :: DeviceServer
                   , stateNumbers :: [(String, Integer)]
                   , pingpongVar :: SimpleVariable Pingpong
                   , numbersVar :: ComplexVariable Integer
                   , stateStd :: StdGen
                   , stateQueries :: [Query Integer] }

data Pingpong = Ping | Pong

instance XMLable Pingpong where
  toXML Ping = [NodeElement (Element (Name (DT.pack "ping") Nothing Nothing) (DM.fromList []) [])]
  toXML Pong = [NodeElement (Element (Name (DT.pack "pong") Nothing Nothing) (DM.fromList []) [])]
  fromXML [NodeElement (Element { elementName = n })] | nameLocalName n == DT.pack "ping" = Ping
  fromXML [NodeElement (Element { elementName = n })] | nameLocalName n == DT.pack "pong" = Pong

data InternalEvent = IED DeviceInEvent | IEP Bool deriving (Show)

host = "test.pontarius.org"
user = "sprint3-xpmn"
server = "test.pontarius.org"
port = 5222
resource = "pontarius"
password = ""

main :: IO ()
main =
  do -- Connect the XMPP account
     deviceServer <- start host port user password resource ["pingpong", "numbers"] ["even-numbers"]
     s <- (createSimpleVar deviceServer) "pingpong" Ping []
     ids <- mapM (\ _ -> getID) [0..9]
     let numbers = zip ids (reverse [0..9])
     let com = complexVariable "numbers" numbers []
     c <- newChan
     forkIO $ lolz (inEvents deviceServer) c
     stdGen <- getStdGen
     forkIO $ loop (State { deviceServer = deviceServer
                          , pingpongVar = s
                          , numbersVar = com
                          , stateNumbers = numbers
                          , stateStd = stdGen
                          , stateQueries = [] }) c
     forkIO $ pingpong c
     return ()
    where
      loop :: State -> Chan InternalEvent -> IO ()
      loop s c =
        do e <- readChan c
           putStrLn $ "DeviceTest: Got InternalEvent: " ++ (show e)
           s' <- processEvent s e
           loop s' c
      
      processEvent :: State -> InternalEvent -> IO State
      
      processEvent s (IED DIEOnline) = do
        putStrLn "We are online!"
        return s
      
      processEvent s (IED (DIEIncomingSimpleVariableGet j "pingpong")) = do
        putStrLn "Hmm3..."
        writeChan (outEvents (deviceServer s)) $ DOEIQ (iqResult (Just (SID "todo")) Nothing (Just j) Nothing
          (Just (Element { elementName = Name { nameLocalName = DT.pack "simple-variable"
                                              , namePrefix = Nothing
                                              , nameNamespace = Just (DT.pack "urn:xmpp:xpmn:0") }
                         , elementAttributes = DM.fromList [( Name { nameLocalName = DT.pack "variable"
                                                                   , namePrefix = Nothing
                                                                   , nameNamespace = Nothing } 
                                                            , [ContentText $ DT.pack $ simpleVariableName $ pingpongVar s])]
                         , elementNodes = (toXML $ simpleVariableValue $ pingpongVar s) })))
        -- TODO: iq result { from, to, id}
        return s
      
      processEvent s (IED (DIEIncomingSimpleVariableSet j "pingpong" v)) = do
        putStrLn "Hmm4..."
        pingpongVar' <- (modifySimpleVar $ deviceServer s) (pingpongVar s) (fromXML v)
        writeChan (outEvents (deviceServer s)) $ DOEIQ (iqResult (Just (SID "todo")) Nothing (Just j) Nothing Nothing)
        -- TODO: iq result { from, to, id}
        return s { pingpongVar = pingpongVar' }
      
      processEvent s (IED (DIESubscribe j "pingpong")) = do
        pingpongVar' <- (subscribeSimpleVar $ deviceServer s) (pingpongVar s) j
        -- TODO: iq result { from, to, id }
        return s { pingpongVar = pingpongVar' }
      
      processEvent s (IED (DIEUnsubscribe j "pingpong")) = do
        let pingpongVar' = (unsubscribeSimpleVar $ deviceServer s) (pingpongVar s) j
        -- TODO: iq result { from, to, id }
        return s { pingpongVar = pingpongVar' }
      
      processEvent s (IED (DIESubscribe j "numbers")) = do
        let numbersVar' = (subscribeComplexVar $ deviceServer s) (numbersVar s) j
        -- TODO: iq result { from, to, id }
        return s { numbersVar = numbersVar' }
      
      processEvent s (IED (DIEUnsubscribe j "numbers")) = do
        let numbersVar' = (unsubscribeComplexVar $ deviceServer s) (numbersVar s) j
        -- TODO: iq result { from, to, id }
        return s { numbersVar = numbersVar' }
      
      processEvent s (IED (DIEItems j "numbers")) = do
        let numbersValues = complexVariableValue (numbersVar s)
        let items = map (\ (i, v) -> NodeElement (Element { elementName = Name { nameLocalName = DT.pack "item"
                                                                               , namePrefix = Nothing
                                                                               , nameNamespace = Nothing }
                                                          , elementNodes = toXML v
                                                          , elementAttributes = ( DM.fromList [(Name { nameLocalName = DT.pack "id"
                                                                                                     , namePrefix = Nothing
                                                                                                     , nameNamespace = Nothing }, [ContentText (DT.pack i)])])})) numbersValues
        writeChan (outEvents (deviceServer s)) $ DOEIQ (iqResult (Just (SID "todo")) Nothing (Just j) Nothing
          (Just (Element { elementName = Name { nameLocalName = DT.pack "pubsub"
                                              , namePrefix = Nothing
                                              , nameNamespace = Just (DT.pack "http://jabber.org/protocol/pubsub") }
                         , elementAttributes = DM.fromList []
                         , elementNodes = [NodeElement (Element { elementName = Name { nameLocalName = DT.pack "items"
                                                                  , namePrefix = Nothing
                                                                  , nameNamespace = Nothing }
                                                   , elementAttributes = DM.fromList [(Name { nameLocalName = DT.pack "node"
                                                                                            , namePrefix = Nothing
                                                                                            , nameNamespace = Nothing }, [(ContentText (DT.pack "numbers"))])]
                                                   , elementNodes = items } )] })))
        return s
      
      processEvent s (IED (DIEQuery j "even-numbers" _)) = do
        let que = query j even :: Query Integer
        return s { stateQueries = que:(stateQueries s) }
      
      processEvent s (IED (DIEIQ i)) = do
        putStrLn $ "Got an IQ that was not processed by DeviceServer: " ++
          (show i)
        return s
      
      processEvent s (IEP b) = do
        -- COMPLEX VAR:
        -- get random number and id
        let (number, stdGen') = randomR (0 :: Integer, 99) (stateStd s)
        idToAdd <- getID
        -- get item to remove
        let idToRemove = fst (last (complexVariableValue (numbersVar s)))
        -- remove id
        c <- (retract (deviceServer s)) (numbersVar s) idToRemove
        -- add id
        c' <- (publish (deviceServer s)) c idToAdd number
        
        -- publish to all queries
        q' <- mapM (\ q -> (queryRetract (deviceServer s)) q idToRemove) (stateQueries s)
        q'' <- mapM (\ q -> (queryPublish (deviceServer s)) q idToAdd number) (stateQueries s)
        
        case b of
          True -> do
            case simpleVariableValue (pingpongVar s) of
              Ping -> -- Already ping
                return s { numbersVar = c', stateStd = stdGen', stateQueries = q'' }
              Pong -> do
                s' <- (modifySimpleVar (deviceServer s)) (pingpongVar s) Ping
                return s { numbersVar = c', pingpongVar = s', stateStd = stdGen', stateQueries = q'' }
          False -> do
            case simpleVariableValue (pingpongVar s) of
              Ping -> do
                s' <- (modifySimpleVar (deviceServer s)) (pingpongVar s) Pong
                return s { numbersVar = c', pingpongVar = s', stateStd = stdGen', stateQueries = q'' }
              Pong -> -- Already pong
                return s { numbersVar = c', stateStd = stdGen', stateQueries = q'' }
      
      processEvent s e = do
        putStrLn $ "!E!E!E!E!E!E!E!E!E!E!: " ++ (show e)
        return s

lolz c c' = do
  e <- readChan c
  writeChan c' (IED e)
  lolz c c'

getFeatures :: [String]
getFeatures = []

pingpong :: Chan InternalEvent -> IO ()
pingpong c = do
  threadDelay 5000000
  writeChan c (IEP False)
  threadDelay 5000000
  writeChan c (IEP True)
  pingpong c