{-# 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 f (a -> a) -> f a -> f a
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Phases f a -> f a
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) = Phases f a -> f a
forall (f :: * -> *) a. Applicative f => Phases f a -> f a
runPhasesBackwards Phases f a
tx f a -> f (a -> a) -> f a
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 = f a -> Phases f a
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 = Phases f a -> Phases f a
forall (f :: * -> *) a. Applicative f => Phases f a -> Phases f a
delay (Phases f a -> Phases f a)
-> (f a -> Phases f a) -> f a -> Phases f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Phases f a
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 = (a -> a) -> f (a -> a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
forall a. a -> a
id f (a -> a) -> Phases f a -> Phases f a
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) = f b -> Phases f b
forall (f :: * -> *) a. f a -> Phases f a
Lift ((a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
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) = ((a -> a) -> a -> b) -> f (a -> a) -> f (a -> b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b
f(a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) f (a -> a)
mg f (a -> b) -> Phases f a -> Phases f b
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 = f a -> Phases f a
forall (f :: * -> *) a. f a -> Phases f a
now (f a -> Phases f a) -> (a -> f a) -> a -> Phases f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
forall a. a -> f a
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 = f b -> Phases f b
forall (f :: * -> *) a. f a -> Phases f a
Lift (f b -> Phases f b) -> f b -> Phases f b
forall a b. (a -> b) -> a -> b
$ f (a -> b)
mf f (a -> b) -> f a -> f b
forall a b. f (a -> b) -> f a -> f b
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) = ((a -> b) -> (a -> a) -> a -> b)
-> f (a -> b) -> f (a -> a) -> f (a -> b)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) f (a -> b)
mf f (a -> a)
mh f (a -> b) -> Phases f a -> Phases f b
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 = ((a -> a -> b) -> a -> a -> b)
-> f (a -> a -> b) -> f a -> f (a -> b)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (a -> a -> b) -> a -> a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip f (a -> a -> b)
mg f a
ma f (a -> b) -> Phases f a -> Phases f b
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) = ((a -> a -> b) -> (a -> a) -> (a, a) -> b)
-> f (a -> a -> b) -> f (a -> a) -> f ((a, a) -> b)
forall a b c. (a -> b -> c) -> f a -> f b -> f c
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 f ((a, a) -> b) -> Phases f (a, a) -> Phases f b
forall (f :: * -> *) a b. f (a -> b) -> Phases f a -> Phases f b
:<*> (a -> a -> (a, a)) -> Phases f a -> Phases f a -> Phases f (a, a)
forall a b c.
(a -> b -> c) -> Phases f a -> Phases f b -> Phases f c
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