{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Examples.Account.SimpleDomain where

import Control.Applicative
import Control.Monad.Except
import Control.Monad.Extra
import Control.Monad.State
import Data.Bifunctor (second)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Set qualified as Set
import Examples.Account.AbstractDomain

-- | Errors raised by the domain
data AccountsError
  = NoSuchAccount String
  | AlreadyExistingAccount String
  | NoSuchPolicy String
  | AlreadyExistingPolicy String
  | PolicyError
  deriving (Int -> AccountsError -> ShowS
[AccountsError] -> ShowS
AccountsError -> String
(Int -> AccountsError -> ShowS)
-> (AccountsError -> String)
-> ([AccountsError] -> ShowS)
-> Show AccountsError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccountsError -> ShowS
showsPrec :: Int -> AccountsError -> ShowS
$cshow :: AccountsError -> String
show :: AccountsError -> String
$cshowList :: [AccountsError] -> ShowS
showList :: [AccountsError] -> ShowS
Show)

-- | Our domain implementation
type AccountsT m = ExceptT AccountsError (StateT Register m)

instance {-# OVERLAPPING #-} (MonadPlus m) => Alternative (AccountsT m) where
  empty :: forall a. AccountsT m a
empty = StateT Register m a -> ExceptT AccountsError (StateT Register m) a
forall (m :: * -> *) a. Monad m => m a -> ExceptT AccountsError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT Register m a
forall a. StateT Register m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  ExceptT (StateT Register -> m (Either AccountsError a, Register)
f) <|> :: forall a. AccountsT m a -> AccountsT m a -> AccountsT m a
<|> ExceptT (StateT Register -> m (Either AccountsError a, Register)
g) =
    StateT Register m (Either AccountsError a)
-> ExceptT AccountsError (StateT Register m) a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (StateT Register m (Either AccountsError a)
 -> ExceptT AccountsError (StateT Register m) a)
-> ((Register -> m (Either AccountsError a, Register))
    -> StateT Register m (Either AccountsError a))
-> (Register -> m (Either AccountsError a, Register))
-> ExceptT AccountsError (StateT Register m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Register -> m (Either AccountsError a, Register))
-> StateT Register m (Either AccountsError a)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((Register -> m (Either AccountsError a, Register))
 -> ExceptT AccountsError (StateT Register m) a)
-> (Register -> m (Either AccountsError a, Register))
-> ExceptT AccountsError (StateT Register m) a
forall a b. (a -> b) -> a -> b
$ \Register
s -> Register -> m (Either AccountsError a, Register)
f Register
s m (Either AccountsError a, Register)
-> m (Either AccountsError a, Register)
-> m (Either AccountsError a, Register)
forall a. m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Register -> m (Either AccountsError a, Register)
g Register
s

instance {-# OVERLAPPING #-} (MonadPlus m) => MonadPlus (AccountsT m)

-- * Some helper functions over AccountsT m

-- | Ensures a user is registered and returns the associated account
ensureExistingUser :: (Monad m) => String -> AccountsT m Account
ensureExistingUser :: forall (m :: * -> *). Monad m => String -> AccountsT m Account
ensureExistingUser String
name =
  ExceptT AccountsError (StateT Register m) Account
-> (Account -> ExceptT AccountsError (StateT Register m) Account)
-> ExceptT AccountsError (StateT Register m) (Maybe Account)
-> ExceptT AccountsError (StateT Register m) Account
forall (m :: * -> *) b a.
Monad m =>
m b -> (a -> m b) -> m (Maybe a) -> m b
maybeM (AccountsError -> ExceptT AccountsError (StateT Register m) Account
forall a.
AccountsError -> ExceptT AccountsError (StateT Register m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AccountsError
 -> ExceptT AccountsError (StateT Register m) Account)
-> AccountsError
-> ExceptT AccountsError (StateT Register m) Account
forall a b. (a -> b) -> a -> b
$ String -> AccountsError
NoSuchAccount String
name) Account -> ExceptT AccountsError (StateT Register m) Account
forall a. a -> ExceptT AccountsError (StateT Register m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExceptT AccountsError (StateT Register m) (Maybe Account)
 -> ExceptT AccountsError (StateT Register m) Account)
-> ExceptT AccountsError (StateT Register m) (Maybe Account)
-> ExceptT AccountsError (StateT Register m) Account
forall a b. (a -> b) -> a -> b
$ (Register -> Maybe Account)
-> ExceptT AccountsError (StateT Register m) (Maybe Account)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Register -> Maybe Account)
 -> ExceptT AccountsError (StateT Register m) (Maybe Account))
-> (Register -> Maybe Account)
-> ExceptT AccountsError (StateT Register m) (Maybe Account)
forall a b. (a -> b) -> a -> b
$ String -> Map String Account -> Maybe Account
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name (Map String Account -> Maybe Account)
-> (Register -> Map String Account) -> Register -> Maybe Account
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Register -> Map String Account
accounts

-- | Ensures a user is not registered
ensureNonExistingUser :: (Monad m) => String -> AccountsT m ()
ensureNonExistingUser :: forall (m :: * -> *). Monad m => String -> AccountsT m ()
ensureNonExistingUser String
name =
  ExceptT AccountsError (StateT Register m) Bool
-> ExceptT AccountsError (StateT Register m) ()
-> ExceptT AccountsError (StateT Register m) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((Register -> Bool)
-> ExceptT AccountsError (StateT Register m) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Register -> Bool)
 -> ExceptT AccountsError (StateT Register m) Bool)
-> (Register -> Bool)
-> ExceptT AccountsError (StateT Register m) Bool
forall a b. (a -> b) -> a -> b
$ (String
name String -> Map String Account -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member`) (Map String Account -> Bool)
-> (Register -> Map String Account) -> Register -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Register -> Map String Account
accounts) (ExceptT AccountsError (StateT Register m) ()
 -> ExceptT AccountsError (StateT Register m) ())
-> ExceptT AccountsError (StateT Register m) ()
-> ExceptT AccountsError (StateT Register m) ()
forall a b. (a -> b) -> a -> b
$ AccountsError -> ExceptT AccountsError (StateT Register m) ()
forall a.
AccountsError -> ExceptT AccountsError (StateT Register m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AccountsError -> ExceptT AccountsError (StateT Register m) ())
-> AccountsError -> ExceptT AccountsError (StateT Register m) ()
forall a b. (a -> b) -> a -> b
$ String -> AccountsError
AlreadyExistingAccount String
name

-- | Modifies the current map of accounts
modifyAccounts :: (Monad m) => (Map String Account -> Map String Account) -> AccountsT m ()
modifyAccounts :: forall (m :: * -> *).
Monad m =>
(Map String Account -> Map String Account) -> AccountsT m ()
modifyAccounts Map String Account -> Map String Account
f = (Register -> Register)
-> ExceptT AccountsError (StateT Register m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Register -> Register)
 -> ExceptT AccountsError (StateT Register m) ())
-> (Register -> Register)
-> ExceptT AccountsError (StateT Register m) ()
forall a b. (a -> b) -> a -> b
$ \(Register Map String Policy
pols Map String Account
accs) -> Map String Policy -> Map String Account -> Register
Register Map String Policy
pols (Map String Account -> Register) -> Map String Account -> Register
forall a b. (a -> b) -> a -> b
$ Map String Account -> Map String Account
f Map String Account
accs

-- | Ensures a policy is registered and executes an action based on its value
ensureExistingPolicy :: (Monad m) => String -> AccountsT m Policy
ensureExistingPolicy :: forall (m :: * -> *). Monad m => String -> AccountsT m Policy
ensureExistingPolicy String
name =
  ExceptT AccountsError (StateT Register m) Policy
-> (Policy -> ExceptT AccountsError (StateT Register m) Policy)
-> ExceptT AccountsError (StateT Register m) (Maybe Policy)
-> ExceptT AccountsError (StateT Register m) Policy
forall (m :: * -> *) b a.
Monad m =>
m b -> (a -> m b) -> m (Maybe a) -> m b
maybeM (AccountsError -> ExceptT AccountsError (StateT Register m) Policy
forall a.
AccountsError -> ExceptT AccountsError (StateT Register m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AccountsError -> ExceptT AccountsError (StateT Register m) Policy)
-> AccountsError
-> ExceptT AccountsError (StateT Register m) Policy
forall a b. (a -> b) -> a -> b
$ String -> AccountsError
NoSuchPolicy String
name) Policy -> ExceptT AccountsError (StateT Register m) Policy
forall a. a -> ExceptT AccountsError (StateT Register m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExceptT AccountsError (StateT Register m) (Maybe Policy)
 -> ExceptT AccountsError (StateT Register m) Policy)
-> ExceptT AccountsError (StateT Register m) (Maybe Policy)
-> ExceptT AccountsError (StateT Register m) Policy
forall a b. (a -> b) -> a -> b
$ (Register -> Maybe Policy)
-> ExceptT AccountsError (StateT Register m) (Maybe Policy)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Register -> Maybe Policy)
 -> ExceptT AccountsError (StateT Register m) (Maybe Policy))
-> (Register -> Maybe Policy)
-> ExceptT AccountsError (StateT Register m) (Maybe Policy)
forall a b. (a -> b) -> a -> b
$ String -> Map String Policy -> Maybe Policy
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name (Map String Policy -> Maybe Policy)
-> (Register -> Map String Policy) -> Register -> Maybe Policy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Register -> Map String Policy
policies

-- | Ensures a policy is not present and executes an action
ensureNonExistingPolicy :: (Monad m) => String -> AccountsT m ()
ensureNonExistingPolicy :: forall (m :: * -> *). Monad m => String -> AccountsT m ()
ensureNonExistingPolicy String
name =
  ExceptT AccountsError (StateT Register m) Bool
-> ExceptT AccountsError (StateT Register m) ()
-> ExceptT AccountsError (StateT Register m) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((Register -> Bool)
-> ExceptT AccountsError (StateT Register m) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Register -> Bool)
 -> ExceptT AccountsError (StateT Register m) Bool)
-> (Register -> Bool)
-> ExceptT AccountsError (StateT Register m) Bool
forall a b. (a -> b) -> a -> b
$ (String
name String -> Map String Policy -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member`) (Map String Policy -> Bool)
-> (Register -> Map String Policy) -> Register -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Register -> Map String Policy
policies) (ExceptT AccountsError (StateT Register m) ()
 -> ExceptT AccountsError (StateT Register m) ())
-> ExceptT AccountsError (StateT Register m) ()
-> ExceptT AccountsError (StateT Register m) ()
forall a b. (a -> b) -> a -> b
$ AccountsError -> ExceptT AccountsError (StateT Register m) ()
forall a.
AccountsError -> ExceptT AccountsError (StateT Register m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AccountsError -> ExceptT AccountsError (StateT Register m) ())
-> AccountsError -> ExceptT AccountsError (StateT Register m) ()
forall a b. (a -> b) -> a -> b
$ String -> AccountsError
AlreadyExistingPolicy String
name

-- | Modifies the current map of policies
modifyPolicies :: (Monad m) => (Map String Policy -> Map String Policy) -> AccountsT m ()
modifyPolicies :: forall (m :: * -> *).
Monad m =>
(Map String Policy -> Map String Policy) -> AccountsT m ()
modifyPolicies Map String Policy -> Map String Policy
f = (Register -> Register)
-> ExceptT AccountsError (StateT Register m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Register -> Register)
 -> ExceptT AccountsError (StateT Register m) ())
-> (Register -> Register)
-> ExceptT AccountsError (StateT Register m) ()
forall a b. (a -> b) -> a -> b
$ \(Register Map String Policy
pols Map String Account
accs) -> (Map String Policy -> Map String Account -> Register)
-> Map String Account -> Map String Policy -> Register
forall a b c. (a -> b -> c) -> b -> a -> c
flip Map String Policy -> Map String Account -> Register
Register Map String Account
accs (Map String Policy -> Register) -> Map String Policy -> Register
forall a b. (a -> b) -> a -> b
$ Map String Policy -> Map String Policy
f Map String Policy
pols

-- | A function to run the domain and return relevant information
runAccountsT :: (Monad m) => Register -> AccountsT m a -> m (Either AccountsError a, Map String Account)
runAccountsT :: forall (m :: * -> *) a.
Monad m =>
Register
-> AccountsT m a -> m (Either AccountsError a, Map String Account)
runAccountsT Register
register AccountsT m a
comp = (Register -> Map String Account)
-> (Either AccountsError a, Register)
-> (Either AccountsError a, Map String Account)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Register -> Map String Account
accounts ((Either AccountsError a, Register)
 -> (Either AccountsError a, Map String Account))
-> m (Either AccountsError a, Register)
-> m (Either AccountsError a, Map String Account)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Register m (Either AccountsError a)
-> Register -> m (Either AccountsError a, Register)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (AccountsT m a -> StateT Register m (Either AccountsError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT AccountsT m a
comp) Register
register

instance (Monad m) => MonadAccounts (AccountsT m) where
  addUser :: String -> Integer -> AccountsT m ()
addUser String
name Integer
balance = do
    String -> AccountsT m ()
forall (m :: * -> *). Monad m => String -> AccountsT m ()
ensureNonExistingUser String
name
    (Map String Account -> Map String Account) -> AccountsT m ()
forall (m :: * -> *).
Monad m =>
(Map String Account -> Map String Account) -> AccountsT m ()
modifyAccounts ((Map String Account -> Map String Account) -> AccountsT m ())
-> (Map String Account -> Map String Account) -> AccountsT m ()
forall a b. (a -> b) -> a -> b
$ String -> Account -> Map String Account -> Map String Account
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
name (Integer
balance, Set String
forall a. Set a
Set.empty)

  addPolicy :: String -> Policy -> AccountsT m ()
addPolicy String
name Policy
val = do
    String -> AccountsT m ()
forall (m :: * -> *). Monad m => String -> AccountsT m ()
ensureNonExistingPolicy String
name
    (Map String Policy -> Map String Policy) -> AccountsT m ()
forall (m :: * -> *).
Monad m =>
(Map String Policy -> Map String Policy) -> AccountsT m ()
modifyPolicies ((Map String Policy -> Map String Policy) -> AccountsT m ())
-> (Map String Policy -> Map String Policy) -> AccountsT m ()
forall a b. (a -> b) -> a -> b
$ String -> Policy -> Map String Policy -> Map String Policy
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
name Policy
val

  subscribeToPolicy :: String -> String -> AccountsT m ()
subscribeToPolicy String
userName String
polName = do
    (Integer
bal, Set String
accPols) <- String -> AccountsT m Account
forall (m :: * -> *). Monad m => String -> AccountsT m Account
ensureExistingUser String
userName
    ExceptT AccountsError (StateT Register m) Policy -> AccountsT m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT AccountsError (StateT Register m) Policy
 -> AccountsT m ())
-> ExceptT AccountsError (StateT Register m) Policy
-> AccountsT m ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT AccountsError (StateT Register m) Policy
forall (m :: * -> *). Monad m => String -> AccountsT m Policy
ensureExistingPolicy String
polName
    (Map String Account -> Map String Account) -> AccountsT m ()
forall (m :: * -> *).
Monad m =>
(Map String Account -> Map String Account) -> AccountsT m ()
modifyAccounts ((Map String Account -> Map String Account) -> AccountsT m ())
-> (Map String Account -> Map String Account) -> AccountsT m ()
forall a b. (a -> b) -> a -> b
$ String -> Account -> Map String Account -> Map String Account
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
userName (Integer
bal, String -> Set String -> Set String
forall a. Ord a => a -> Set a -> Set a
Set.insert String
polName Set String
accPols)

  unsubscribeToPolicy :: String -> String -> AccountsT m ()
unsubscribeToPolicy String
userName String
polName = do
    (Integer
bal, Set String
accPols) <- String -> AccountsT m Account
forall (m :: * -> *). Monad m => String -> AccountsT m Account
ensureExistingUser String
userName
    (Map String Account -> Map String Account) -> AccountsT m ()
forall (m :: * -> *).
Monad m =>
(Map String Account -> Map String Account) -> AccountsT m ()
modifyAccounts ((Map String Account -> Map String Account) -> AccountsT m ())
-> (Map String Account -> Map String Account) -> AccountsT m ()
forall a b. (a -> b) -> a -> b
$ String -> Account -> Map String Account -> Map String Account
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
userName (Integer
bal, String -> Set String -> Set String
forall a. Ord a => a -> Set a -> Set a
Set.delete String
polName Set String
accPols)

  allPolicies :: AccountsT m [String]
allPolicies = (Register -> [String]) -> AccountsT m [String]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Register -> [String]) -> AccountsT m [String])
-> (Register -> [String]) -> AccountsT m [String]
forall a b. (a -> b) -> a -> b
$ Map String Policy -> [String]
forall k a. Map k a -> [k]
Map.keys (Map String Policy -> [String])
-> (Register -> Map String Policy) -> Register -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Register -> Map String Policy
policies

  getUserBalance :: String -> AccountsT m Integer
getUserBalance = (Account -> Integer
forall a b. (a, b) -> a
fst (Account -> Integer) -> AccountsT m Account -> AccountsT m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (AccountsT m Account -> AccountsT m Integer)
-> (String -> AccountsT m Account) -> String -> AccountsT m Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> AccountsT m Account
forall (m :: * -> *). Monad m => String -> AccountsT m Account
ensureExistingUser

  simulate :: forall a. AccountsT m a -> AccountsT m (Maybe a)
simulate AccountsT m a
comp = do
    Register
current <- ExceptT AccountsError (StateT Register m) Register
forall s (m :: * -> *). MonadState s m => m s
get
    (Either AccountsError a, Map String Account)
x <- StateT Register m (Either AccountsError a, Map String Account)
-> ExceptT
     AccountsError
     (StateT Register m)
     (Either AccountsError a, Map String Account)
forall (m :: * -> *) a. Monad m => m a -> ExceptT AccountsError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT Register m (Either AccountsError a, Map String Account)
 -> ExceptT
      AccountsError
      (StateT Register m)
      (Either AccountsError a, Map String Account))
-> StateT Register m (Either AccountsError a, Map String Account)
-> ExceptT
     AccountsError
     (StateT Register m)
     (Either AccountsError a, Map String Account)
forall a b. (a -> b) -> a -> b
$ m (Either AccountsError a, Map String Account)
-> StateT Register m (Either AccountsError a, Map String Account)
forall (m :: * -> *) a. Monad m => m a -> StateT Register m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either AccountsError a, Map String Account)
 -> StateT Register m (Either AccountsError a, Map String Account))
-> m (Either AccountsError a, Map String Account)
-> StateT Register m (Either AccountsError a, Map String Account)
forall a b. (a -> b) -> a -> b
$ Register
-> AccountsT m a -> m (Either AccountsError a, Map String Account)
forall (m :: * -> *) a.
Monad m =>
Register
-> AccountsT m a -> m (Either AccountsError a, Map String Account)
runAccountsT Register
current AccountsT m a
comp
    Maybe a -> AccountsT m (Maybe a)
forall a. a -> ExceptT AccountsError (StateT Register m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> AccountsT m (Maybe a))
-> Maybe a -> AccountsT m (Maybe a)
forall a b. (a -> b) -> a -> b
$ case (Either AccountsError a, Map String Account)
-> Either AccountsError a
forall a b. (a, b) -> a
fst (Either AccountsError a, Map String Account)
x of
      (Left AccountsError
_) -> Maybe a
forall a. Maybe a
Nothing
      Right a
a -> a -> Maybe a
forall a. a -> Maybe a
Just a
a

  issuePayment :: Payment -> AccountsT m ()
issuePayment payment :: Payment
payment@(String
sender, Integer
amount, String
recipient) = do
    (Integer
senderBal, Set String
senderPols) <- String -> AccountsT m Account
forall (m :: * -> *). Monad m => String -> AccountsT m Account
ensureExistingUser String
sender
    (Integer
recipientBal, Set String
recipientPols) <- String -> AccountsT m Account
forall (m :: * -> *). Monad m => String -> AccountsT m Account
ensureExistingUser String
recipient
    Bool
sPols <- (Bool -> String -> ExceptT AccountsError (StateT Register m) Bool)
-> Bool
-> Set String
-> ExceptT AccountsError (StateT Register m) Bool
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Bool
res String
el -> (\Policy
f -> Policy
f Payment
payment Integer
senderBal String
sender Bool -> Bool -> Bool
&& Bool
res) (Policy -> Bool)
-> ExceptT AccountsError (StateT Register m) Policy
-> ExceptT AccountsError (StateT Register m) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ExceptT AccountsError (StateT Register m) Policy
forall (m :: * -> *). Monad m => String -> AccountsT m Policy
ensureExistingPolicy String
el) Bool
True Set String
senderPols
    Bool -> AccountsT m () -> AccountsT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
sPols (AccountsT m () -> AccountsT m ())
-> AccountsT m () -> AccountsT m ()
forall a b. (a -> b) -> a -> b
$ AccountsError -> AccountsT m ()
forall a.
AccountsError -> ExceptT AccountsError (StateT Register m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError AccountsError
PolicyError
    Bool
rPols <- (Bool -> String -> ExceptT AccountsError (StateT Register m) Bool)
-> Bool
-> Set String
-> ExceptT AccountsError (StateT Register m) Bool
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Bool
res String
el -> (\Policy
f -> Policy
f Payment
payment Integer
recipientBal String
recipient Bool -> Bool -> Bool
&& Bool
res) (Policy -> Bool)
-> ExceptT AccountsError (StateT Register m) Policy
-> ExceptT AccountsError (StateT Register m) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ExceptT AccountsError (StateT Register m) Policy
forall (m :: * -> *). Monad m => String -> AccountsT m Policy
ensureExistingPolicy String
el) Bool
True Set String
recipientPols
    Bool -> AccountsT m () -> AccountsT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
rPols (AccountsT m () -> AccountsT m ())
-> AccountsT m () -> AccountsT m ()
forall a b. (a -> b) -> a -> b
$ AccountsError -> AccountsT m ()
forall a.
AccountsError -> ExceptT AccountsError (StateT Register m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError AccountsError
PolicyError
    (Map String Account -> Map String Account) -> AccountsT m ()
forall (m :: * -> *).
Monad m =>
(Map String Account -> Map String Account) -> AccountsT m ()
modifyAccounts ((Map String Account -> Map String Account) -> AccountsT m ())
-> (Map String Account -> Map String Account) -> AccountsT m ()
forall a b. (a -> b) -> a -> b
$ String -> Account -> Map String Account -> Map String Account
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
recipient (Integer
recipientBal Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
amount, Set String
recipientPols)
    (Map String Account -> Map String Account) -> AccountsT m ()
forall (m :: * -> *).
Monad m =>
(Map String Account -> Map String Account) -> AccountsT m ()
modifyAccounts ((Map String Account -> Map String Account) -> AccountsT m ())
-> (Map String Account -> Map String Account) -> AccountsT m ()
forall a b. (a -> b) -> a -> b
$ String -> Account -> Map String Account -> Map String Account
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
sender (Integer
senderBal Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
amount, Set String
senderPols)