lambdabot-core 5.0 → 5.0.1

raw patch · 10 files changed

+94/−114 lines, 10 filesdep ~monad-controlPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: monad-control

API changes (from Hackage documentation)

Files

• lambdabot-core.cabal +2/−2
• src/Lambdabot/Command.hs +6/−6
• src/Lambdabot/Config/Core.hs +3/−0
• src/Lambdabot/File.hs +68/−92
• src/Lambdabot/Main.hs +1/−1
• src/Lambdabot/Module.hs +6/−6
• src/Lambdabot/Monad.hs +4/−3
• src/Lambdabot/Plugin/Core/OfflineRC.hs +1/−1
• src/Lambdabot/Plugin/Core/Version.hs +1/−1
• src/Lambdabot/State.hs +2/−2

@@ -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,

@@ -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

@@ -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                        |]

@@ -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

@@ -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

@@ -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 #-} 

@@ -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

@@ -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 ()

@@ -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"             }         ]     }

@@ -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