clean up

Author: Intrets

app/Main.hs

@@ -31,27 +31,25 @@ main :: IO ()
 main = do
   setLocaleEncoding utf8
   --hSetBuffering stdout NoBuffering
-  options <- execParser clOptionsParser
-  config  <- parseConfigFile $ cfgFile options
-  b       <- connect (T.unpack $ ircServer config) (ircPort config)
+  config <- parseConfigFile . cfgFile =<< execParser clOptionsParser
+  b      <- connect (T.unpack $ ircServer config) (ircPort config)
   let db = Database (dbFile config)
-  s        <- getStdGen
-  catFacts <- loadFacts $ factsFile config
-  let opt = Options b config db catFacts
+  s   <- getStdGen
+  opt <- Options b config db <$> loadFacts (factsFile config)
   bracket (pure opt) disconnect (loop s)
  where
-  disconnect options = do
+  disconnect opts = do
     putStrLn "disconnecting"
-    hClose . botSocket . bot $ options
+    hClose . botSocket . bot $ opts
   loop :: StdGen -> Options -> IO ()
-  loop s options = do
+  loop s opts = do
     _ <-
       flip runStateT messageQueue
       . flip runStateT  simpleCommands
       . flip runStateT  M.empty
       . flip runStateT  s
       . flip runStateT  M.empty
-      . flip runReaderT options
+      . flip runReaderT opts
       $ runApp run
     return ()
 

src/Bot/Catfacts.hs

@@ -5,15 +5,13 @@ import Bot.Random
 
 import Control.Monad.Reader
 import qualified Data.Array as A
-import qualified Data.Text as T (lines, null, pack, strip, unpack)
+import qualified Data.Text as T
 import qualified Data.Text.IO as T (readFile)
-import System.IO hiding (hGetContents)
-import System.IO.Strict (hGetContents)
 
 loadFacts :: StringType -> IO (A.Array Int StringType)
-loadFacts path = do
+loadFacts pth = do
   facts <- filter (not . T.null) . map T.strip . T.lines <$> T.readFile
-    (T.unpack path)
+    (T.unpack pth)
   return . A.listArray (0, pred . length $ facts) $ facts
 
 randomFact :: (MonadIO m, RandomGenerator m, OptionsConfig m) => m StringType

src/Bot/Irc.hs

@@ -6,15 +6,9 @@ import Conc
 import Bot
 import Bot.Irc.Send
 import Command.Commands
-import Conc
-import qualified Conc
 import Control.Monad.Reader
-import Data.Function ((&))
 import qualified Data.Text as T
-  (Text, drop, dropWhile, isPrefixOf, pack, strip, unpack, words)
 import qualified Data.Text.IO as T (hGetLine)
-import GHC.IO.Handle (Handle)
-import System.IO.Unsafe
 
 clean :: StringType -> StringType
 clean = T.strip . T.drop 1 . T.dropWhile (/= ':') . T.drop 1

src/Bot/Irc/Send.hs

@@ -11,15 +11,10 @@ module Bot.Irc.Send
 where
 
 import Bot
-import Bot.Options.Parse
-import Conc
 
-import Control.Concurrent
-import Control.Concurrent.Async
 import Control.Monad.IO.Class
 import Control.Monad.Reader
 import System.Exit
-import System.IO
 
 import qualified Data.Text as T
 import qualified Data.Text.IO as T

src/Command.hs

@@ -15,17 +15,17 @@ class (Monad m) =>
   putOnCooldown :: Command a -> User -> m ()
 
 checkUserOnCooldown :: Command m -> User -> POSIXTime -> App Bool
-checkUserOnCooldown command user time =
+checkUserOnCooldown command usr time =
   if requireUserCooldown . options $ command
     then do
       userCooldowns <- userLift get
-      case (> time) <$> M.lookup user userCooldowns of
+      case (> time) <$> M.lookup usr userCooldowns of
         Nothing -> return False
         Just r  -> return r
     else return False
 
 checkCommandOnCooldown :: Command m -> User -> POSIXTime -> App Bool
-checkCommandOnCooldown command user time =
+checkCommandOnCooldown command usr time =
   if requireGlobalCooldown . options $ command
     then do
       commandCooldowns <- commandLift get
@@ -35,17 +35,17 @@ checkCommandOnCooldown command user time =
     else return False
 
 instance CommandCooldownHandler App where
-  isOnCooldown command user time = do
-    u <- checkUserOnCooldown command user time
-    c <- checkCommandOnCooldown command user time
+  isOnCooldown command usr time = do
+    u <- checkUserOnCooldown command usr time
+    c <- checkCommandOnCooldown command usr time
     return $ not (u && c)
-  putOnCooldown command user = do
+  putOnCooldown command usr = do
     time <- liftIO getPOSIXTime
     commandLift $ modify $ M.insert
       (name command)
       ((time +) $ globalCooldown . options $ command)
     userLift $ modify $ M.insert
-      user
+      usr
       ((time +) $ userCooldown . options $ command)
 
 class (Monad m) =>

src/Command/Commands.hs

@@ -1,7 +1,4 @@
 {-# LANGUAGE TupleSections #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE Arrows #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Command.Commands where
@@ -27,17 +24,17 @@ import Control.Monad.IO.Class
 import qualified Data.HashMap.Strict as M
 
 runCommandM :: Message -> ConcM App ()
-runCommandM message@(Message text user) = do
+runCommandM message@(Message text usr) = do
   c <- pureM $ do
     cmd <- getCommand message
     case cmd of
       Nothing      -> return Nothing
       Just command -> do
         time       <- liftIO getPOSIXTime
-        onCooldown <- isOnCooldown command user time
+        onCooldown <- isOnCooldown command usr time
         if onCooldown
           then do
-            putOnCooldown command user
+            putOnCooldown command usr
             return $ Just $ action command message
           else return Nothing
   case c of
@@ -64,12 +61,12 @@ commandList =
     "facts"
     ["!fact", "!f", "forsenScoots", "OMGScoots"]
     (CommandOptions 2 2 True True (const True))
-    (randomFactCommand)
+    randomFactCommand
   , Command
     "real facts"
     ["!realfact", "!rf"]
     (CommandOptions 2 2 True True (const True))
-    (randomFactCommand)
+    randomFactCommand
   , Command
     "dubious facts"
     ["!dubiousfact", "!df"]

src/MessageQueue.hs

@@ -1,20 +1,12 @@
-{-# LANGUAGE Arrows #-}
-
 module MessageQueue where
 
 import Bot
 import Bot.Irc.Send
 import Conc
 import Control.Concurrent
 import Control.Monad.State.Strict
-import Data.Function ((&))
 import Data.Time.Clock.POSIX
 import Queue
-import qualified Data.Text.IO as T
-import qualified Data.Text as T
-import Control.Monad.Reader
-import GHC.IO.Handle (Handle)
-import Control.Arrow
 
 messageLift :: StateT MessageQueue IO a -> App a
 messageLift = App . lift . lift . lift . lift . lift
@@ -26,14 +18,14 @@ queueMessage message = messageLift
 messageDispensingLoopM :: ConcM App ()
 messageDispensingLoopM = do
   _ <- pureM $ do
-    MessageQueue time queue <- messageLift get
-    if isEmpty queue
+    MessageQueue time q <- messageLift get
+    if isEmpty q
       then return ()
       else do
         currentTime <- liftIO getPOSIXTime
         when (currentTime > time) $ do
-          let (Just message, q) = pop queue
-          messageLift . put $ MessageQueue (currentTime + 2) q
+          let (Just message, q_new) = pop q
+          messageLift . put $ MessageQueue (currentTime + 2) q_new
           privmsg message
           liftIO $ print $ currentTime > time
   _ <- taskM $ threadDelay 100000