-- |
-- Static gas consumption for free applicatives.
module Control.Applicative.Free.Gas
    ( requiredGas
    ) where

import Control.Applicative.Free (Ap, runAp)
import Data.Functor.Const (Const (..))
import Data.Monoid (Sum (..))

-- |
-- Compute the number of steps the interpretation of a free applicative action
-- would take. The number of steps is the cummulative result of the cost
-- function given to 'requiredGas'. The limit is called the gas, by typical
-- /car analogy/.
requiredGas
    :: (forall x. f x -> Word) -- ^ Given an action, its cost.
    -> Ap f a                  -- ^ Program to compute required gas of.
    -> Word
requiredGas cost =
    getSum . getConst . runAp (Const . Sum . cost)