diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,3 +1,3 @@ #!/usr/bin/env runhaskell import Distribution.Simple -main = defaultMainWithHooks defaultUserHooks +main = defaultMain diff --git a/lambdabot-core.cabal b/lambdabot-core.cabal --- a/lambdabot-core.cabal +++ b/lambdabot-core.cabal @@ -1,5 +1,5 @@ name: lambdabot-core -version: 5.2 +version: 5.3 license: GPL license-file: LICENSE @@ -18,8 +18,8 @@ homepage: https://wiki.haskell.org/Lambdabot build-type: Simple -cabal-version: >= 1.8 -tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5 +cabal-version: >= 1.10 +tested-with: GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.3 extra-source-files: AUTHORS.md COMMENTARY.md @@ -33,6 +33,7 @@ hs-source-dirs: src ghc-options: -Wall -funbox-strict-fields + default-language: Haskell98 exposed-modules: Lambdabot.Bot Lambdabot.ChanName @@ -71,26 +72,26 @@ binary >= 0.5, bytestring >= 0.9, containers >= 0.4, - dependent-map == 0.2.*, - dependent-sum >= 0.3 && < 0.6, - dependent-sum-template >= 0.0.0.1, + dependent-map >= 0.2 && < 0.4, + dependent-sum >= 0.7 && < 0.8, + dependent-sum-template >= 0.1.0.2 && < 0.2, directory >= 1.1, edit-distance >= 0.2, filepath >= 1.3, - haskeline >= 0.7, + haskeline >= 0.7 && < 0.8, hslogger >= 1.2.1, HTTP >= 4000, lifted-base >= 0.2, monad-control >= 1.0, mtl >= 2, network >= 2.7 && < 3.2, - network-bsd >= 2.8 && < 2.9, + network-bsd >= 2.7 && < 2.9, parsec >= 3, - prim-uniq == 0.1.*, + prim-uniq >= 0.2 && < 0.4, random >= 1, random-fu >= 0.2.6.2, random-source >= 0.3, - regex-tdfa >= 1.1, + regex-tdfa >= 1.1 && < 1.4, SafeSemaphore >= 0.9, split >= 0.2, syb >= 0.3, diff --git a/src/Lambdabot/Command.hs b/src/Lambdabot/Command.hs --- a/src/Lambdabot/Command.hs +++ b/src/Lambdabot/Command.hs @@ -28,6 +28,8 @@ import Lambdabot.Nick import Control.Applicative +import Control.Monad.Fail (MonadFail) +import qualified Control.Monad.Fail import Control.Monad.Base import Control.Monad.Identity import Control.Monad.Reader @@ -49,6 +51,7 @@ instance Monad m => Monad (Cmd m) where return = Cmd . return Cmd x >>= f = Cmd (x >>= (unCmd . f)) +instance MonadFail m => MonadFail (Cmd m) where fail = lift . fail instance MonadIO m => MonadIO (Cmd m) where liftIO = lift . liftIO diff --git a/src/Lambdabot/Main.hs b/src/Lambdabot/Main.hs --- a/src/Lambdabot/Main.hs +++ b/src/Lambdabot/Main.hs @@ -102,11 +102,11 @@ where instalify x = let module' = varE $ mkName (x ++ "Plugin") - in [| (x, This $module') |] + in [| (x, Some $module') |] withModules :: Modules -> LB a -> LB a withModules [] = id -withModules ((n, This m):ms) = withModule n m . withModules ms +withModules ((n, Some m):ms) = withModule n m . withModules ms withModule :: String -> Module st -> LB a -> LB a withModule name m = bracket_ (ircLoadModule name m) (ircUnloadModule name) diff --git a/src/Lambdabot/Module.hs b/src/Lambdabot/Module.hs --- a/src/Lambdabot/Module.hs +++ b/src/Lambdabot/Module.hs @@ -24,6 +24,8 @@ import Control.Applicative import Control.Concurrent (MVar) import Control.Monad +import Control.Monad.Fail (MonadFail) +import qualified Control.Monad.Fail import Control.Monad.Base import Control.Monad.Reader (MonadReader(..), ReaderT(..), asks) import Control.Monad.Trans (MonadTrans(..), MonadIO(..)) @@ -99,7 +101,7 @@ -- need to access its name or its state. newtype ModuleT st m a = ModuleT { unModuleT :: ReaderT (ModuleInfo st) m a } deriving (Applicative, Functor, Monad, MonadReader (ModuleInfo st), - MonadTrans, MonadIO, MonadException, MonadConfig) + MonadTrans, MonadIO, MonadException, MonadConfig, MonadFail) runModuleT :: ModuleT st m a -> ModuleInfo st -> m a runModuleT = runReaderT . unModuleT diff --git a/src/Lambdabot/Monad.hs b/src/Lambdabot/Monad.hs --- a/src/Lambdabot/Monad.hs +++ b/src/Lambdabot/Monad.hs @@ -60,6 +60,8 @@ import Control.Applicative import Control.Concurrent.Lifted import Control.Exception.Lifted as E (catch) +import Control.Monad.Fail (MonadFail) +import qualified Control.Monad.Fail import Control.Monad.Base import Control.Monad.Identity import Control.Monad.Reader @@ -168,7 +170,7 @@ -- instances Monad, Functor, MonadIO, MonadState, MonadError newtype LB a = LB { unLB :: ReaderT (IRCRState, IORef IRCRWState) IO a } - deriving (Functor, Applicative, Monad, MonadIO, MonadException) + deriving (Functor, Applicative, Monad, MonadIO, MonadException, MonadFail) runLB :: LB a -> (IRCRState, IORef IRCRWState) -> IO a runLB = runReaderT . unLB @@ -181,7 +183,7 @@ liftBaseWith action = LB (liftBaseWith (\run -> action (run . unLB))) restoreM = LB . restoreM -class (MonadIO m, MonadBaseControl IO m, MonadConfig m, MonadLogging m, Applicative m) => MonadLB m where +class (MonadIO m, MonadBaseControl IO m, MonadConfig m, MonadLogging m, Applicative m, MonadFail m) => MonadLB m where lb :: LB a -> m a instance MonadLB LB where lb = id @@ -211,7 +213,7 @@ mInfo <- ModuleInfo mName mTag m <$> newMVar mState modify $ \s -> s - { ircModulesByName = M.insert mName (This mInfo) (ircModulesByName s) + { ircModulesByName = M.insert mName (Some mInfo) (ircModulesByName s) , ircModulesByID = D.insert mTag mInfo (ircModulesByID s) } @@ -251,18 +253,18 @@ unregisterModule mName = maybe (return ()) warningM <=< state $ \s -> case M.lookup mName (ircModulesByName s) of Nothing -> (Just $ "Tried to unregister module that wasn't registered: " ++ show mName, s) - Just (This modInfo) -> + Just (Some modInfo) -> let mTag = moduleID modInfo - notThisTag :: DSum ModuleID f -> Bool - notThisTag (tag :=> _) = This tag /= This mTag + notSomeTag :: DSum ModuleID f -> Bool + notSomeTag (tag :=> _) = Some tag /= Some mTag s' = s { ircModulesByName = M.delete mName (ircModulesByName s) , ircModulesByID = D.delete mTag (ircModulesByID s) - , ircCommands = M.filter notThisTag (ircCommands s) + , ircCommands = M.filter notSomeTag (ircCommands s) , ircCallbacks = M.map (D.delete mTag) (ircCallbacks s) - , ircServerMap = M.filter notThisTag (ircServerMap s) - , ircOutputFilters = filter notThisTag (ircOutputFilters s) + , ircServerMap = M.filter notSomeTag (ircServerMap s) + , ircOutputFilters = filter notSomeTag (ircOutputFilters s) } in (Nothing, s') @@ -339,7 +341,7 @@ mbMod <- gets (M.lookup name . ircModulesByName) case mbMod of Nothing -> nothing - Just (This modInfo) -> runModuleT just modInfo + Just (Some modInfo) -> runModuleT just modInfo inModuleWithID :: ModuleID st -> LB a -> (ModuleT st LB a) -> LB a inModuleWithID tag nothing just = do @@ -362,4 +364,4 @@ withAllModules :: (forall st. ModuleT st LB a) -> LB () withAllModules f = do mods <- gets $ M.elems . ircModulesByName - forM_ mods $ \(This modInfo) -> runModuleT f modInfo + forM_ mods $ \(Some modInfo) -> runModuleT f modInfo diff --git a/src/Lambdabot/Util/Serial.hs b/src/Lambdabot/Util/Serial.hs --- a/src/Lambdabot/Util/Serial.hs +++ b/src/Lambdabot/Util/Serial.hs @@ -31,6 +31,8 @@ , readOnly ) where +import Control.Monad.Fail (MonadFail) + import Data.Maybe (mapMaybe) import Data.Map (Map) @@ -84,7 +86,7 @@ -- | 'readM' behaves like read, but catches failure in a monad. -- this allocates a 20-30 M on startup... -readM :: (Monad m, Read a) => String -> m a +readM :: (MonadFail m, Read a) => String -> m a readM s = case [x | (x,t) <- {-# SCC "Serial.readM.reads" #-} reads s -- bad! , ("","") <- lex t] of [x] -> return x