module Mdl
  ( module Mdl
  , module Ircmsg
  , module Control.Concurrent
  , module Control.Concurrent.STM
  , module Control.Exception
  , module Control.Monad
  , module Data.IORef
  , module Data.Char
  , module Regex
  , module Numeric
  ) where

import Ircmsg
import Control.Concurrent hiding (throwTo)
import Control.Concurrent.STM
import Control.Monad hiding (join)
import Control.Exception
import Data.IORef
import Data.Char
import Regex
import Numeric


type Mdl = Log -> Inp -> Out -> IO ()
type Log = Int -> String -> IO ()
type Inp = TChan Msg
type Out = TChan String

react :: (Msg -> IO [String]) -> Inp -> Out -> IO ()
react f inp out
  = do  m <- atomically (readTChan inp)
        handle (\_ -> return ()) $ do
          xs <- f m
          atomically (mapM_ (writeTChan out) xs)
        react f inp out


basemdls botnick = [register botnick, ping, pong, motd, logerr]
ping, motd, logerr :: Mdl

-- thes are must-have modules (duh)
ping log inp out
  = do -- ping the server every 30s with a dummy message
       threadDelay 30000000
       atomically (writeTChan out "TIME")
       ping log inp out

pong log = react f
  where
  f (Msg "" "" _ "PING" (id:_)) = return ["PONG :"++id]

register :: String -> Mdl
register botnick log = react f
  where
  f (Status "connected" _)
    = return [ "NICK "++botnick
             , "USER "++botnick++" * * :Karl Hans Rising" ]


-- these are not strictly necessary for operation, but still basic:

motd log inp out = do r_n <- newIORef 0
                      react (f r_n) inp out
  where
  f r_n (Msg "" "" _ "376" _)
    = do n <- readIORef r_n
         log 0 ("motd received, "++show n++" lines.")
         writeIORef r_n 0
         return []
  f r_n (Msg "" "" _ "372" _)
    = do modifyIORef r_n (+1)
         return []

logerr log = react f
  where
  f (Msg "" "" _ [x,y,z] (_to:msgs)) | x=='4' || x=='5'
    = do log 0 ([x,y,z]++": "++unwords msgs)
         return []


-- these are optional, but standard:

stdmdls botnick botchans = basemdls botnick ++ [join botnick botchans, logcmds]

join :: String -> String -> Mdl
join botnick botchans log = react f
  where
  f (Msg "" "" _ "001" (_me:welcome:_))
    = do log 0 (">> "++welcome)
         log 0 ("joining "++botchans++"...")
         return ["JOIN "++botchans]
  f (Msg from _ _ "JOIN" (chans:_))
    = do when (from==botnick) $ log 0 (chans++" joined.")
         return []

logcmds :: Mdl
logcmds log = react f
  where
  f (Msg from _ _ "PRIVMSG" (to:args)) | head (head args) == '!'
    = do log 0 (">> "++whr++unwords args)
         return []
    where
    whr
      | isAlpha (head to) = "["++from++"] "
      | otherwise         = "<"++to++":"++from++"> "