{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
-- | Support for the LB (LambdaBot) monad
module Lambdabot.State
    ( -- ** Functions to access the module's state
      MonadLBState(..)
    , readMS
    , writeMS
    , modifyMS
    
    -- ** Utility functions for modules that need state for each target.
    , GlobalPrivate -- (global)
    , mkGlobalPrivate
    
    , withPS
    , readPS
    , writePS
    
    , withGS
    , readGS
    , writeGS
    
    -- ** Handling global state
    , readGlobalState
    , writeGlobalState
  ) where

import Lambdabot.File
import Lambdabot.Logging
import Lambdabot.Monad
import Lambdabot.Module
import Lambdabot.Nick
import Lambdabot.Command
import Lambdabot.Util
import Lambdabot.Util.Serial

import Control.Concurrent.Lifted
import Control.Exception.Lifted as E
import Control.Monad.Reader
import Control.Monad.Trans.Control
import qualified Data.ByteString.Char8 as P
import Data.IORef.Lifted

-- | Thread-safe modification of an MVar.
withMWriter :: MonadBaseControl IO m => MVar a -> (a -> (a -> m ()) -> m b) -> m b
withMWriter :: MVar a -> (a -> (a -> m ()) -> m b) -> m b
withMWriter MVar a
mvar a -> (a -> m ()) -> m b
f = m (a, IORef a)
-> ((a, IORef a) -> m Bool) -> ((a, IORef a) -> m b) -> m b
forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
  (do a
x <- MVar a -> m a
forall (m :: * -> *) a. MonadBase IO m => MVar a -> m a
takeMVar MVar a
mvar; IORef a
ref <- a -> m (IORef a)
forall (m :: * -> *) a. MonadBase IO m => a -> m (IORef a)
newIORef a
x; (a, IORef a) -> m (a, IORef a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x,IORef a
ref))
  (\(a
_,IORef a
ref) -> MVar a -> a -> m Bool
forall (m :: * -> *) a. MonadBase IO m => MVar a -> a -> m Bool
tryPutMVar MVar a
mvar (a -> m Bool) -> m a -> m Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef a -> m a
forall (m :: * -> *) a. MonadBase IO m => IORef a -> m a
readIORef IORef a
ref)
  (\(a
x,IORef a
ref) -> a -> (a -> m ()) -> m b
f a
x ((a -> m ()) -> m b) -> (a -> m ()) -> m b
forall a b. (a -> b) -> a -> b
$ IORef a -> a -> m ()
forall (m :: * -> *) a. MonadBase IO m => IORef a -> a -> m ()
writeIORef IORef a
ref)

class MonadLB m => MonadLBState m where
    type LBState m
    
    -- | Update the module's private state.
    -- This is the preferred way of changing the state. The state will be locked
    -- until the body returns. The function is exception-safe, i.e. even if
    -- an error occurs or the thread is killed (e.g. because it deadlocked and
    -- therefore exceeded its time limit), the state from the last write operation
    -- will be restored. If the writer escapes, calling it will have no observable
    -- effect.
    -- @withMS@ is not composable, in the sense that a readMS from within the body
    -- will cause a dead-lock. However, all other possibilies to access the state
    -- that came to my mind had even more serious deficiencies such as being prone
    -- to race conditions or semantic obscurities.
    withMS :: (LBState m -> (LBState m -> m ()) -> m a) -> m a

instance MonadLB m => MonadLBState (ModuleT st m) where
    type LBState (ModuleT st m) = st
    withMS :: (LBState (ModuleT st m)
 -> (LBState (ModuleT st m) -> ModuleT st m ()) -> ModuleT st m a)
-> ModuleT st m a
withMS LBState (ModuleT st m)
-> (LBState (ModuleT st m) -> ModuleT st m ()) -> ModuleT st m a
f = do
        MVar st
ref <- (ModuleInfo st -> MVar st) -> ModuleT st m (MVar st)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ModuleInfo st -> MVar st
forall st. ModuleInfo st -> MVar st
moduleState
        MVar st
-> (st -> (st -> ModuleT st m ()) -> ModuleT st m a)
-> ModuleT st m a
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
MVar a -> (a -> (a -> m ()) -> m b) -> m b
withMWriter MVar st
ref st -> (st -> ModuleT st m ()) -> ModuleT st m a
LBState (ModuleT st m)
-> (LBState (ModuleT st m) -> ModuleT st m ()) -> ModuleT st m a
f

instance MonadLBState m => MonadLBState (Cmd m) where
    type LBState (Cmd m) = LBState m
    withMS :: (LBState (Cmd m) -> (LBState (Cmd m) -> Cmd m ()) -> Cmd m a)
-> Cmd m a
withMS LBState (Cmd m) -> (LBState (Cmd m) -> Cmd m ()) -> Cmd m a
f = do
        (a, [String])
x <- (Run Cmd -> m (a, [String])) -> Cmd m (a, [String])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith ((Run Cmd -> m (a, [String])) -> Cmd m (a, [String]))
-> (Run Cmd -> m (a, [String])) -> Cmd m (a, [String])
forall a b. (a -> b) -> a -> b
$ \Run Cmd
run -> 
            (LBState m -> (LBState m -> m ()) -> m (a, [String]))
-> m (a, [String])
forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS ((LBState m -> (LBState m -> m ()) -> m (a, [String]))
 -> m (a, [String]))
-> (LBState m -> (LBState m -> m ()) -> m (a, [String]))
-> m (a, [String])
forall a b. (a -> b) -> a -> b
$ \LBState m
st LBState m -> m ()
wr -> 
                Cmd m a -> m (StT Cmd a)
Run Cmd
run (LBState (Cmd m) -> (LBState (Cmd m) -> Cmd m ()) -> Cmd m a
f LBState m
LBState (Cmd m)
st (m () -> Cmd m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Cmd m ()) -> (LBState m -> m ()) -> LBState m -> Cmd m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LBState m -> m ()
wr))
        m (StT Cmd a) -> Cmd m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT ((a, [String]) -> m (a, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (a, [String])
x)

-- | Read the module's private state.
readMS :: MonadLBState m => m (LBState m)
readMS :: m (LBState m)
readMS = (LBState m -> (LBState m -> m ()) -> m (LBState m))
-> m (LBState m)
forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS (\LBState m
st LBState m -> m ()
_ -> LBState m -> m (LBState m)
forall (m :: * -> *) a. Monad m => a -> m a
return LBState m
st)

-- | Modify the module's private state.
modifyMS :: MonadLBState m => (LBState m -> LBState m) -> m ()
modifyMS :: (LBState m -> LBState m) -> m ()
modifyMS LBState m -> LBState m
f = (LBState m -> (LBState m -> m ()) -> m ()) -> m ()
forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS ((LBState m -> (LBState m -> m ()) -> m ()) -> m ())
-> (LBState m -> (LBState m -> m ()) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \LBState m
st LBState m -> m ()
wr -> LBState m -> m ()
wr (LBState m -> LBState m
f LBState m
st)

-- | Write the module's private state. Try to use withMS instead.
writeMS :: MonadLBState m => LBState m -> m ()
writeMS :: LBState m -> m ()
writeMS = (LBState m -> LBState m) -> m ()
forall (m :: * -> *).
MonadLBState m =>
(LBState m -> LBState m) -> m ()
modifyMS ((LBState m -> LBState m) -> m ())
-> (LBState m -> LBState m -> LBState m) -> LBState m -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LBState m -> LBState m -> LBState m
forall a b. a -> b -> a
const

-- | This datatype allows modules to conviently maintain both global
--   (i.e. for all clients they're interacting with) and private state.
--   It is implemented on top of readMS\/withMS.
--
-- This simple implementation is linear in the number of private states used.
data GlobalPrivate g p = GP {
  GlobalPrivate g p -> g
global :: !g,
  GlobalPrivate g p -> [(Nick, MVar (Maybe p))]
private :: ![(Nick,MVar (Maybe p))],
  GlobalPrivate g p -> Int
maxSize :: Int
}

-- | Creates a @GlobalPrivate@ given the value of the global state. No private
--   state for clients will be created.
mkGlobalPrivate :: Int -> g -> GlobalPrivate g p
mkGlobalPrivate :: Int -> g -> GlobalPrivate g p
mkGlobalPrivate Int
ms g
g = GP :: forall g p.
g -> [(Nick, MVar (Maybe p))] -> Int -> GlobalPrivate g p
GP {
  global :: g
global = g
g,
  private :: [(Nick, MVar (Maybe p))]
private = [],
  maxSize :: Int
maxSize = Int
ms
}

-- Needs a better interface. The with-functions are hardly useful.
-- | Writes private state. For now, it locks everything.
withPS :: (MonadLBState m, LBState m ~ GlobalPrivate g p)
  => Nick  -- ^ The target
  -> (Maybe p -> (Maybe p -> LB ()) -> LB a)
    -- ^ @Just x@ writes x in the user's private state, @Nothing@ removes it.
  -> m a
withPS :: Nick -> (Maybe p -> (Maybe p -> LB ()) -> LB a) -> m a
withPS Nick
who Maybe p -> (Maybe p -> LB ()) -> LB a
f = do
  MVar (Maybe p)
mvar <- (MVar (Maybe p) -> m (MVar (Maybe p)))
-> (m (MVar (Maybe p)) -> m (MVar (Maybe p)))
-> Nick
-> m (MVar (Maybe p))
forall (m :: * -> *) g p a.
(MonadLBState m, LBState m ~ GlobalPrivate g p) =>
(MVar (Maybe p) -> m a)
-> (m (MVar (Maybe p)) -> m a) -> Nick -> m a
accessPS MVar (Maybe p) -> m (MVar (Maybe p))
forall (m :: * -> *) a. Monad m => a -> m a
return m (MVar (Maybe p)) -> m (MVar (Maybe p))
forall a. a -> a
id Nick
who
  LB a -> m a
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB a -> m a) -> LB a -> m a
forall a b. (a -> b) -> a -> b
$ MVar (Maybe p) -> (Maybe p -> (Maybe p -> LB ()) -> LB a) -> LB a
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
MVar a -> (a -> (a -> m ()) -> m b) -> m b
withMWriter MVar (Maybe p)
mvar Maybe p -> (Maybe p -> LB ()) -> LB a
f

-- | Reads private state.
readPS :: (MonadLBState m, LBState m ~ GlobalPrivate g p)
  => Nick -> m (Maybe p)
readPS :: Nick -> m (Maybe p)
readPS = (MVar (Maybe p) -> m (Maybe p))
-> (m (MVar (Maybe p)) -> m (Maybe p)) -> Nick -> m (Maybe p)
forall (m :: * -> *) g p a.
(MonadLBState m, LBState m ~ GlobalPrivate g p) =>
(MVar (Maybe p) -> m a)
-> (m (MVar (Maybe p)) -> m a) -> Nick -> m a
accessPS (IO (Maybe p) -> m (Maybe p)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe p) -> m (Maybe p))
-> (MVar (Maybe p) -> IO (Maybe p))
-> MVar (Maybe p)
-> m (Maybe p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar (Maybe p) -> IO (Maybe p)
forall (m :: * -> *) a. MonadBase IO m => MVar a -> m a
readMVar) (\m (MVar (Maybe p))
_ -> Maybe p -> m (Maybe p)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe p
forall a. Maybe a
Nothing)

-- | Reads private state, executes one of the actions success and failure
-- which take an MVar and an action producing a @Nothing@ MVar, respectively.
accessPS :: (MonadLBState m, LBState m ~ GlobalPrivate g p)
  => (MVar (Maybe p) -> m a) -> (m (MVar (Maybe p)) -> m a)
  -> Nick
  -> m a
accessPS :: (MVar (Maybe p) -> m a)
-> (m (MVar (Maybe p)) -> m a) -> Nick -> m a
accessPS MVar (Maybe p) -> m a
success m (MVar (Maybe p)) -> m a
failure Nick
who = (LBState m -> (LBState m -> m ()) -> m a) -> m a
forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS ((LBState m -> (LBState m -> m ()) -> m a) -> m a)
-> (LBState m -> (LBState m -> m ()) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \LBState m
state LBState m -> m ()
writer ->
  case Nick -> [(Nick, MVar (Maybe p))] -> Maybe (MVar (Maybe p))
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Nick
who ([(Nick, MVar (Maybe p))] -> Maybe (MVar (Maybe p)))
-> [(Nick, MVar (Maybe p))] -> Maybe (MVar (Maybe p))
forall a b. (a -> b) -> a -> b
$ GlobalPrivate g p -> [(Nick, MVar (Maybe p))]
forall g p. GlobalPrivate g p -> [(Nick, MVar (Maybe p))]
private GlobalPrivate g p
LBState m
state of
    Just MVar (Maybe p)
mvar -> do
      let newPrivate :: [(Nick, MVar (Maybe p))]
newPrivate = (Nick
who,MVar (Maybe p)
mvar)(Nick, MVar (Maybe p))
-> [(Nick, MVar (Maybe p))] -> [(Nick, MVar (Maybe p))]
forall a. a -> [a] -> [a]
:
            ((Nick, MVar (Maybe p)) -> Bool)
-> [(Nick, MVar (Maybe p))] -> [(Nick, MVar (Maybe p))]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Nick -> Nick -> Bool
forall a. Eq a => a -> a -> Bool
/=Nick
who) (Nick -> Bool)
-> ((Nick, MVar (Maybe p)) -> Nick)
-> (Nick, MVar (Maybe p))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Nick, MVar (Maybe p)) -> Nick
forall a b. (a, b) -> a
fst) (GlobalPrivate g p -> [(Nick, MVar (Maybe p))]
forall g p. GlobalPrivate g p -> [(Nick, MVar (Maybe p))]
private GlobalPrivate g p
LBState m
state)
      [(Nick, MVar (Maybe p))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Nick, MVar (Maybe p))]
newPrivate Int -> m () -> m ()
`seq` LBState m -> m ()
writer (GlobalPrivate g p
LBState m
state { private :: [(Nick, MVar (Maybe p))]
private = [(Nick, MVar (Maybe p))]
newPrivate })
      MVar (Maybe p) -> m a
success MVar (Maybe p)
mvar
    Maybe (MVar (Maybe p))
Nothing -> m (MVar (Maybe p)) -> m a
failure (m (MVar (Maybe p)) -> m a) -> m (MVar (Maybe p)) -> m a
forall a b. (a -> b) -> a -> b
$ do
      MVar (Maybe p)
mvar <- IO (MVar (Maybe p)) -> m (MVar (Maybe p))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar (Maybe p)) -> m (MVar (Maybe p)))
-> IO (MVar (Maybe p)) -> m (MVar (Maybe p))
forall a b. (a -> b) -> a -> b
$ Maybe p -> IO (MVar (Maybe p))
forall (m :: * -> *) a. MonadBase IO m => a -> m (MVar a)
newMVar Maybe p
forall a. Maybe a
Nothing
      let newPrivate :: [(Nick, MVar (Maybe p))]
newPrivate = Int -> [(Nick, MVar (Maybe p))] -> [(Nick, MVar (Maybe p))]
forall a. Int -> [a] -> [a]
take (GlobalPrivate g p -> Int
forall g p. GlobalPrivate g p -> Int
maxSize GlobalPrivate g p
LBState m
state) ([(Nick, MVar (Maybe p))] -> [(Nick, MVar (Maybe p))])
-> [(Nick, MVar (Maybe p))] -> [(Nick, MVar (Maybe p))]
forall a b. (a -> b) -> a -> b
$ (Nick
who,MVar (Maybe p)
mvar)(Nick, MVar (Maybe p))
-> [(Nick, MVar (Maybe p))] -> [(Nick, MVar (Maybe p))]
forall a. a -> [a] -> [a]
: GlobalPrivate g p -> [(Nick, MVar (Maybe p))]
forall g p. GlobalPrivate g p -> [(Nick, MVar (Maybe p))]
private GlobalPrivate g p
LBState m
state
      [(Nick, MVar (Maybe p))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Nick, MVar (Maybe p))]
newPrivate Int -> m () -> m ()
`seq` LBState m -> m ()
writer (GlobalPrivate g p
LBState m
state { private :: [(Nick, MVar (Maybe p))]
private = [(Nick, MVar (Maybe p))]
newPrivate })
      MVar (Maybe p) -> m (MVar (Maybe p))
forall (m :: * -> *) a. Monad m => a -> m a
return MVar (Maybe p)
mvar

-- | Writes global state. Locks everything
withGS :: (MonadLBState m, LBState m ~ GlobalPrivate g p)
  => (g -> (g -> m ()) -> m ()) -> m ()
withGS :: (g -> (g -> m ()) -> m ()) -> m ()
withGS g -> (g -> m ()) -> m ()
f = (LBState m -> (LBState m -> m ()) -> m ()) -> m ()
forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS ((LBState m -> (LBState m -> m ()) -> m ()) -> m ())
-> (LBState m -> (LBState m -> m ()) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \LBState m
state LBState m -> m ()
writer ->
  g -> (g -> m ()) -> m ()
f (GlobalPrivate g p -> g
forall g p. GlobalPrivate g p -> g
global GlobalPrivate g p
LBState m
state) ((g -> m ()) -> m ()) -> (g -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \g
g -> LBState m -> m ()
writer (LBState m -> m ()) -> LBState m -> m ()
forall a b. (a -> b) -> a -> b
$ GlobalPrivate g p
LBState m
state { global :: g
global = g
g }

-- | Reads global state.
readGS :: (MonadLBState m, LBState m ~ GlobalPrivate g p)
  => m g
readGS :: m g
readGS = (GlobalPrivate g p -> g) -> m (GlobalPrivate g p) -> m g
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GlobalPrivate g p -> g
forall g p. GlobalPrivate g p -> g
global m (GlobalPrivate g p)
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS


-- The old interface, as we don't wanna be too fancy right now.
writePS :: (MonadLBState m, LBState m ~ GlobalPrivate g p)
  => Nick -> Maybe p -> m ()
writePS :: Nick -> Maybe p -> m ()
writePS Nick
who Maybe p
x = Nick -> (Maybe p -> (Maybe p -> LB ()) -> LB ()) -> m ()
forall (m :: * -> *) g p a.
(MonadLBState m, LBState m ~ GlobalPrivate g p) =>
Nick -> (Maybe p -> (Maybe p -> LB ()) -> LB a) -> m a
withPS Nick
who (\Maybe p
_ Maybe p -> LB ()
writer -> Maybe p -> LB ()
writer Maybe p
x)

writeGS :: (MonadLBState m, LBState m ~ GlobalPrivate g p)
  => g -> m ()
writeGS :: g -> m ()
writeGS g
g = (g -> (g -> m ()) -> m ()) -> m ()
forall (m :: * -> *) g p.
(MonadLBState m, LBState m ~ GlobalPrivate g p) =>
(g -> (g -> m ()) -> m ()) -> m ()
withGS (\g
_ g -> m ()
writer -> g -> m ()
writer g
g)

-- ---------------------------------------------------------------------
--
-- Handling global state
--

-- | Peristence: write the global state out
writeGlobalState :: ModuleT st LB ()
writeGlobalState :: ModuleT st LB ()
writeGlobalState = do
    Module st
m     <- (ModuleInfo st -> Module st) -> ModuleT st LB (Module st)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ModuleInfo st -> Module st
forall st. ModuleInfo st -> Module st
theModule
    String
mName <- (ModuleInfo st -> String) -> ModuleT st LB String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ModuleInfo st -> String
forall st. ModuleInfo st -> String
moduleName
    
    String -> ModuleT st LB ()
forall (m :: * -> *). MonadLogging m => String -> m ()
debugM (String
"saving state for module " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
mName)
    case Module st -> Maybe (Serial st)
forall st. Module st -> Maybe (Serial st)
moduleSerialize Module st
m of
        Maybe (Serial st)
Nothing  -> () -> ModuleT st LB ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just Serial st
ser -> do
            st
state' <- ModuleT st LB st
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
            case Serial st -> st -> Maybe ByteString
forall s. Serial s -> s -> Maybe ByteString
serialize Serial st
ser st
state' of
                Maybe ByteString
Nothing  -> () -> ModuleT st LB ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()   -- do not write any state
                Just ByteString
out -> do
                    String
stateFile <- LB String -> ModuleT st LB String
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (String -> LB String
findLBFileForWriting String
mName)
                    IO () -> ModuleT st LB ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (String -> ByteString -> IO ()
P.writeFile String
stateFile ByteString
out)

-- | Read it in
readGlobalState :: Module st -> String -> LB (Maybe st)
readGlobalState :: Module st -> String -> LB (Maybe st)
readGlobalState Module st
module' String
name = do
    String -> LB ()
forall (m :: * -> *). MonadLogging m => String -> m ()
debugM (String
"loading state for module " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
name)
    case Module st -> Maybe (Serial st)
forall st. Module st -> Maybe (Serial st)
moduleSerialize Module st
module' of
        Just Serial st
ser -> do
            Maybe String
mbStateFile <- String -> LB (Maybe String)
findLBFileForReading String
name
            case Maybe String
mbStateFile of
                Maybe String
Nothing         -> Maybe st -> LB (Maybe st)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe st
forall a. Maybe a
Nothing
                Just String
stateFile  -> IO (Maybe st) -> LB (Maybe st)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Maybe st) -> LB (Maybe st)) -> IO (Maybe st) -> LB (Maybe st)
forall a b. (a -> b) -> a -> b
$ do
                    Maybe ByteString
state' <- ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> IO ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO ByteString
P.readFile String
stateFile IO (Maybe ByteString)
-> (SomeException -> IO (Maybe ByteString))
-> IO (Maybe ByteString)
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
`E.catch` \SomeException{} -> Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
                    IO (Maybe st) -> (SomeException -> IO (Maybe st)) -> IO (Maybe st)
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
E.catch (Maybe st -> IO (Maybe st)
forall (m :: * -> *) a. MonadBase IO m => a -> m a
evaluate (Maybe st -> IO (Maybe st)) -> Maybe st -> IO (Maybe st)
forall a b. (a -> b) -> a -> b
$ Maybe st -> (st -> Maybe st) -> Maybe st -> Maybe st
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe st
forall a. Maybe a
Nothing (st -> Maybe st
forall a. a -> Maybe a
Just (st -> Maybe st) -> st -> Maybe st
forall a b. (a -> b) -> a -> b
$!) (Serial st -> ByteString -> Maybe st
forall s. Serial s -> ByteString -> Maybe s
deserialize Serial st
ser (ByteString -> Maybe st) -> Maybe ByteString -> Maybe st
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe ByteString
state')) -- Monad Maybe)
                        (\SomeException
e -> do
                            String -> IO ()
forall (m :: * -> *). MonadLogging m => String -> m ()
errorM (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Error parsing state file for: "
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show (SomeException
e :: SomeException)
                            String -> IO ()
forall (m :: * -> *). MonadLogging m => String -> m ()
errorM (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Try removing: "String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
stateFile
                            Maybe st -> IO (Maybe st)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe st
forall a. Maybe a
Nothing) -- proceed regardless
        Maybe (Serial st)
Nothing -> Maybe st -> LB (Maybe st)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe st
forall a. Maybe a
Nothing