From 297dbcdc48b9b8cf4d53880a9b9992fb4b646c40 Mon Sep 17 00:00:00 2001 From: Austin Seipp Date: Sun, 27 Jan 2008 17:17:39 -0600 Subject: [PATCH] Fixed nasty error involving GHCi, ghc and bytestring The whole basic discussion is here: http://www.haskell.org/pipermail/haskell-cafe/2008-January/038702.html Fixing it so we can still run tests and use Setup.hs involved moving around some stuff in the code base, but there were really no substantial changes. Mainly just moving some declarations and changing a few imports. --- Config.hs | 16 ++++------------ Config.hs-boot | 3 --- Infinity/Core.hs | 16 +++++++++++++--- Infinity/Main.hs | 32 ++++++++++++++++---------------- Main.hs | 1 - Setup.hs | 2 +- Tests/Properties.hs | 2 +- 7 files changed, 35 insertions(+), 37 deletions(-) delete mode 100644 Config.hs-boot diff --git a/Config.hs b/Config.hs index 28b6781..472cce2 100644 --- a/Config.hs +++ b/Config.hs @@ -1,8 +1,9 @@ -- | This is the configuration file, which specifies -- what servers the bot joins, the prefix for commands, -- and what plugins are enabled -module Config (Server(..),Config(..),config) where +module Config (Config(..),config) where import Data.Set +import Infinity.Core import Infinity.Plugins -- After this point, you should include any plugins you want -- to have included into the bot. Naturally, you can reconfigure @@ -13,17 +14,6 @@ import Infinity.Plugins.Fortune import Infinity.Plugins.System import Infinity.Plugins.Unlambda --- | Describes a single IRC server -data Server = Server { - address :: String, -- ^ what server to connect to - port :: Int, -- ^ what port - channels :: Set String, -- ^ what channels to enter - nickname :: String, -- ^ bot nick - password :: String, -- ^ bot password, can be empty - realname :: String, -- ^ bot's real name - administrators :: Set String -- ^ bot admins -} deriving (Eq,Show,Ord) - -- | Configuration data type, specifies command -- prefixes and all servers that're connected to data Config = Config { @@ -32,6 +22,8 @@ data Config = Config { enabledplugins :: [IModule] -- ^ List of enabled plugins } +-- | Describes a single IRC Server, you can just follow the +-- same template. To see the full datatype, check Infinity/Core.hs freenode = Server { address = "irc.freenode.org", port = 6667, diff --git a/Config.hs-boot b/Config.hs-boot deleted file mode 100644 index 8eb5d25..0000000 --- a/Config.hs-boot +++ /dev/null @@ -1,3 +0,0 @@ -module Config where - -data Server diff --git a/Infinity/Core.hs b/Infinity/Core.hs index ab9d909..b257d1a 100644 --- a/Infinity/Core.hs +++ b/Infinity/Core.hs @@ -1,7 +1,7 @@ {-# LANGUAGE ExistentialQuantification #-} module Infinity.Core ( -- * Types - Bot(..), + Bot(..), Server(..), -- * Functions on 'Bot' newbot, -- :: Bot joinchan, partchan, -- :: Channel -> Serv -> Serv @@ -12,13 +12,23 @@ module Infinity.Core ( servexists, -- :: Serv -> Bot -> Bool servnum -- :: Bot -> Int ) where -import Infinity.Plugins import Infinity.Util import System.IO import Data.Map (Map) +import Data.Set (Set) import qualified Data.Set as S import qualified Data.Map as M -import Config + +-- | Describes a single IRC server +data Server = Server { + address :: String, -- ^ what server to connect to + port :: Int, -- ^ what port + channels :: Set String, -- ^ what channels to enter + nickname :: String, -- ^ bot nick + password :: String, -- ^ bot password, can be empty + realname :: String, -- ^ bot's real name + administrators :: Set String -- ^ bot admins +} deriving (Eq,Show,Ord) -- | This corresponds to the bot's -- general state overall. diff --git a/Infinity/Main.hs b/Infinity/Main.hs index bcbfc07..2853d7d 100644 --- a/Infinity/Main.hs +++ b/Infinity/Main.hs @@ -52,9 +52,9 @@ type Reboot = (Module -> Bot -> IO ()) -- | Data that can go over the remote channel data RemoteLine = Str String -- ^ A regular string - | Quit (C.Server,Handle) -- ^ A quit message from a server - | Join (C.Server,Channel) -- ^ Joined a channel - | Part (C.Server,Channel) -- ^ Parted the channel + | Quit (Server,Handle) -- ^ A quit message from a server + | Join (Server,Channel) -- ^ Joined a channel + | Part (Server,Channel) -- ^ Parted the channel | Reboot -- ^ Reboot message sent | Nil -- ^ Signifies thread death, -- only happens after reboot @@ -165,19 +165,19 @@ monitor plugins rchan rebootvar bot = do -- | This is the entry point for threads that listen on sockets for -- messages -listener :: [IModule] -> Chan RemoteLine -> Maybe (TMVar Bool) -> (C.Server,Handle) -> IO () +listener :: [IModule] -> Chan RemoteLine -> Maybe (TMVar Bool) -> (Server,Handle) -> IO () listener plugins rchan rebootvar x@(serv,handle) = infinity $ do str <- hGetLine handle writeChan rchan (Str str) if ping str then pong handle str else eval (ircParser str) where eval s | (Err e) <- s = logs Error ("eval err: "++e) - | (Line u c x) <- s = irclog (C.address serv) (u,c,x) + | (Line u c x) <- s = irclog (address serv) (u,c,x) | (Cmd u c (cmd,av)) <- s = do let cmd' = tail cmd case av of - Nothing -> irclog (C.address serv) (u,c,cmd) - Just args -> irclog (C.address serv) (u,c,unwords [cmd,args]) + Nothing -> irclog (address serv) (u,c,cmd) + Just args -> irclog (address serv) (u,c,unwords [cmd,args]) unless (null cmd') (parseCmds cmd' av c $ IContext (Just serv) plugins (Just handle)) parseCmds c av chan ctx | "join" == c = case av of @@ -194,7 +194,7 @@ listener plugins rchan rebootvar x@(serv,handle) = infinity $ do logs Normal $ "Output of \'"++cmd'++"\', with args \'"++(show av)++"\': "++str #endif mapM_ (\s -> privmsg handle chan s >> - irclog (C.address serv) ((C.nickname serv),chan,s)) (lines str) + irclog (address serv) ((nickname serv),chan,s)) (lines str) -------------------------------- @@ -245,9 +245,9 @@ startup = do -- | Connects to a server servcon s = do - let name = C.address s - port = C.port s - h <- connectTo name (PortNumber $ fromIntegral port) + let name = address s + portn = port s + h <- connectTo name (PortNumber $ fromIntegral portn) hSetBuffering h NoBuffering return (s,h) @@ -257,11 +257,11 @@ servcon s = do -- as well as joining channels. setup x@(serv,handle) = do -- setup authentication and stuff - sendstr handle (IRC.encode $ IRC.nick (C.nickname serv)) -- nick - sendstr handle (IRC.encode $ IRC.user (C.nickname serv) "0" "*" (C.realname serv)) -- realname - when (not . null $ (C.password serv)) $ do - sendstr handle (IRC.encode $ IRC.privmsg "nickserv" ("identify "++(C.password serv))) -- password - mapM_ (sendstr handle . IRC.encode . IRC.joinChan) (S.toList $ C.channels serv) -- channels + sendstr handle (IRC.encode $ IRC.nick (nickname serv)) -- nick + sendstr handle (IRC.encode $ IRC.user (nickname serv) "0" "*" (realname serv)) -- realname + when (not . null $ (password serv)) $ do + sendstr handle (IRC.encode $ IRC.privmsg "nickserv" ("identify "++(password serv))) -- password + mapM_ (sendstr handle . IRC.encode . IRC.joinChan) (S.toList $ channels serv) -- channels return () -- | Send a string over handle diff --git a/Main.hs b/Main.hs index c5fc729..aaed5e0 100644 --- a/Main.hs +++ b/Main.hs @@ -4,7 +4,6 @@ import Control.Concurrent import System.Environment import Control.Monad import System.Exit -import GHC.Exts #ifdef STATIC_BUILD import Infinity #else diff --git a/Setup.hs b/Setup.hs index df00acb..510320c 100755 --- a/Setup.hs +++ b/Setup.hs @@ -1,8 +1,8 @@ #!/usr/bin/env runghc import Distribution.Simple import qualified Control.Exception as Ex -import System.Directory import qualified Tests.Properties as P +import System.Directory import System.FilePath import Control.Monad import System.Info diff --git a/Tests/Properties.hs b/Tests/Properties.hs index e87ee93..bff2283 100644 --- a/Tests/Properties.hs +++ b/Tests/Properties.hs @@ -6,7 +6,7 @@ import System.Exit import System.IO import qualified Data.Set as S import qualified Data.Map as M -import Infinity +import Infinity.Core instance Arbitrary Server where arbitrary = do -- 2.11.4.GIT