-- | Lifting functions for the various types used in 'HardForkState'
--
-- NOTE: These are internal and not exported in the toplevel @.State@ module.
module Ouroboros.Consensus.HardFork.Combinator.State.Lift (
    -- * Lifting functions on @f@ to @Current @f@
    lift
  , liftM
  ) where

import           Data.Functor.Identity

import           Ouroboros.Consensus.HardFork.Combinator.State.Types

{-------------------------------------------------------------------------------
  Lifting functions on @f@ to @Current @f@
-------------------------------------------------------------------------------}

lift :: (f blk -> f' blk) -> Current f blk -> Current f' blk
lift :: (f blk -> f' blk) -> Current f blk -> Current f' blk
lift f blk -> f' blk
f = Identity (Current f' blk) -> Current f' blk
forall a. Identity a -> a
runIdentity (Identity (Current f' blk) -> Current f' blk)
-> (Current f blk -> Identity (Current f' blk))
-> Current f blk
-> Current f' blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f blk -> Identity (f' blk))
-> Current f blk -> Identity (Current f' blk)
forall (m :: * -> *) (f :: * -> *) blk (f' :: * -> *).
Functor m =>
(f blk -> m (f' blk)) -> Current f blk -> m (Current f' blk)
liftM (f' blk -> Identity (f' blk)
forall a. a -> Identity a
Identity (f' blk -> Identity (f' blk))
-> (f blk -> f' blk) -> f blk -> Identity (f' blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f blk -> f' blk
f)

liftM :: Functor m
      => (f blk -> m (f' blk)) -> Current f blk -> m (Current f' blk)
liftM :: (f blk -> m (f' blk)) -> Current f blk -> m (Current f' blk)
liftM f blk -> m (f' blk)
f (Current Bound
start f blk
cur) = Bound -> f' blk -> Current f' blk
forall (f :: * -> *) blk. Bound -> f blk -> Current f blk
Current Bound
start (f' blk -> Current f' blk) -> m (f' blk) -> m (Current f' blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f blk -> m (f' blk)
f f blk
cur