monadize

parrotbot.cabal

@@ -23,11 +23,12 @@ executable parrotbot
     main-is:          Main.hs
 
     -- Modules included in this executable, other than Main.
-    -- other-modules:
+    other-modules:    Types
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:
     build-depends:    base >=4.14.1.0
                     , network
+                    , mtl
     hs-source-dirs:   src
     default-language: Haskell2010

shell.nix

@@ -4,14 +4,14 @@ let
 
   inherit (nixpkgs) pkgs;
 
-  f = { mkDerivation, base, lib, network }:
+  f = { mkDerivation, base, lib, mtl, network }:
       mkDerivation {
         pname = "parrotbot";
         version = "0.0.0.0";
         src = ./.;
         isLibrary = false;
         isExecutable = true;
-        executableHaskellDepends = [ base network ];
+        executableHaskellDepends = [ base mtl network ];
         description = "polly wanna cracker";
         license = lib.licenses.gpl3Plus;
       };

src/Main.hs

@@ -4,30 +4,62 @@ module Main where
 import System.IO
 import System.Exit (exitSuccess)
 
+import Control.Exception (bracket, bracket_)
+
+import Control.Monad.Reader
+import Control.Monad.IO.Class (liftIO)
+
 import Data.List (intercalate, isPrefixOf)
 
 import qualified Network.Socket as N
 
+-- internal imports
+import Types
+
 -- configuration options (TODO: Move to yaml and read from there)
 server = "irc.freenode.org"
 port = 6667
 chan = "#parrotbot-testing"
 nick = "parrotbot"
 
+-- | Entry point
 main :: IO ()
-main = do
+main =
-  handle <- connect server port
+  bracket connect disconnect loop
-  write handle "NICK" nick
+  where
-  write handle "USER" (nick <> " 0 * :parrot bot")
+    disconnect = hClose . botSocket
-  write handle "JOIN" chan
+    loop st = runReaderT run st
-  listen handle
 
--- | Connect to an IRC server given domain name and port
+-- | Process bot comands inside of its monad
+run
+  :: Net ()
+run = do
+  write "NICK" nick
+  write "USER" (nick <> " 0 * :parrot bot")
+  write "JOIN" chan
+  listen
+
+-- | Connect to the server und return the initial bot state
 connect
+  :: IO Bot
+connect = notify $ do
+  handle <- connectTo server port
+  return (Bot handle)
+  where
+    notify a = bracket_
+      (do
+        putStrLn ("Connecting to " <> server <> "…")
+        hFlush stdout
+        )
+      (putStrLn "done.")
+      a
+
+-- | Connect to an IRC server given domain name and port (Helper for 'connect'
+connectTo
   :: N.HostName   -- ^ Domain to connect to
   -> N.PortNumber -- ^ Port to connect to
   -> IO Handle    -- ^ Handle for the connection
-connect chost cport = do
+connectTo chost cport = do
   (addr:_) <- N.getAddrInfo Nothing (Just chost) (Just (show cport))
   sock <- N.socket
     (N.addrFamily addr)
@@ -38,37 +70,37 @@ connect chost cport = do
 
 -- | Send messages to IRC
 write
-  :: Handle -- ^ Connection handle
+  :: String -- ^ Command to issue
-  -> String -- ^ Command to issue
   -> String -- ^ Command argument(s)
-  -> IO ()
+  -> Net ()
-write handle cmd args = do
+write cmd args = do
   let msg = intercalate " " [cmd, args, "\r\n"]
-  hPutStr handle msg
+  handle <- asks botSocket
-  print ("> " <> msg)
+  liftIO $ do
+    hPutStr handle msg
+    putStr ("> " <> msg)
 
 -- | Send Messages via PRIVMSG to the connected Channel
 privmsg
-  :: Handle -- ^ Connection handle
+  :: String -- ^ Message Content
-  -> String -- ^ Message Content
+  -> Net ()
-  -> IO ()
+privmsg msg = write "PRIVMSG" (chan <> " :" <> msg)
-privmsg handle msg = write handle "PRIVMSG" (chan <> " :" <> msg)
 
 -- | Listen to and process messages from IRC
 listen
-  :: Handle -- ^ Connection handle
+  :: Net ()
-  -> IO ()
+listen = forever $ do
-listen handle = forever $ do
+  handle <- asks botSocket
-  line <- hGetLine handle
+  line <- liftIO $ hGetLine handle
-  putStrLn line
+  liftIO $ putStrLn line
   let s = init line
   if isPing s
   then
     pong s
   else
-    evaluate handle (clean s)
+    evaluate (clean s)
   where
-    forever :: IO () -> IO ()
+    forever :: Net () -> Net ()
     forever a = do
       a
       forever a
@@ -79,18 +111,17 @@ listen handle = forever $ do
     isPing :: String -> Bool
     isPing s = "PING" `isPrefixOf` s
 
-    pong :: String -> IO ()
+    pong :: String -> Net ()
-    pong x = write handle "PONG" (':' : drop 6 x)
+    pong x = write "PONG" (':' : drop 6 x)
 
 -- | Evaluate input from IRC
 evaluate
-  :: Handle -- ^ Connection handle
+  :: String -- ^ Input to be processed
-  -> String -- ^ Input to be processed
+  -> Net ()
-  -> IO ()
+evaluate "!quit" = do
-evaluate handle "!quit" = do
+  write "QUIT" ":I have been orderd to go"
-  write handle "QUIT" ":I have been orderd to go"
+  liftIO exitSuccess
-  exitSuccess
+evaluate text | "!say " `isPrefixOf` text =
-evaluate handle text | "!say " `isPrefixOf` text =
+  privmsg (drop 5 text)
-  privmsg handle (drop 4 text)
+evaluate _ =
-evaluate _ _ =
   return ()

src/Types.hs

@@ -0,0 +1,11 @@
+module Types where
+
+import Control.Monad.Reader (ReaderT(..))
+
+import System.IO (Handle)
+
+data Bot = Bot
+  { botSocket :: Handle
+  }
+
+type Net = ReaderT Bot IO