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.0 +version: 5.0.1 license: GPL license-file: LICENSE @@ -81,7 +81,7 @@ hslogger >= 1.2.1, HTTP >= 4000, lifted-base >= 0.2, - monad-control >= 0.3 && < 1, + monad-control >= 1.0, mtl >= 2, network >= 2.3.0.13, time >= 1.4, diff --git a/src/Lambdabot/Command.hs b/src/Lambdabot/Command.hs --- a/src/Lambdabot/Command.hs +++ b/src/Lambdabot/Command.hs @@ -57,17 +57,17 @@ instance MonadTrans Cmd where lift = Cmd . lift . lift instance MonadTransControl Cmd where - newtype StT Cmd a = StCmd {unStCmd :: (a, [String])} + type StT Cmd a = (a, [String]) liftWith f = do r <- Cmd ask - lift $ f $ \t -> liftM StCmd (runWriterT (runReaderT (unCmd t) r)) - restoreT = Cmd . lift . WriterT . liftM unStCmd + lift $ f $ \t -> runWriterT (runReaderT (unCmd t) r) + restoreT = Cmd . lift . WriterT {-# INLINE liftWith #-} {-# INLINE restoreT #-} instance MonadBaseControl b m => MonadBaseControl b (Cmd m) where - newtype StM (Cmd m) a = StMCmd {unStMCmd :: ComposeSt Cmd m a} - liftBaseWith = defaultLiftBaseWith StMCmd - restoreM = defaultRestoreM unStMCmd + type StM (Cmd m) a = ComposeSt Cmd m a + liftBaseWith = defaultLiftBaseWith + restoreM = defaultRestoreM {-# INLINE liftBaseWith #-} {-# INLINE restoreM #-} instance MonadConfig m => MonadConfig (Cmd m) where diff --git a/src/Lambdabot/Config/Core.hs b/src/Lambdabot/Config/Core.hs --- a/src/Lambdabot/Config/Core.hs +++ b/src/Lambdabot/Config/Core.hs @@ -9,6 +9,7 @@ , enableInsults , onStartupCmds , outputDir + , dataDir , uncaughtExceptionHandler , replaceRootLogger @@ -33,6 +34,8 @@ config "enableInsults" [t| Bool |] [| True |] configWithMerge [| (++) |] "onStartupCmds" [t| [String] |] [| ["offline"] |] config "outputDir" [t| FilePath |] [| "State/" |] +-- The dataDir variable will be filled by lambdabot's executable +config "dataDir" [t| FilePath |] [| "." |] -- basic logging. for more complex setups, configure directly using System.Log.Logger config "replaceRootLogger" [t| Bool |] [| True |] diff --git a/src/Lambdabot/File.hs b/src/Lambdabot/File.hs --- a/src/Lambdabot/File.hs +++ b/src/Lambdabot/File.hs @@ -1,6 +1,19 @@ +-- | Manage lambdabot's state files. There are three relevant directories: +-- +-- * local: @./State/@ (configurable, see `outputDir`) +-- * home: @~/.lambdabot/State/@ +-- * data: relative to the data directory of the @lambdabot@ package. +-- +-- Files are stored locally if the directory exists; otherwise, in the home +-- directory. When reading a state file, and the file exists in the data +-- directory but nowhere else, then it is picked up from the data directory. + module Lambdabot.File - ( findLBFile + ( stateDir + , findLBFileForReading + , findLBFileForWriting , findOrCreateLBFile + , findLBFile -- deprecated , outputDir ) where @@ -10,113 +23,76 @@ import Control.Applicative import Control.Monad -import Paths_lambdabot_core import System.Directory import System.FilePath --- | Constants. lambdabot :: FilePath lambdabot = ".lambdabot" +-- | Locate state directory. Returns the local directory if it exists, +-- and the home directory otherwise. stateDir :: LB FilePath -stateDir = (lambdabot ) <$> getConfig outputDir - -maybeFileExists :: FilePath -> IO (Maybe FilePath) -maybeFileExists path = do - b <- doesFileExist path - return $! if b then Just path else Nothing - --- | For a given file, look locally under State/. That is, suppose one is --- running out of a Lambdabot darcs repository in /home/cale/lambdabot. Then --- --- > lookLocally "fact" ~> "/home/cale/lambdabot/State/fact" -lookLocally :: FilePath -> LB (Maybe String) -lookLocally file = do - local <- getConfig outputDir - io $ maybeFileExists (local file) +stateDir = do + -- look locally + output <- getConfig outputDir + b <- io $ doesDirectoryExist output + if b then return output else homeDir --- | For a given file, look at the home directory. By default, we stash files in --- ~/.lambdabot. So, running Lambdabot normally would let us do: --- --- > lookHome "fact" ~> "/home/cale/lambdabot/State/fact" --- --- (Note that for convenience we preserve the "State/foo" address pattern.) -lookHome :: FilePath -> LB (Maybe String) -lookHome f = do - home <- io getHomeDirectory - state <- stateDir - io (maybeFileExists $ home state f) +homeDir :: LB FilePath +homeDir = do + output <- getConfig outputDir + home <- io getHomeDirectory + return $ home lambdabot output --- | Do ~/.lambdabot & ~/.lambdabot/State exist? -isHome :: LB Bool -isHome = do - home <- io getHomeDirectory +-- | Look for the file in the local, home, and data directories. +findLBFileForReading :: FilePath -> LB (Maybe FilePath) +findLBFileForReading f = do state <- stateDir - io . fmap and . mapM (doesDirectoryExist . (home )) $ [lambdabot, state] + home <- homeDir + output <- getConfig outputDir + rodir <- getConfig dataDir + findFirstFile [state f, home f, rodir output f] --- | Create ~/.lambdabot and ~/.lambdabot/State -mkdirL :: LB () -mkdirL = do - home <- io getHomeDirectory +-- | Return file name for writing state. The file will reside in the +-- state directory (`stateDir`), and `findLBFileForWriting` ensures that +-- the state directory exists. +findLBFileForWriting :: FilePath -> LB FilePath +findLBFileForWriting f = do state <- stateDir - - io . mapM_ (createDirectory . (home )) $ [lambdabot, state] + -- ensure that the directory exists + io $ createDirectoryIfMissing True state + success <- io $ doesDirectoryExist state + when (not success) $ fail $ concat ["Unable to create directory ", state] + return $ state f --- | Ask Cabal for the read-only copy of a file, and copy it into ~/.lambdabot/State. --- if there isn't a read-only copy, create an empty file. -cpDataToHome :: FilePath -> LB () -cpDataToHome f = do - local <- getConfig outputDir - state <- stateDir - - rofile <- io (getDataFileName (local f)) - home <- io getHomeDirectory - -- cp /.../lambdabot-4.foo/State/foo ~/.lambdabot/State/foo - - let outFile = home state f - exists <- io (doesFileExist rofile) - if exists - then io (copyFile rofile outFile) - else io (writeFile outFile "") +findFirstFile :: [FilePath] -> LB (Maybe FilePath) +findFirstFile [] = return Nothing +findFirstFile (path:ps) = do + b <- io $ doesFileExist path + if b then return (Just path) else findFirstFile ps --- | Try to find a pre-existing file, searching first in ./State and then in --- ~/.lambdabot/State +{-# DEPRECATED findLBFile + "Use `findLBFileForReading` or `findLBFileForWriting` instead" #-} +-- | Try to find a pre-existing file, searching first in the local or home +-- directory (but not in the data directory) findLBFile :: FilePath -> LB (Maybe String) findLBFile f = do - first <- lookLocally f - case first of - -- With any luck we can exit quickly - Just a -> return (Just a) - -- OK, we didn't get lucky with local, so - -- hopefully it's in ~/.lambdabot - Nothing -> lookHome f + state <- stateDir + home <- homeDir + findFirstFile [state f, home f] --- | Complicated. If a file exists locally, we return that. If a file exists in --- ~/lambdabot/State, we return that. If neither the file nor ~/lambdabot/State --- exist, we create the directories and then copy the file into it if a template --- exists, or create an empty file if it does not. --- Note that the return type is simple so we can just do a binding and stuff it --- into the conventional functions easily; unfortunately, this removes --- error-checking, as an error is now just \"\". +-- | This returns the same file name as `findLBFileForWriting`. +-- If the file does not exist, it is either copied from the data (or home) +-- directory, if a copy is found there; otherwise, an empty file is +-- created instead. findOrCreateLBFile :: FilePath -> LB String findOrCreateLBFile f = do - mbFile <- findLBFile f - case mbFile of - Just file -> return file - -- Uh oh. We didn't find it locally, nor did we - -- find it in ~/.lambdabot/State. So now we - -- need to make ~/.lambdabot/State and copy it in. - Nothing -> do - exists <- isHome - when (not exists) mkdirL - cpDataToHome f - -- With the file copied/created, - -- a second attempt should work. - g <- lookHome f - case g of - Just a -> return a - Nothing -> do - home <- io getHomeDirectory - state <- stateDir - fail $ "findOrCreateLBFile: couldn't find file " - ++ f ++ " in " ++ home state + outFile <- findLBFileForWriting f + b <- io $ doesFileExist outFile + when (not b) $ do + -- the file does not exist; populate it from home or data directory + b <- findLBFileForReading f + case b of + Nothing -> io $ writeFile outFile "" + Just roFile -> io $ copyFile roFile outFile + return outFile diff --git a/src/Lambdabot/Main.hs b/src/Lambdabot/Main.hs --- a/src/Lambdabot/Main.hs +++ b/src/Lambdabot/Main.hs @@ -29,7 +29,7 @@ import Data.Typeable import Data.Version import Language.Haskell.TH -import Paths_lambdabot_core +import Paths_lambdabot_core (version) import System.Exit import System.Log.Formatter import qualified System.Log.Logger as L diff --git a/src/Lambdabot/Module.hs b/src/Lambdabot/Module.hs --- a/src/Lambdabot/Module.hs +++ b/src/Lambdabot/Module.hs @@ -99,18 +99,18 @@ liftBase = lift . liftBase instance MonadTransControl (ModuleT st) where - newtype StT (ModuleT st) a = StModule {unStModule :: a} + type StT (ModuleT st) a = a liftWith f = do r <- ModuleT ask - lift $ f $ \t -> liftM StModule (runReaderT (runModuleT t) r) - restoreT = lift . liftM unStModule + lift $ f $ \t -> runReaderT (runModuleT t) r + restoreT = lift {-# INLINE liftWith #-} {-# INLINE restoreT #-} instance MonadBaseControl b m => MonadBaseControl b (ModuleT st m) where - newtype StM (ModuleT st m) a = StMModule {unStMModule :: ComposeSt (ModuleT st) m a} - liftBaseWith = defaultLiftBaseWith StMModule - restoreM = defaultRestoreM unStMModule + type StM (ModuleT st m) a = ComposeSt (ModuleT st) m a + liftBaseWith = defaultLiftBaseWith + restoreM = defaultRestoreM {-# INLINE liftBaseWith #-} {-# INLINE restoreM #-} diff --git a/src/Lambdabot/Monad.hs b/src/Lambdabot/Monad.hs --- a/src/Lambdabot/Monad.hs +++ b/src/Lambdabot/Monad.hs @@ -5,6 +5,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} module Lambdabot.Monad ( IRCRState , initRoState @@ -204,9 +205,9 @@ liftBase = LB . liftBase instance MonadBaseControl IO LB where - newtype StM LB a = StLB { unStLB :: StM (ReaderT (IRCRState,IORef IRCRWState) IO) a } - liftBaseWith action = LB (liftBaseWith (\run -> action (fmap StLB . run . runLB))) - restoreM = LB . restoreM . unStLB + type StM LB a = StM (ReaderT (IRCRState,IORef IRCRWState) IO) a + liftBaseWith action = LB (liftBaseWith (\run -> action (run . runLB))) + restoreM = LB . restoreM class (MonadIO m, MonadBaseControl IO m, MonadConfig m, MonadLogging m, Applicative m) => MonadLB m where lb :: LB a -> m a diff --git a/src/Lambdabot/Plugin/Core/OfflineRC.hs b/src/Lambdabot/Plugin/Core/OfflineRC.hs --- a/src/Lambdabot/Plugin/Core/OfflineRC.hs +++ b/src/Lambdabot/Plugin/Core/OfflineRC.hs @@ -41,7 +41,7 @@ , help = say "offline. Start a repl" , process = const . lift $ do lockRC - histFile <- lb $ findOrCreateLBFile "offlinerc" + histFile <- lb $ findLBFileForWriting "offlinerc" let settings = defaultSettings { historyFile = Just histFile } _ <- fork (runInputT settings replLoop `finally` unlockRC) return () diff --git a/src/Lambdabot/Plugin/Core/Version.hs b/src/Lambdabot/Plugin/Core/Version.hs --- a/src/Lambdabot/Plugin/Core/Version.hs +++ b/src/Lambdabot/Plugin/Core/Version.hs @@ -17,7 +17,7 @@ "and git repo of this bot" , process = const $ do say $ "lambdabot " ++ showVersion version - say "git clone git://github.com/lambdabot/lambdabot.git" + say "git clone https://github.com/lambdabot/lambdabot" } ] } diff --git a/src/Lambdabot/State.hs b/src/Lambdabot/State.hs --- a/src/Lambdabot/State.hs +++ b/src/Lambdabot/State.hs @@ -188,7 +188,7 @@ case serialize ser state' of Nothing -> return () -- do not write any state Just out -> do - stateFile <- lb (findOrCreateLBFile name) + stateFile <- lb (findLBFileForWriting name) io (P.writeFile stateFile out) -- | Read it in @@ -197,7 +197,7 @@ debugM ("loading state for module " ++ show name) case moduleSerialize module' of Just ser -> do - mbStateFile <- findLBFile name + mbStateFile <- findLBFileForReading name case mbStateFile of Nothing -> return Nothing Just stateFile -> io $ do