-- | Internal monad for the resolution algorithm
--
--  - we keep some state for the list of created values
--  - we collect the applied functions as "Operations"
--  - we might exit with a Left value if we can't build a value
module Data.Registry.Internal.Stack where

import Data.Registry.Internal.Statistics
import Data.Registry.Internal.Types
import Protolude

-- | Monadic stack for the resolution algorithm
type Stack a = StateT Statistics (Either Text) a

-- | Return a value from the Stack if possible
runStack :: Stack a -> Either Text a
runStack :: forall a. Stack a -> Either Text a
runStack = forall a. Values -> Stack a -> Either Text a
runStackWithValues forall a. Monoid a => a
mempty

-- | Return a value from the Stack if possible
runStackWithValues :: Values -> Stack a -> Either Text a
runStackWithValues :: forall a. Values -> Stack a -> Either Text a
runStackWithValues Values
vs Stack a
sa = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Stack a
sa (Values -> Statistics
initStatistics Values
vs)

-- | Run the stack to get a list of created values
execStack :: Stack a -> Either Text Values
execStack :: forall a. Stack a -> Either Text Values
execStack = forall a. Values -> Stack a -> Either Text Values
execStackWithValues forall a. Monoid a => a
mempty

-- | Return the state of the stack after executing the action
--   This returns the list of built values
execStackWithValues :: Values -> Stack a -> Either Text Values
execStackWithValues :: forall a. Values -> Stack a -> Either Text Values
execStackWithValues Values
vs Stack a
sa = Statistics -> Values
values forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT Stack a
sa (Values -> Statistics
initStatistics Values
vs)

-- | Return the list of applied functions after resolution
evalStack :: Stack a -> Either Text Statistics
evalStack :: forall a. Stack a -> Either Text Statistics
evalStack = forall a. Values -> Stack a -> Either Text Statistics
evalStackWithValues forall a. Monoid a => a
mempty

-- | Run the stack to get a the statistics, starting with some initially created values
evalStackWithValues :: Values -> Stack a -> Either Text Statistics
evalStackWithValues :: forall a. Values -> Stack a -> Either Text Statistics
evalStackWithValues Values
vs Stack a
sa = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT Stack a
sa (Values -> Statistics
initStatistics Values
vs)

-- | Get the current list of values
getValues :: Stack Values
getValues :: Stack Values
getValues = Statistics -> Values
values forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get

-- | Get the current list of operations
getOperations :: Stack Operations
getOperations :: Stack Operations
getOperations = Statistics -> Operations
operations forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get

-- | Modify the current list of values
modifyValues :: (Values -> Values) -> Stack ()
modifyValues :: (Values -> Values) -> Stack ()
modifyValues Values -> Values
f = (Statistics -> Statistics) -> Stack ()
modifyStatistics (\Statistics
s -> Statistics
s {values :: Values
values = Values -> Values
f (Statistics -> Values
values Statistics
s)})

-- | Modify the current operations
modifyOperations :: (Operations -> Operations) -> Stack ()
modifyOperations :: (Operations -> Operations) -> Stack ()
modifyOperations Operations -> Operations
f = (Statistics -> Statistics) -> Stack ()
modifyStatistics (\Statistics
s -> Statistics
s {operations :: Operations
operations = Operations -> Operations
f (Statistics -> Operations
operations Statistics
s)})

-- | Modify the current statistics
modifyStatistics :: (Statistics -> Statistics) -> Stack ()
modifyStatistics :: (Statistics -> Statistics) -> Stack ()
modifyStatistics = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify

-- | Store a function application in the list of operations
functionApplied :: Value -> [Value] -> Stack ()
functionApplied :: Value -> [Value] -> Stack ()
functionApplied Value
output [Value]
inputs = (Operations -> Operations) -> Stack ()
modifyOperations (Value -> [Value] -> AppliedFunction
AppliedFunction Value
output [Value]
inputs :)