{-# LANGUAGE GADTs #-}
-- | Defines 'Phases', an 'Applicative' transformer for scheduling
-- effects during different phases of execution.
module Control.Applicative.Phases 
  ( Phases(..)
  , runPhasesForwards, runPhasesBackwards
  , now, later, delay
  ) where

import Control.Applicative (liftA2, (<**>))

-- | An applicative transformer to organize effects into an arbitrary number of
-- phases of execution.
--
-- Use 'now' to schedule actions for the current phase of execution:
--
-- >>> say name = putStrLn name *> pure name
-- >>> runPhasesForwards $ (,,) <$> now (say "Huey") <*> now (say "Dewey") <*> now (say "Louie")
-- Huey
-- Dewey
-- Louie
-- ("Huey","Dewey","Louie")
--
-- Or 'later' to schedule it for the next phase of execution:
--
-- >>> runPhasesForwards $ (,,) <$> later (say "Huey") <*> now (say "Dewey") <*> now (say "Louie")
-- Dewey
-- Louie
-- Huey
-- ("Huey","Dewey","Louie")
--
-- And 'delay' to delay a set of phased actions by one phase:
-- 
-- >>> runPhasesForwards $ delay ((,,) <$> later (say "Huey") <*> now (say "Dewey")) <*> now (say "Louie")
-- Louie
-- Dewey
-- Huey
-- ("Huey","Dewey","Louie")
--
-- Phases can also be run in reverse, but all actions in the same phase still occur in the same order:
--
-- >>> runPhasesBackwards $ (,,) <$> later (say "Huey") <*> now (say "Dewey") <*> now (say "Louie")
-- Huey
-- Dewey
-- Louie
-- ("Huey","Dewey","Louie")
data Phases f a where
  Lift :: f a -> Phases f a
  (:<*>) :: f (a -> b) -> Phases f a -> Phases f b

-- | run the phased actions in forwards order
--
-- >>> runPhasesForwards $ now (putStrLn "hello") *> later (putStrLn "world")
-- hello
-- world
-- >>> runPhasesForwards $ later (putStrLn "hello") *> now (putStrLn "world")
-- world
-- hello
runPhasesForwards :: Applicative f => Phases f a -> f a
runPhasesForwards :: forall (f :: * -> *) a. Applicative f => Phases f a -> f a
runPhasesForwards (Lift f a
ma) = f a
ma
runPhasesForwards (f (a -> a)
mg :<*> Phases f a
tx) = f (a -> a)
mg forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => Phases f a -> f a
runPhasesForwards Phases f a
tx

-- | run the phased actions in backwards order
--
-- >>> runPhasesBackwards $ now (putStrLn "hello") *> later (putStrLn "world")
-- world
-- hello
-- >>> runPhasesBackwards $ later (putStrLn "hello") *> now (putStrLn "world")
-- hello
-- world
runPhasesBackwards :: Applicative f => Phases f a -> f a
runPhasesBackwards :: forall (f :: * -> *) a. Applicative f => Phases f a -> f a
runPhasesBackwards (Lift f a
ma) = f a
ma
runPhasesBackwards (f (a -> a)
mg :<*> Phases f a
tx) = forall (f :: * -> *) a. Applicative f => Phases f a -> f a
runPhasesBackwards Phases f a
tx forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> f (a -> a)
mg

-- | schedule an action to run in the current phase
now :: f a -> Phases f a
now :: forall (f :: * -> *) a. f a -> Phases f a
now = forall (f :: * -> *) a. f a -> Phases f a
Lift

-- | schedule  an action to run in the next phase
later :: Applicative f => f a -> Phases f a
later :: forall (f :: * -> *) a. Applicative f => f a -> Phases f a
later = forall (f :: * -> *) a. Applicative f => Phases f a -> Phases f a
delay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. f a -> Phases f a
now

-- | delay all actions by a phase
delay :: Applicative f => Phases f a -> Phases f a
delay :: forall (f :: * -> *) a. Applicative f => Phases f a -> Phases f a
delay Phases f a
ta = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. a -> a
id forall (f :: * -> *) a b. f (a -> b) -> Phases f a -> Phases f b
:<*> Phases f a
ta

instance Functor f => Functor (Phases f) where
  fmap :: forall a b. (a -> b) -> Phases f a -> Phases f b
fmap a -> b
f (Lift f a
ma) = forall (f :: * -> *) a. f a -> Phases f a
Lift (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
ma)
  fmap a -> b
f (f (a -> a)
mg :<*> Phases f a
tx) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b
fforall b c a. (b -> c) -> (a -> b) -> a -> c
.) f (a -> a)
mg forall (f :: * -> *) a b. f (a -> b) -> Phases f a -> Phases f b
:<*> Phases f a
tx

instance Applicative f => Applicative (Phases f) where
  pure :: forall a. a -> Phases f a
pure = forall (f :: * -> *) a. f a -> Phases f a
now forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Lift f (a -> b)
mf <*> :: forall a b. Phases f (a -> b) -> Phases f a -> Phases f b
<*> Lift f a
ma = forall (f :: * -> *) a. f a -> Phases f a
Lift forall a b. (a -> b) -> a -> b
$ f (a -> b)
mf forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
ma 
  Lift f (a -> b)
mf <*> (f (a -> a)
mh :<*> Phases f a
ty) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) f (a -> b)
mf f (a -> a)
mh forall (f :: * -> *) a b. f (a -> b) -> Phases f a -> Phases f b
:<*> Phases f a
ty
  (f (a -> a -> b)
mg :<*> Phases f a
tx) <*> Lift f a
ma = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a b c. (a -> b -> c) -> b -> a -> c
flip f (a -> a -> b)
mg f a
ma forall (f :: * -> *) a b. f (a -> b) -> Phases f a -> Phases f b
:<*> Phases f a
tx
  (f (a -> a -> b)
mg :<*> Phases f a
tx) <*> (f (a -> a)
mh :<*> Phases f a
ty) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\a -> a -> b
g a -> a
h ~(a
x,a
y) -> a -> a -> b
g a
x (a -> a
h a
y)) f (a -> a -> b)
mg f (a -> a)
mh forall (f :: * -> *) a b. f (a -> b) -> Phases f a -> Phases f b
:<*> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) Phases f a
tx Phases f a
ty