{- |
  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 :: Stack a -> Either Text a
runStack = Values -> Stack a -> Either Text a
forall a. Values -> Stack a -> Either Text a
runStackWithValues Values
forall a. Monoid a => a
mempty

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

execStack :: Stack a -> Either Text Values
execStack :: Stack a -> Either Text Values
execStack = Values -> Stack a -> Either Text Values
forall a. Values -> Stack a -> Either Text Values
execStackWithValues Values
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 :: Values -> Stack a -> Either Text Values
execStackWithValues Values
vs Stack a
sa = Statistics -> Values
values (Statistics -> Values)
-> Either Text Statistics -> Either Text Values
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stack a -> Statistics -> Either Text Statistics
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 :: Stack a -> Either Text Statistics
evalStack = Values -> Stack a -> Either Text Statistics
forall a. Values -> Stack a -> Either Text Statistics
evalStackWithValues Values
forall a. Monoid a => a
mempty

evalStackWithValues :: Values -> Stack a -> Either Text Statistics
evalStackWithValues :: Values -> Stack a -> Either Text Statistics
evalStackWithValues Values
vs Stack a
sa = Stack a -> Statistics -> Either Text Statistics
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 (Statistics -> Values)
-> StateT Statistics (Either Text) Statistics -> Stack Values
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Statistics (Either Text) Statistics
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 (Statistics -> Operations)
-> StateT Statistics (Either Text) Statistics -> Stack Operations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Statistics (Either Text) Statistics
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) })

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) })

modifyStatistics :: (Statistics -> Statistics) -> Stack ()
modifyStatistics :: (Statistics -> Statistics) -> Stack ()
modifyStatistics = (Statistics -> Statistics) -> Stack ()
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]
inputsAppliedFunction -> Operations -> Operations
forall a. a -> [a] -> [a]
:)