{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RecordWildCards #-}

{-|
Module      : Mealstrom.MemoryStore
Description : A memory-only storage backend, using STM.
Copyright   : (c) Max Amanshauser, 2016
License     : MIT
Maintainer  : max@lambdalifting.org
-}
module Mealstrom.MemoryStore (
    MemoryStore,
    mkStore,
    _fsmRead,
    _fsmCreate,
    _fsmUpdate,
    printWal
) where

import           Control.Concurrent.STM
import           Control.Exception
import           Data.Text
import           Data.Time
import qualified DeferredFolds.UnfoldlM as UnfoldlM
import           StmContainers.Map as Map

import           Mealstrom.FSM
import           Mealstrom.FSMStore
import           Mealstrom.WALStore

instance (MealyInstance k s e a) => FSMStore (MemoryStore k s e a) k s e a where
    fsmRead :: MemoryStore k s e a -> k -> Proxy k s e a -> IO (Maybe s)
fsmRead MemoryStore k s e a
st k
k Proxy k s e a
_p = do
        Maybe (Instance k s e a)
may <- STM (Maybe (Instance k s e a)) -> IO (Maybe (Instance k s e a))
forall a. STM a -> IO a
atomically (MemoryStore k s e a -> k -> STM (Maybe (Instance k s e a))
forall k s e a.
MemoryStore k s e a -> k -> STM (Maybe (Instance k s e a))
_fsmRead MemoryStore k s e a
st k
k)
        Maybe s -> IO (Maybe s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe s -> IO (Maybe s)) -> Maybe s -> IO (Maybe s)
forall a b. (a -> b) -> a -> b
$ (Instance k s e a -> s) -> Maybe (Instance k s e a) -> Maybe s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Machine s e a -> s
forall s e a. Machine s e a -> s
currState (Machine s e a -> s)
-> (Instance k s e a -> Machine s e a) -> Instance k s e a -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instance k s e a -> Machine s e a
forall k s e a. Instance k s e a -> Machine s e a
machine) Maybe (Instance k s e a)
may
    fsmCreate :: MemoryStore k s e a -> Instance k s e a -> IO (Maybe String)
fsmCreate MemoryStore k s e a
st Instance k s e a
a  = STM (Maybe String) -> IO (Maybe String)
forall a. STM a -> IO a
atomically (STM (Maybe String) -> IO (Maybe String))
-> STM (Maybe String) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ MemoryStore k s e a -> Instance k s e a -> STM (Maybe String)
forall k s e a.
MemoryStore k s e a -> Instance k s e a -> STM (Maybe String)
_fsmCreate MemoryStore k s e a
st Instance k s e a
a
    fsmUpdate :: MemoryStore k s e a
-> k -> MachineTransformer s e a -> IO MealyStatus
fsmUpdate MemoryStore k s e a
st k
k MachineTransformer s e a
t = MemoryStore k s e a
-> k -> MachineTransformer s e a -> IO MealyStatus
forall k s e a.
MemoryStore k s e a
-> k -> MachineTransformer s e a -> IO MealyStatus
_fsmUpdate MemoryStore k s e a
st k
k MachineTransformer s e a
t

instance WALStore (MemoryStore k s e a) k where
    walUpsertIncrement :: MemoryStore k s e a -> k -> IO ()
walUpsertIncrement      =              MemoryStore k s e a -> k -> IO ()
forall k s e a. MemoryStore k s e a -> k -> IO ()
Mealstrom.MemoryStore.walUpsertIncrement
    walDecrement :: MemoryStore k s e a -> k -> IO ()
walDecrement       MemoryStore k s e a
st k
k = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ MemoryStore k s e a -> k -> STM ()
forall k s e a. MemoryStore k s e a -> k -> STM ()
Mealstrom.MemoryStore.walDecrement MemoryStore k s e a
st k
k
    walScan :: MemoryStore k s e a -> Int -> IO [WALEntry k]
walScan                 =              MemoryStore k s e a -> Int -> IO [WALEntry k]
forall k s e a. MemoryStore k s e a -> Int -> IO [WALEntry k]
Mealstrom.MemoryStore.walScan

data MemoryStore k s e a where
    MemoryStore :: (MealyInstance k s e a) => {
        MemoryStore k s e a -> Text
memstoreName    :: Text,
        MemoryStore k s e a -> Map k (Instance k s e a)
memstoreBacking :: Map k (Instance k s e a),
        MemoryStore k s e a -> Map k (TMVar ())
memstoreLocks   :: Map k (TMVar ()),
        MemoryStore k s e a -> Map k (UTCTime, Int)
memstoreWals    :: Map k (UTCTime,Int)
    } -> MemoryStore k s e a

_fsmRead :: MemoryStore k s e a -> k -> STM (Maybe (Instance k s e a))
_fsmRead :: MemoryStore k s e a -> k -> STM (Maybe (Instance k s e a))
_fsmRead MemoryStore{Text
Map k (UTCTime, Int)
Map k (TMVar ())
Map k (Instance k s e a)
memstoreWals :: Map k (UTCTime, Int)
memstoreLocks :: Map k (TMVar ())
memstoreBacking :: Map k (Instance k s e a)
memstoreName :: Text
memstoreWals :: forall k s e a. MemoryStore k s e a -> Map k (UTCTime, Int)
memstoreLocks :: forall k s e a. MemoryStore k s e a -> Map k (TMVar ())
memstoreBacking :: forall k s e a. MemoryStore k s e a -> Map k (Instance k s e a)
memstoreName :: forall k s e a. MemoryStore k s e a -> Text
..} k
k = k -> Map k (Instance k s e a) -> STM (Maybe (Instance k s e a))
forall key value.
(Eq key, Hashable key) =>
key -> Map key value -> STM (Maybe value)
Map.lookup k
k Map k (Instance k s e a)
memstoreBacking STM (Maybe (Instance k s e a))
-> (Maybe (Instance k s e a) -> STM (Maybe (Instance k s e a)))
-> STM (Maybe (Instance k s e a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Instance k s e a
a -> Maybe (Instance k s e a) -> STM (Maybe (Instance k s e a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Instance k s e a) -> STM (Maybe (Instance k s e a)))
-> Maybe (Instance k s e a) -> STM (Maybe (Instance k s e a))
forall a b. (a -> b) -> a -> b
$ Instance k s e a -> Maybe (Instance k s e a)
forall a. a -> Maybe a
Just Instance k s e a
a
    Maybe (Instance k s e a)
_      -> Maybe (Instance k s e a) -> STM (Maybe (Instance k s e a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Instance k s e a)
forall a. Maybe a
Nothing

-- |For compatibility with the other stores we check existence here
_fsmCreate :: MemoryStore k s e a -> Instance k s e a -> STM (Maybe String)
_fsmCreate :: MemoryStore k s e a -> Instance k s e a -> STM (Maybe String)
_fsmCreate MemoryStore{Text
Map k (UTCTime, Int)
Map k (TMVar ())
Map k (Instance k s e a)
memstoreWals :: Map k (UTCTime, Int)
memstoreLocks :: Map k (TMVar ())
memstoreBacking :: Map k (Instance k s e a)
memstoreName :: Text
memstoreWals :: forall k s e a. MemoryStore k s e a -> Map k (UTCTime, Int)
memstoreLocks :: forall k s e a. MemoryStore k s e a -> Map k (TMVar ())
memstoreBacking :: forall k s e a. MemoryStore k s e a -> Map k (Instance k s e a)
memstoreName :: forall k s e a. MemoryStore k s e a -> Text
..} Instance k s e a
ins = do
    Maybe (Instance k s e a)
exists <- k -> Map k (Instance k s e a) -> STM (Maybe (Instance k s e a))
forall key value.
(Eq key, Hashable key) =>
key -> Map key value -> STM (Maybe value)
Map.lookup (Instance k s e a -> k
forall k s e a. Instance k s e a -> k
key Instance k s e a
ins) Map k (Instance k s e a)
memstoreBacking
    STM (Maybe String)
-> (Instance k s e a -> STM (Maybe String))
-> Maybe (Instance k s e a)
-> STM (Maybe String)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (do
            TMVar ()
t <- () -> STM (TMVar ())
forall a. a -> STM (TMVar a)
newTMVar ()
            TMVar () -> k -> Map k (TMVar ()) -> STM ()
forall key value.
(Eq key, Hashable key) =>
value -> key -> Map key value -> STM ()
Map.insert TMVar ()
t   (Instance k s e a -> k
forall k s e a. Instance k s e a -> k
key Instance k s e a
ins) Map k (TMVar ())
memstoreLocks
            Instance k s e a -> k -> Map k (Instance k s e a) -> STM ()
forall key value.
(Eq key, Hashable key) =>
value -> key -> Map key value -> STM ()
Map.insert Instance k s e a
ins (Instance k s e a -> k
forall k s e a. Instance k s e a -> k
key Instance k s e a
ins) Map k (Instance k s e a)
memstoreBacking
            Maybe String -> STM (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
          )
          (\Instance k s e a
_ -> Maybe String -> STM (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> STM (Maybe String))
-> Maybe String -> STM (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
"MemoryStore: Duplicate key")
          Maybe (Instance k s e a)
exists

-- |We need to use a lock here, because we are in the unfortunate position of
-- having to use IO while performing STM operations, which is not possible.
-- Using the lock we can rest assured no concurrent update operation can progress.
_fsmUpdate :: MemoryStore k s e a -> k -> MachineTransformer s e a -> IO MealyStatus
_fsmUpdate :: MemoryStore k s e a
-> k -> MachineTransformer s e a -> IO MealyStatus
_fsmUpdate MemoryStore{Text
Map k (UTCTime, Int)
Map k (TMVar ())
Map k (Instance k s e a)
memstoreWals :: Map k (UTCTime, Int)
memstoreLocks :: Map k (TMVar ())
memstoreBacking :: Map k (Instance k s e a)
memstoreName :: Text
memstoreWals :: forall k s e a. MemoryStore k s e a -> Map k (UTCTime, Int)
memstoreLocks :: forall k s e a. MemoryStore k s e a -> Map k (TMVar ())
memstoreBacking :: forall k s e a. MemoryStore k s e a -> Map k (Instance k s e a)
memstoreName :: forall k s e a. MemoryStore k s e a -> Text
..} k
k MachineTransformer s e a
t =
    let
        m :: Map k (Instance k s e a)
m  = Map k (Instance k s e a)
memstoreBacking
        ls :: Map k (TMVar ())
ls = Map k (TMVar ())
memstoreLocks
    in
        STM (Maybe (TMVar ())) -> IO (Maybe (TMVar ()))
forall a. STM a -> IO a
atomically (k -> Map k (TMVar ()) -> STM (Maybe (TMVar ()))
forall key value.
(Eq key, Hashable key) =>
key -> Map key value -> STM (Maybe value)
Map.lookup k
k Map k (TMVar ())
ls) IO (Maybe (TMVar ()))
-> (Maybe (TMVar ()) -> IO MealyStatus) -> IO MealyStatus
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe (TMVar ())
lock ->
            IO MealyStatus
-> (TMVar () -> IO MealyStatus)
-> Maybe (TMVar ())
-> IO MealyStatus
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MealyStatus -> IO MealyStatus
forall (m :: * -> *) a. Monad m => a -> m a
return MealyStatus
MealyError)
                  (\TMVar ()
l ->
                      IO () -> IO () -> IO MealyStatus -> IO MealyStatus
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar () -> STM ()
forall a. TMVar a -> STM a
takeTMVar TMVar ()
l)
                               (STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar () -> () -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar ()
l ())
                               (STM (Maybe (Instance k s e a)) -> IO (Maybe (Instance k s e a))
forall a. STM a -> IO a
atomically (k -> Map k (Instance k s e a) -> STM (Maybe (Instance k s e a))
forall key value.
(Eq key, Hashable key) =>
key -> Map key value -> STM (Maybe value)
Map.lookup k
k Map k (Instance k s e a)
m) IO (Maybe (Instance k s e a))
-> (Maybe (Instance k s e a) -> IO MealyStatus) -> IO MealyStatus
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe (Instance k s e a)
res ->
                                   IO MealyStatus
-> (Instance k s e a -> IO MealyStatus)
-> Maybe (Instance k s e a)
-> IO MealyStatus
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MealyStatus -> IO MealyStatus
forall (m :: * -> *) a. Monad m => a -> m a
return MealyStatus
MealyError)
                                         (\Instance k s e a
inst ->
                                             (do
                                                 Machine s e a
newMach <- MachineTransformer s e a
t (Instance k s e a -> Machine s e a
forall k s e a. Instance k s e a -> Machine s e a
machine Instance k s e a
inst)
                                                 let r :: MealyStatus
r = if [Msg a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null (Machine s e a -> [Msg a]
forall s e a. Machine s e a -> [Msg a]
outbox Machine s e a
newMach) then MealyStatus
Done else MealyStatus
Pending
                                                 STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ Instance k s e a -> k -> Map k (Instance k s e a) -> STM ()
forall key value.
(Eq key, Hashable key) =>
value -> key -> Map key value -> STM ()
Map.insert Instance k s e a
inst{machine :: Machine s e a
machine=Machine s e a
newMach} k
k Map k (Instance k s e a)
m
                                                 MealyStatus -> IO MealyStatus
forall (m :: * -> *) a. Monad m => a -> m a
return MealyStatus
r
                                             )
                                         ) Maybe (Instance k s e a)
res)
                  )
                  Maybe (TMVar ())
lock

walUpsertIncrement :: MemoryStore k s e a -> k -> IO ()
walUpsertIncrement :: MemoryStore k s e a -> k -> IO ()
walUpsertIncrement MemoryStore{Text
Map k (UTCTime, Int)
Map k (TMVar ())
Map k (Instance k s e a)
memstoreWals :: Map k (UTCTime, Int)
memstoreLocks :: Map k (TMVar ())
memstoreBacking :: Map k (Instance k s e a)
memstoreName :: Text
memstoreWals :: forall k s e a. MemoryStore k s e a -> Map k (UTCTime, Int)
memstoreLocks :: forall k s e a. MemoryStore k s e a -> Map k (TMVar ())
memstoreBacking :: forall k s e a. MemoryStore k s e a -> Map k (Instance k s e a)
memstoreName :: forall k s e a. MemoryStore k s e a -> Text
..} k
k =
    IO UTCTime
getCurrentTime IO UTCTime -> (UTCTime -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \UTCTime
t -> STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$
        k -> Map k (UTCTime, Int) -> STM (Maybe (UTCTime, Int))
forall key value.
(Eq key, Hashable key) =>
key -> Map key value -> STM (Maybe value)
Map.lookup k
k Map k (UTCTime, Int)
memstoreWals STM (Maybe (UTCTime, Int))
-> (Maybe (UTCTime, Int) -> STM ()) -> STM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe (UTCTime, Int)
res ->
            STM ()
-> ((UTCTime, Int) -> STM ()) -> Maybe (UTCTime, Int) -> STM ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((UTCTime, Int) -> k -> Map k (UTCTime, Int) -> STM ()
forall key value.
(Eq key, Hashable key) =>
value -> key -> Map key value -> STM ()
Map.insert (UTCTime
t,Int
1) k
k Map k (UTCTime, Int)
memstoreWals)
                  (\(UTCTime
_oldt,Int
w) -> (UTCTime, Int) -> k -> Map k (UTCTime, Int) -> STM ()
forall key value.
(Eq key, Hashable key) =>
value -> key -> Map key value -> STM ()
Map.insert (UTCTime
t,Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) k
k Map k (UTCTime, Int)
memstoreWals)
                  Maybe (UTCTime, Int)
res

walDecrement :: MemoryStore k s e a -> k -> STM ()
walDecrement :: MemoryStore k s e a -> k -> STM ()
walDecrement MemoryStore{Text
Map k (UTCTime, Int)
Map k (TMVar ())
Map k (Instance k s e a)
memstoreWals :: Map k (UTCTime, Int)
memstoreLocks :: Map k (TMVar ())
memstoreBacking :: Map k (Instance k s e a)
memstoreName :: Text
memstoreWals :: forall k s e a. MemoryStore k s e a -> Map k (UTCTime, Int)
memstoreLocks :: forall k s e a. MemoryStore k s e a -> Map k (TMVar ())
memstoreBacking :: forall k s e a. MemoryStore k s e a -> Map k (Instance k s e a)
memstoreName :: forall k s e a. MemoryStore k s e a -> Text
..} k
k =
    k -> Map k (UTCTime, Int) -> STM (Maybe (UTCTime, Int))
forall key value.
(Eq key, Hashable key) =>
key -> Map key value -> STM (Maybe value)
Map.lookup k
k Map k (UTCTime, Int)
memstoreWals STM (Maybe (UTCTime, Int))
-> (Maybe (UTCTime, Int) -> STM ()) -> STM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe (UTCTime, Int)
res ->
        STM ()
-> ((UTCTime, Int) -> STM ()) -> Maybe (UTCTime, Int) -> STM ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> STM ()
forall a. HasCallStack => String -> a
error String
"trying to recover non-existing entry")
              (\(UTCTime
t,Int
w) -> (UTCTime, Int) -> k -> Map k (UTCTime, Int) -> STM ()
forall key value.
(Eq key, Hashable key) =>
value -> key -> Map key value -> STM ()
Map.insert (UTCTime
t,Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) k
k Map k (UTCTime, Int)
memstoreWals)
              Maybe (UTCTime, Int)
res

walScan :: MemoryStore k s e a -> Int -> IO [WALEntry k]
walScan :: MemoryStore k s e a -> Int -> IO [WALEntry k]
walScan MemoryStore{Text
Map k (UTCTime, Int)
Map k (TMVar ())
Map k (Instance k s e a)
memstoreWals :: Map k (UTCTime, Int)
memstoreLocks :: Map k (TMVar ())
memstoreBacking :: Map k (Instance k s e a)
memstoreName :: Text
memstoreWals :: forall k s e a. MemoryStore k s e a -> Map k (UTCTime, Int)
memstoreLocks :: forall k s e a. MemoryStore k s e a -> Map k (TMVar ())
memstoreBacking :: forall k s e a. MemoryStore k s e a -> Map k (Instance k s e a)
memstoreName :: forall k s e a. MemoryStore k s e a -> Text
..} Int
cutoff =
    IO UTCTime
getCurrentTime IO UTCTime -> (UTCTime -> IO [WALEntry k]) -> IO [WALEntry k]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \UTCTime
t -> STM [WALEntry k] -> IO [WALEntry k]
forall a. STM a -> IO a
atomically (STM [WALEntry k] -> IO [WALEntry k])
-> STM [WALEntry k] -> IO [WALEntry k]
forall a b. (a -> b) -> a -> b
$
        let xx :: UTCTime
xx = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a
negate (Integer -> NominalDiffTime
forall a. Num a => Integer -> a
fromInteger (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
cutoff) :: NominalDiffTime)) UTCTime
t in

        ([WALEntry k] -> (k, (UTCTime, Int)) -> STM [WALEntry k])
-> [WALEntry k]
-> UnfoldlM STM (k, (UTCTime, Int))
-> STM [WALEntry k]
forall (m :: * -> *) output input.
Monad m =>
(output -> input -> m output)
-> output -> UnfoldlM m input -> m output
UnfoldlM.foldlM' (\[WALEntry k]
acc (k
k,(UTCTime
t,Int
w)) -> if UTCTime
t UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
xx
                                    then [WALEntry k] -> STM [WALEntry k]
forall (m :: * -> *) a. Monad m => a -> m a
return (k -> UTCTime -> Int -> WALEntry k
forall k. k -> UTCTime -> Int -> WALEntry k
WALEntry k
k UTCTime
t Int
w WALEntry k -> [WALEntry k] -> [WALEntry k]
forall a. a -> [a] -> [a]
: [WALEntry k]
acc)
                                    else [WALEntry k] -> STM [WALEntry k]
forall (m :: * -> *) a. Monad m => a -> m a
return [WALEntry k]
acc) [] (Map k (UTCTime, Int) -> UnfoldlM STM (k, (UTCTime, Int))
forall key value. Map key value -> UnfoldlM STM (key, value)
Map.unfoldlM Map k (UTCTime, Int)
memstoreWals)


printWal :: MemoryStore k s e a -> k -> IO ()
printWal :: MemoryStore k s e a -> k -> IO ()
printWal MemoryStore{Text
Map k (UTCTime, Int)
Map k (TMVar ())
Map k (Instance k s e a)
memstoreWals :: Map k (UTCTime, Int)
memstoreLocks :: Map k (TMVar ())
memstoreBacking :: Map k (Instance k s e a)
memstoreName :: Text
memstoreWals :: forall k s e a. MemoryStore k s e a -> Map k (UTCTime, Int)
memstoreLocks :: forall k s e a. MemoryStore k s e a -> Map k (TMVar ())
memstoreBacking :: forall k s e a. MemoryStore k s e a -> Map k (Instance k s e a)
memstoreName :: forall k s e a. MemoryStore k s e a -> Text
..} k
k =
    STM (Maybe (UTCTime, Int)) -> IO (Maybe (UTCTime, Int))
forall a. STM a -> IO a
atomically (k -> Map k (UTCTime, Int) -> STM (Maybe (UTCTime, Int))
forall key value.
(Eq key, Hashable key) =>
key -> Map key value -> STM (Maybe value)
Map.lookup k
k Map k (UTCTime, Int)
memstoreWals) IO (Maybe (UTCTime, Int))
-> (Maybe (UTCTime, Int) -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe (UTCTime, Int)
res ->
        IO () -> ((UTCTime, Int) -> IO ()) -> Maybe (UTCTime, Int) -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO ()
putStrLn String
"NO WAL")
              (UTCTime, Int) -> IO ()
forall a. Show a => a -> IO ()
print
              Maybe (UTCTime, Int)
res


mkStore :: (MealyInstance k s e a) => Text -> IO (MemoryStore k s e a)
mkStore :: Text -> IO (MemoryStore k s e a)
mkStore Text
name = STM (MemoryStore k s e a) -> IO (MemoryStore k s e a)
forall a. STM a -> IO a
atomically (STM (MemoryStore k s e a) -> IO (MemoryStore k s e a))
-> STM (MemoryStore k s e a) -> IO (MemoryStore k s e a)
forall a b. (a -> b) -> a -> b
$ do
    Map k (Instance k s e a)
back  <- forall key value. STM (Map key value)
forall k s e a. STM (Map k (Instance k s e a))
new :: STM (Map k (Instance k s e a))
    Map k (TMVar ())
locks <- forall k. STM (Map k (TMVar ()))
forall key value. STM (Map key value)
new :: STM (Map k (TMVar ()))
    Map k (UTCTime, Int)
wals  <- forall k. STM (Map k (UTCTime, Int))
forall key value. STM (Map key value)
new :: STM (Map k (UTCTime,Int))
    MemoryStore k s e a -> STM (MemoryStore k s e a)
forall (m :: * -> *) a. Monad m => a -> m a
return (MemoryStore k s e a -> STM (MemoryStore k s e a))
-> MemoryStore k s e a -> STM (MemoryStore k s e a)
forall a b. (a -> b) -> a -> b
$ Text
-> Map k (Instance k s e a)
-> Map k (TMVar ())
-> Map k (UTCTime, Int)
-> MemoryStore k s e a
forall k s e a.
MealyInstance k s e a =>
Text
-> Map k (Instance k s e a)
-> Map k (TMVar ())
-> Map k (UTCTime, Int)
-> MemoryStore k s e a
MemoryStore Text
name Map k (Instance k s e a)
back Map k (TMVar ())
locks Map k (UTCTime, Int)
wals