module M_bintopic where

import Mdl
import qualified Data.Map as Map


bintopic :: Mdl
bintopic log inp out = do r_ts <- newIORef (Map.empty)
                          react (f r_ts) inp out
  where
  f r_ts (Msg _ _ _ "332" (_by:chan:topic:_))
    = do modifyIORef r_ts (Map.insert chan topic)
         return []
  f r_ts (Msg from _ _ "TOPIC" (chan:topic:_))
    = do modifyIORef r_ts (Map.insert chan topic)
         return []
  f r_ts (Msg _ _ _ "PRIVMSG" (to:msg:_))
    | cmd == "!8bit" = doit 8
    | cmd == "!7bit" = doit 7
    | otherwise = return []
    where
    (cmd,rest) = getarg msg
    (chan,plaintext)
      | head to == '#' = (to, dropWhile (==' ') rest)
      | otherwise = getarg rest
    getarg xs = let (ys,zs)=break (==' ') xs in (ys, dropWhile (==' ') zs)

    doit n = do ts <- readIORef r_ts
                let t  = maybe "" id (Map.lookup chan ts)
                let t' = (t /~ "(^ *|// *)[01]{4,}( *$| *//)") 1 (enc n plaintext) 2
                return $ if t==t' then [] else ["TOPIC "++chan++" :" ++ t']

  enc n = concatMap (padl '0' n . showbin . ord)
  padl x n xs = reverse (take n (reverse xs ++ repeat x))
  showbin x = showIntAtBase 2 b2c x ""
  b2c 0 = '0'
  b2c 1 = '1'