Reaktor: add data Commandv0.2.0

5 files changed, 29 insertions, 32 deletions

diff --git a/src/Reaktor/Plugins/Mention.hs b/src/Reaktor/Plugins/Mention.hs
index b3cdbb8..b288fdb 100644
--- a/src/Reaktor/Plugins/Mention.hs
+++ b/src/Reaktor/Plugins/Mention.hs
@@ -3,16 +3,16 @@
 {-# LANGUAGE RecordWildCards #-}
 module Reaktor.Plugins.Mention (new) where
 
-import Prelude.Extended
 import qualified Data.Char
 import qualified Data.Text as T
+import Prelude.Extended
 import Reaktor
 
 
 new :: Actions -> IO (Message -> IO ())
 new Actions{..} = do
     pure $ \case
-      Message _ "PRIVMSG" (msgtarget:text:[]) -> do
+      Message _ PRIVMSG (msgtarget:text:[]) -> do
           nick <- aGetNick
           when (isMention nick text) $ do
             aSend (privmsg msgtarget ["I'm famous!"])
diff --git a/src/Reaktor/Plugins/Ping.hs b/src/Reaktor/Plugins/Ping.hs
index 436ebe2..07aae9e 100644
--- a/src/Reaktor/Plugins/Ping.hs
+++ b/src/Reaktor/Plugins/Ping.hs
@@ -10,6 +10,6 @@ new :: Actions -> IO (Message -> IO ())
 new Actions{..} =
     return $ \case
       Message _ cmd args ->
-        when (cmd == "PING") $
-          aSend (Message Nothing "PONG" args)
+        when (cmd == PING) $
+          aSend (Message Nothing PONG args)
       _ -> pure ()
diff --git a/src/Reaktor/Plugins/Register.hs b/src/Reaktor/Plugins/Register.hs
index ff420f0..979e4ba 100644
--- a/src/Reaktor/Plugins/Register.hs
+++ b/src/Reaktor/Plugins/Register.hs
@@ -5,12 +5,12 @@
 module Reaktor.Plugins.Register where
 
 import Blessings
-import Prelude.Extended
 import Data.Aeson
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
-import qualified Reaktor.Nick as Nick
+import Prelude.Extended
 import Reaktor
+import qualified Reaktor.Nick as Nick
 import System.Environment (lookupEnv)
 
 data ConfigNickServ = ConfigNickServ
@@ -60,43 +60,43 @@ new Config{..} Actions{..} = do
             -- TODO JOIN only if not already joined
             --      i.e. not during subsequent nick changes
             unless (T.null channelsArg) $
-              aSend (Message Nothing "JOIN" [channelsArg])
+              aSend (Message Nothing JOIN [channelsArg])
 
         start = do
           nick <- maybe aGetNick pure cNick
           user <-
             maybe (maybe nick T.pack <$> lookupEnv "LOGNAME") pure cUser
           aSetNick nick
-          aSend (Message Nothing "NICK" [nick])
-          aSend (Message Nothing "USER" [user, "*", "0", cReal])
+          aSend (Message Nothing NICK [nick])
+          aSend (Message Nothing USER [user, "*", "0", cReal])
         onNick newnick = do
           nick <- aGetNick
           when (newnick == nick) join
         useRandomNick = do
           nick <- Nick.getRandom
           aSetNick nick
-          aSend (Message Nothing "NICK" [nick])
+          aSend (Message Nothing NICK [nick])
         useNextNick = do
           nick0 <- aGetNick
           let nick = Nick.getNext nick0
           aSetNick nick
-          aSend (Message Nothing "NICK" [nick])
+          aSend (Message Nothing NICK [nick])
         useNextNickTemporarily = do
           nick <- aGetNick
           let tmpNick = Nick.getNext nick
           -- do not aSetNick tmpNick 
-          aSend (Message Nothing "NICK" [tmpNick])
+          aSend (Message Nothing NICK [tmpNick])
 
     if not isNickServEnabled then do
       when (isJust cNickServ) $ do
         aLog $ SGR [38,5,202] "! disabling NickServ due to insecure connection"
       pure $ \case
         Start -> start
-        Message (Just _self) "NICK" (newnick:[]) -> onNick newnick
-        Message _ "001" _ -> join
-        Message _ "432" _ -> useRandomNick
-        Message _ "433" _ -> useNextNick
-        Message _ "437" (_msgtarget:res:_reason:[]) -> do
+        Message (Just _self) NICK (newnick:[]) -> onNick newnick
+        Message _ RPL_WELCOME _ -> join
+        Message _ ERR_ERRONEUSNICKNAME _ -> useRandomNick
+        Message _ ERR_NICKNAMEINUSE _ -> useNextNick
+        Message _ ERR_UNAVAILRESOURCE (_msgtarget:res:_reason:[]) -> do
           nick <- aGetNick
           when (res == nick) useNextNick
         _ -> pure ()
@@ -106,16 +106,15 @@ new Config{..} Actions{..} = do
       [pass] <- T.lines <$> T.readFile cnsPassFile
       pure $ \case
         Start -> start
-        Message (Just _self) "NICK" (newnick:[]) -> onNick newnick
+        Message (Just _self) NICK (newnick:[]) -> onNick newnick
 
-        -- RFC2812 RPL_WELCOME
-        Message _ "001" [msgtarget,_text] -> do
+        Message _ RPL_WELCOME [msgtarget,_text] -> do
           nick <- aGetNick
           aSend (privmsg "NickServ" ["IDENTIFY", nick, pass])
           when (msgtarget /= nick) (regain nick pass)
 
         -- TODO structured prefix, and check just for "NickServ"?
-        Message (Just prefix) "NOTICE" (msgtarget:text:[]) ->
+        Message (Just prefix) NOTICE (msgtarget:text:[]) ->
           when (prefix == cnsPrefix) $ do
             nick <- aGetNick
             let stx = ("\STX"<>) . (<>"\STX")
@@ -135,17 +134,14 @@ new Config{..} Actions{..} = do
               | otherwise ->
                 pure ()
 
-        -- RFC1459 ERR_ERRONEUSNICKNAME
-        Message (Just _servername) "432" (_msgtarget:_nick:_reason:[]) ->
+        Message _ ERR_ERRONEUSNICKNAME (_msgtarget:_nick:_reason:[]) ->
           useRandomNick
 
-        -- RFC1459 ERR_NICKNAMEINUSE
-        Message (Just _servername) "433" (_msgtarget:_nick:_reason:[]) ->
+        Message _ ERR_NICKNAMEINUSE (_msgtarget:_nick:_reason:[]) ->
           -- TODO what if nick0 /= nick? OR assert/prove nick0 == nick?
           useNextNickTemporarily
 
-        --RFC2812 ERR_UNAVAILRESOURCE
-        Message (Just _servername) "437" (msgtarget:res:_reason:[]) -> do
+        Message _ ERR_UNAVAILRESOURCE (msgtarget:res:_reason:[]) -> do
           nick <- aGetNick
           when (res == nick) $
             case msgtarget of
diff --git a/src/Reaktor/Plugins/System.hs b/src/Reaktor/Plugins/System.hs
index a39bd23..864bbc3 100644
--- a/src/Reaktor/Plugins/System.hs
+++ b/src/Reaktor/Plugins/System.hs
@@ -36,12 +36,12 @@ import qualified Text.Regex.PCRE.Light as RE
 new :: Config -> Actions -> IO (Message -> IO ())
 new config@Config{..} actions@Actions{..} = do
     pure $ \case
-        Message (Just prefix) "PRIVMSG" (msgtarget:text:[]) -> do
-          let hooks = maybe [] id (M.lookup "PRIVMSG" cHooks)
+        Message (Just prefix) PRIVMSG (msgtarget:text:[]) -> do
+          let hooks = maybe [] id (M.lookup PRIVMSG cHooks)
           mapM_ (\h -> run1 config actions h prefix msgtarget text) hooks
 
-        Message (Just prefix) "JOIN" (channel:[]) -> do
-          let hooks = maybe [] id (M.lookup "JOIN" cHooks)
+        Message (Just prefix) JOIN (channel:[]) -> do
+          let hooks = maybe [] id (M.lookup JOIN cHooks)
           mapM_ (\h -> run1 config actions h prefix channel "") hooks
 
         _ -> pure ()
diff --git a/src/Reaktor/Plugins/System/Internal.hs b/src/Reaktor/Plugins/System/Internal.hs
index aa60452..d042217 100644
--- a/src/Reaktor/Plugins/System/Internal.hs
+++ b/src/Reaktor/Plugins/System/Internal.hs
@@ -5,6 +5,7 @@ module Reaktor.Plugins.System.Internal where
 import Prelude.Extended
 import Data.Aeson
 import Reaktor ()
+import qualified Reaktor.IRC as IRC
 import Text.Regex.PCRE.Light (Regex)
 import qualified Text.Regex.PCRE.Light as RE
 
@@ -30,7 +31,7 @@ instance FromJSON Activate where
 
 data Config = Config
     { cWorkDir :: Maybe FilePath
-    , cHooks :: HashMap Text [Hook]
+    , cHooks :: HashMap IRC.Command [Hook]
     }
   deriving Show