diff --git a/Main.hs b/Main.hs index 3da9bf9..995d352 100644 --- a/Main.hs +++ b/Main.hs @@ -7,12 +7,12 @@ module Main (main) where import qualified Data.Configurator as CF import ClassyPrelude hiding (try, getArgs) -import Control.Concurrent.Lifted -import Control.Exception.Lifted -import Data.Configurator.Types -import System.Environment -import System.Exit -import System.Posix.Signals +import Control.Concurrent.Lifted (myThreadId) +import Control.Exception.Lifted (try, throwTo, AsyncException (UserInterrupt)) +import Data.Configurator.Types (Configured (..), ConfigError (..), Value (List), KeyError (..)) +import System.Environment (getArgs, getProgName) +import System.Exit (exitFailure) +import System.Posix.Signals (installHandler, sigINT, sigTERM, Handler (Catch)) import Network.IRC.Types import Network.IRC.Client @@ -39,7 +39,7 @@ main = do loadBotConfig :: String -> IO BotConfig loadBotConfig configFile = do - eCfg <- try $ CF.load [Required configFile] + eCfg <- try $ CF.load [CF.Required configFile] case eCfg of Left (ParseError _ _) -> error "Error while loading config" Right cfg -> do diff --git a/Network/IRC/Client.hs b/Network/IRC/Client.hs index c9c3e78..d2ef972 100644 --- a/Network/IRC/Client.hs +++ b/Network/IRC/Client.hs @@ -10,13 +10,13 @@ import qualified Data.Text.Format as TF import qualified Data.Text.Format.Params as TF import ClassyPrelude -import Control.Exception.Lifted -import Control.Concurrent.Lifted -import Control.Monad.Reader hiding (forM_, foldM) -import Control.Monad.State hiding (forM_, foldM) -import Network -import System.IO (hIsEOF, hSetBuffering, BufferMode(..)) -import System.Timeout +import Control.Exception.Lifted (mask_, AsyncException (UserInterrupt)) +import Control.Concurrent.Lifted (fork, Chan, newChan, readChan, writeChan, threadDelay) +import Control.Monad.Reader (ask) +import Control.Monad.State (get, put) +import Network (PortID (PortNumber), connectTo, withSocketsDo) +import System.IO (hIsEOF, hSetBuffering, BufferMode(..)) +import System.Timeout (timeout) import Network.IRC.Handlers import Network.IRC.Protocol diff --git a/Network/IRC/Handlers.hs b/Network/IRC/Handlers.hs index 311893d..b9e225d 100644 --- a/Network/IRC/Handlers.hs +++ b/Network/IRC/Handlers.hs @@ -9,11 +9,11 @@ import qualified Network.IRC.Handlers.MessageLogger as L import qualified Network.IRC.Handlers.SongSearch as SS import ClassyPrelude -import Control.Concurrent.Lifted -import Control.Monad.Reader.Class -import Data.Convertible -import Data.Text (strip) -import Data.Time (addUTCTime) +import Control.Concurrent.Lifted (Chan) +import Control.Monad.Reader (ask) +import Data.Convertible (convert) +import Data.Text (strip) +import Data.Time (addUTCTime) import Network.IRC.Types diff --git a/Network/IRC/Handlers/MessageLogger.hs b/Network/IRC/Handlers/MessageLogger.hs index ca60931..7c4857c 100644 --- a/Network/IRC/Handlers/MessageLogger.hs +++ b/Network/IRC/Handlers/MessageLogger.hs @@ -11,13 +11,13 @@ import qualified Data.Text.Format as TF import qualified Data.Text.Format.Params as TF import ClassyPrelude hiding (try, (), (<.>), FilePath, log) -import Control.Concurrent.Lifted -import Control.Exception.Lifted -import Control.Monad.Reader -import Data.Time (diffDays) -import System.Directory -import System.FilePath -import System.IO (openFile, IOMode(..), hSetBuffering, BufferMode(..)) +import Control.Concurrent.Lifted (Chan) +import Control.Exception.Lifted (mask_) +import Control.Monad.Reader (ask) +import Data.Time (diffDays) +import System.Directory (createDirectoryIfMissing, getModificationTime, copyFile, removeFile) +import System.FilePath (FilePath, (), (<.>)) +import System.IO (openFile, IOMode(..), hSetBuffering, BufferMode(..)) import Network.IRC.Types diff --git a/Network/IRC/Handlers/SongSearch.hs b/Network/IRC/Handlers/SongSearch.hs index 07d1c6b..64bbb60 100644 --- a/Network/IRC/Handlers/SongSearch.hs +++ b/Network/IRC/Handlers/SongSearch.hs @@ -8,15 +8,15 @@ module Network.IRC.Handlers.SongSearch (mkMsgHandler) where import qualified Data.Configurator as CF -import ClassyPrelude hiding (try) -import Control.Concurrent.Lifted -import Control.Exception.Lifted -import Control.Monad.Reader -import Data.Aeson -import Data.Aeson.Types (emptyArray) -import Data.Text (strip) -import Network.Curl.Aeson -import Network.HTTP.Base +import ClassyPrelude hiding (try) +import Control.Concurrent.Lifted (Chan) +import Control.Exception.Lifted (try, evaluate) +import Control.Monad.Reader (ask) +import Data.Aeson (FromJSON, parseJSON, Value (..), (.:)) +import Data.Aeson.Types (emptyArray) +import Data.Text (strip) +import Network.Curl.Aeson (curlAesonGet, CurlAesonException) +import Network.HTTP.Base (urlEncode) import Network.IRC.Types diff --git a/Network/IRC/Types.hs b/Network/IRC/Types.hs index e9b393a..b812082 100644 --- a/Network/IRC/Types.hs +++ b/Network/IRC/Types.hs @@ -32,10 +32,12 @@ module Network.IRC.Types where import ClassyPrelude -import Control.Monad.Reader -import Control.Monad.State -import Data.Configurator.Types -import Data.Typeable (cast) +import Control.Monad.Reader (ReaderT, MonadReader, runReaderT) +import Control.Monad.State (StateT, MonadState, execStateT) +import Data.Configurator.Types (Config) +import Data.Typeable (cast) + +-- IRC related type Nick = Text type MsgHandlerName = Text @@ -76,6 +78,8 @@ data Command = | NamesCmd deriving (Show, Eq) +-- Internal events + class (Typeable e, Show e) => Event e where toEvent :: e -> IO SomeEvent toEvent e = SomeEvent <$> pure e <*> getCurrentTime @@ -86,12 +90,10 @@ class (Typeable e, Show e) => Event e where return (ev, time) data SomeEvent = forall e. Event e => SomeEvent e UTCTime deriving (Typeable) - instance Show SomeEvent where show (SomeEvent e time) = formatTime defaultTimeLocale "[%F %T] " time ++ show e data QuitEvent = QuitEvent deriving (Show, Typeable) - instance Event QuitEvent data EventResponse = RespNothing @@ -100,6 +102,8 @@ data EventResponse = RespNothing | RespCommand Command deriving (Show) +-- Bot + data BotConfig = BotConfig { server :: !Text , port :: !Int , channel :: !Text @@ -141,6 +145,8 @@ newtype IRC a = IRC { _runIRC :: StateT BotStatus (ReaderT Bot IO) a } runIRC :: Bot -> BotStatus -> IRC a -> IO BotStatus runIRC bot botStatus = flip runReaderT bot . flip execStateT botStatus . _runIRC +-- Message handlers + newtype MsgHandlerT a = MsgHandlerT { _runMsgHandler :: ReaderT BotConfig IO a } deriving ( Functor , Applicative