{-# LANGUAGE LambdaCase, TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeOperators, ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Control.Moffy.Handle (
	-- * Constraint
	ExpandableHandle, ExpandableOccurred, MergeableOccurred,
	-- * Plain Handle
	-- ** Type
	Handle, Handle',
	-- ** Composer
	retry, sleep, sleepIfNothing, expand, before, merge,
	-- * Handle with State
	-- ** Type
	HandleSt, HandleSt', St, liftHandle, liftHandle', liftSt,
	-- ** Composer
	retrySt, expandSt, beforeSt, mergeSt,
	-- * Handle with Input and Output
	-- ** Type
	HandleIo', pushInput, popInput,
	-- ** Composer
	expandIo, beforeIo, mergeIo ) where

import Control.Arrow (first)
import Control.Moffy.Internal.React.Type (
	EvReqs, EvOccs, ExpandableOccurred, MergeableOccurred,
	Handle, HandleSt, St, liftHandle, liftSt )
import Control.Concurrent (threadDelay)
import Data.Type.Set ((:+:))
import Data.OneOrMore (Collapsable)
import Data.OneOrMoreApp (merge')

import qualified Data.OneOrMore as OOM (collapse)
import qualified Data.OneOrMoreApp as OOM (expand)

---------------------------------------------------------------------------

-- * CONSTRAINT
-- * PLAIN HANDLE
--	+ TYPE
--	+ COMPOSER
-- * HANDLE WITH STATE
--	+ TYPE
--	+ COMPOSER
-- * HANDLE WITH INPUT AND OUTPUT
--	+ TYPE
--	+ COMPOSER

---------------------------------------------------------------------------
-- CONSTRAINT
---------------------------------------------------------------------------

type ExpandableHandle es es' = (ExpandableOccurred es es', Collapsable es' es)

---------------------------------------------------------------------------
-- PLAIN HANDLE
---------------------------------------------------------------------------

-- TYPE

type Handle' m es = EvReqs es -> m (Maybe (EvOccs es))

-- COMPOSER

retry :: Monad m => Handle' m es -> Handle m es
retry :: forall (m :: * -> *) (es :: Set (*)).
Monad m =>
Handle' m es -> Handle m es
retry Handle' m es
hdl EvReqs es
rqs = forall (m :: * -> *) (es :: Set (*)).
Monad m =>
Handle' m es -> Handle m es
retry Handle' m es
hdl EvReqs es
rqs forall b a. b -> (a -> b) -> Maybe a -> b
`maybe` forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handle' m es
hdl EvReqs es
rqs

sleep :: Int -> Handle' IO es -> Handle' IO es
sleep :: forall (es :: Set (*)). Int -> Handle' IO es -> Handle' IO es
sleep Int
n Handle' IO es
hdl EvReqs es
rqs = Handle' IO es
hdl EvReqs es
rqs forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int -> IO ()
threadDelay Int
n

sleepIfNothing :: Int -> Handle' IO es -> Handle' IO es
sleepIfNothing :: forall (es :: Set (*)). Int -> Handle' IO es -> Handle' IO es
sleepIfNothing Int
n Handle' IO es
hdl EvReqs es
rqs = Handle' IO es
hdl EvReqs es
rqs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
	Maybe (OneOrMoreApp ('SetApp Occurred (Map Occurred es)))
Nothing -> forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Int -> IO ()
threadDelay Int
n
	Just OneOrMoreApp ('SetApp Occurred (Map Occurred es))
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just OneOrMoreApp ('SetApp Occurred (Map Occurred es))
x

collapse :: (Applicative m, Collapsable es' es) =>
	Handle' m es -> EvReqs es' -> m (Maybe (EvOccs es))
collapse :: forall (m :: * -> *) (es' :: Set (*)) (es :: Set (*)).
(Applicative m, Collapsable es' es) =>
Handle' m es -> EvReqs es' -> m (Maybe (EvOccs es))
collapse Handle' m es
hdl = (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing forall b a. b -> (a -> b) -> Maybe a -> b
`maybe` Handle' m es
hdl) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (as :: Set (*)) (as' :: Set (*)).
Collapsable as as' =>
OneOrMore as -> Maybe (OneOrMore as')
OOM.collapse

expand :: (Applicative m, ExpandableHandle es es') =>
	Handle' m es -> Handle' m es'
expand :: forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)).
(Applicative m, ExpandableHandle es es') =>
Handle' m es -> Handle' m es'
expand Handle' m es
hdl = ((forall (as :: Set (*)) (as' :: Set (*)) (f :: * -> *).
Expandable as as' =>
OneOrMoreApp ('SetApp f as) -> OneOrMoreApp ('SetApp f as')
OOM.expand forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (es' :: Set (*)) (es :: Set (*)).
(Applicative m, Collapsable es' es) =>
Handle' m es -> EvReqs es' -> m (Maybe (EvOccs es))
collapse Handle' m es
hdl

infixr 5 `before`, `beforeSt`

before :: (
	Monad m,
	ExpandableHandle es (es :+: es'), ExpandableHandle es' (es :+: es') ) =>
	Handle' m es -> Handle' m es' -> Handle' m (es :+: es')
((forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)).
(Applicative m, ExpandableHandle es es') =>
Handle' m es -> Handle' m es'
expand -> Handle' m (es :+: es')
l) before :: forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)).
(Monad m, ExpandableHandle es (es :+: es'),
 ExpandableHandle es' (es :+: es')) =>
Handle' m es -> Handle' m es' -> Handle' m (es :+: es')
`before` (forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)).
(Applicative m, ExpandableHandle es es') =>
Handle' m es -> Handle' m es'
expand -> Handle' m (es :+: es')
r)) EvReqs (es :+: es')
rqs =
	Handle' m (es :+: es')
r EvReqs (es :+: es')
rqs forall b a. b -> (a -> b) -> Maybe a -> b
`maybe` (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handle' m (es :+: es')
l EvReqs (es :+: es')
rqs

infixr 6 `merge`, `mergeSt`

merge :: (
	Applicative m,
	ExpandableHandle es (es :+: es'), ExpandableHandle es' (es :+: es'),
	MergeableOccurred es es' (es :+: es') ) =>
	Handle' m es -> Handle' m es' -> Handle' m (es :+: es')
((forall (m :: * -> *) (es' :: Set (*)) (es :: Set (*)).
(Applicative m, Collapsable es' es) =>
Handle' m es -> EvReqs es' -> m (Maybe (EvOccs es))
collapse -> EvReqs (es :+: es') -> m (Maybe (EvOccs es))
l) merge :: forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)).
(Applicative m, ExpandableHandle es (es :+: es'),
 ExpandableHandle es' (es :+: es'),
 MergeableOccurred es es' (es :+: es')) =>
Handle' m es -> Handle' m es' -> Handle' m (es :+: es')
`merge` (forall (m :: * -> *) (es' :: Set (*)) (es :: Set (*)).
(Applicative m, Collapsable es' es) =>
Handle' m es -> EvReqs es' -> m (Maybe (EvOccs es))
collapse -> EvReqs (es :+: es') -> m (Maybe (EvOccs es'))
r)) EvReqs (es :+: es')
rqs = forall (as :: Set (*)) (as' :: Set (*)) (mrg :: Set (*))
       (f :: * -> *).
(Mergeable as as' mrg, Expandable as mrg, Expandable as' mrg) =>
Maybe (OneOrMoreApp ('SetApp f as))
-> Maybe (OneOrMoreApp ('SetApp f as'))
-> Maybe (OneOrMoreApp ('SetApp f mrg))
merge' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EvReqs (es :+: es') -> m (Maybe (EvOccs es))
l EvReqs (es :+: es')
rqs forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EvReqs (es :+: es') -> m (Maybe (EvOccs es'))
r EvReqs (es :+: es')
rqs

---------------------------------------------------------------------------
-- HANDLE WITH STATE
---------------------------------------------------------------------------

-- TYPE

type HandleSt' st m es = EvReqs es -> St st m (Maybe (EvOccs es))
-- ^ > type HandleSt' st m es = HandleIo' st st m es

liftHandle' :: Functor m => Handle' m es -> HandleSt' st m es
liftHandle' :: forall (m :: * -> *) (es :: Set (*)) st.
Functor m =>
Handle' m es -> HandleSt' st m es
liftHandle' = (forall (m :: * -> *) r st. Functor m => m r -> St st m r
liftSt forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

-- COMPOSER

retrySt :: Monad m => HandleSt' st m es -> HandleSt st m es
retrySt :: forall (m :: * -> *) st (es :: Set (*)).
Monad m =>
HandleSt' st m es -> HandleSt st m es
retrySt HandleSt' st m es
hdl EvReqs es
rqs st
st = HandleSt' st m es
hdl EvReqs es
rqs st
st forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Maybe (OneOrMoreApp ('SetApp Occurred (Map Occurred es)))
mo, st
st') ->
	(forall (m :: * -> *) st (es :: Set (*)).
Monad m =>
HandleSt' st m es -> HandleSt st m es
retrySt HandleSt' st m es
hdl EvReqs es
rqs st
st' forall b a. b -> (a -> b) -> Maybe a -> b
`maybe` (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, st
st'))) Maybe (OneOrMoreApp ('SetApp Occurred (Map Occurred es)))
mo

expandSt :: (Applicative m, ExpandableHandle es es') =>
	HandleSt' st m es -> HandleSt' st m es'
expandSt :: forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st.
(Applicative m, ExpandableHandle es es') =>
HandleSt' st m es -> HandleSt' st m es'
expandSt = (forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) i o.
(Applicative m, ExpandableHandle es es') =>
HandleIo' i o m es -> (i -> m o) -> HandleIo' i o m es'
`expandIo` forall (f :: * -> *) a. Applicative f => a -> f a
pure)

beforeSt :: (
	Monad m,
	ExpandableHandle es (es :+: es'), ExpandableHandle es' (es :+: es') ) =>
	HandleSt' st m es -> HandleSt' st m es' -> HandleSt' st m (es :+: es')
HandleSt' st m es
l beforeSt :: forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st.
(Monad m, ExpandableHandle es (es :+: es'),
 ExpandableHandle es' (es :+: es')) =>
HandleSt' st m es
-> HandleSt' st m es' -> HandleSt' st m (es :+: es')
`beforeSt` HandleSt' st m es'
r = forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) i x o.
(Monad m, ExpandableHandle es (es :+: es'),
 ExpandableHandle es' (es :+: es')) =>
HandleIo' i x m es
-> (i -> m x)
-> HandleIo' x o m es'
-> (x -> m o)
-> HandleIo' i o m (es :+: es')
beforeIo HandleSt' st m es
l forall (f :: * -> *) a. Applicative f => a -> f a
pure HandleSt' st m es'
r forall (f :: * -> *) a. Applicative f => a -> f a
pure

mergeSt :: (
	Monad m,
	ExpandableHandle es (es :+: es'), ExpandableHandle es' (es :+: es'),
	MergeableOccurred es es' (es :+: es') ) =>
	HandleSt' st m es -> HandleSt' st m es' -> HandleSt' st m (es :+: es')
HandleSt' st m es
l mergeSt :: forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st.
(Monad m, ExpandableHandle es (es :+: es'),
 ExpandableHandle es' (es :+: es'),
 MergeableOccurred es es' (es :+: es')) =>
HandleSt' st m es
-> HandleSt' st m es' -> HandleSt' st m (es :+: es')
`mergeSt` HandleSt' st m es'
r = forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) i x o.
(Monad m, ExpandableHandle es (es :+: es'),
 ExpandableHandle es' (es :+: es'),
 MergeableOccurred es es' (es :+: es')) =>
HandleIo' i x m es
-> (i -> m x)
-> HandleIo' x o m es'
-> (x -> m o)
-> HandleIo' i o m (es :+: es')
mergeIo HandleSt' st m es
l forall (f :: * -> *) a. Applicative f => a -> f a
pure HandleSt' st m es'
r forall (f :: * -> *) a. Applicative f => a -> f a
pure

---------------------------------------------------------------------------
-- HANDLE WITH INPUT AND OUTPUT
---------------------------------------------------------------------------

-- TYPE

type HandleIo' i o m es = EvReqs es -> i -> m (Maybe (EvOccs es), o)

pushInput :: (a -> HandleSt' st m es) -> HandleIo' (a, st) st m es
pushInput :: forall a st (m :: * -> *) (es :: Set (*)).
(a -> HandleSt' st m es) -> HandleIo' (a, st) st m es
pushInput = (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip

popInput :: HandleIo' (a, st) st m es -> a -> HandleSt' st m es
popInput :: forall a st (m :: * -> *) (es :: Set (*)).
HandleIo' (a, st) st m es -> a -> HandleSt' st m es
popInput = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b c. ((a, b) -> c) -> a -> b -> c
curry forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

-- COMPOSER

collapseIo :: (Applicative m, Collapsable es' es) =>
	HandleIo' i o m es -> (i -> m o) ->
	EvReqs es' -> i -> m (Maybe (EvOccs es), o)
collapseIo :: forall (m :: * -> *) (es' :: Set (*)) (es :: Set (*)) i o.
(Applicative m, Collapsable es' es) =>
HandleIo' i o m es
-> (i -> m o) -> EvReqs es' -> i -> m (Maybe (EvOccs es), o)
collapseIo HandleIo' i o m es
hdl i -> m o
nh = ((((forall a. Maybe a
Nothing ,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> m o
nh) forall b a. b -> (a -> b) -> Maybe a -> b
`maybe` HandleIo' i o m es
hdl) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (as :: Set (*)) (as' :: Set (*)).
Collapsable as as' =>
OneOrMore as -> Maybe (OneOrMore as')
OOM.collapse

expandIo :: (Applicative m, ExpandableHandle es es') =>
	HandleIo' i o m es -> (i -> m o) -> HandleIo' i o m es'
expandIo :: forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) i o.
(Applicative m, ExpandableHandle es es') =>
HandleIo' i o m es -> (i -> m o) -> HandleIo' i o m es'
expandIo HandleIo' i o m es
hdl i -> m o
nh EvReqs es'
rqs = (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (forall (as :: Set (*)) (as' :: Set (*)) (f :: * -> *).
Expandable as as' =>
OneOrMoreApp ('SetApp f as) -> OneOrMoreApp ('SetApp f as')
OOM.expand forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (es' :: Set (*)) (es :: Set (*)) i o.
(Applicative m, Collapsable es' es) =>
HandleIo' i o m es
-> (i -> m o) -> EvReqs es' -> i -> m (Maybe (EvOccs es), o)
collapseIo HandleIo' i o m es
hdl i -> m o
nh EvReqs es'
rqs

beforeIo :: (
	Monad m,
	ExpandableHandle es (es :+: es'), ExpandableHandle es' (es :+: es') ) =>
	HandleIo' i x m es -> (i -> m x) ->
	HandleIo' x o m es' -> (x -> m o) -> HandleIo' i o m (es :+: es')
beforeIo :: forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) i x o.
(Monad m, ExpandableHandle es (es :+: es'),
 ExpandableHandle es' (es :+: es')) =>
HandleIo' i x m es
-> (i -> m x)
-> HandleIo' x o m es'
-> (x -> m o)
-> HandleIo' i o m (es :+: es')
beforeIo HandleIo' i x m es
l i -> m x
nhl HandleIo' x o m es'
r x -> m o
nhr EvReqs (es :+: es')
rqs i
st = forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) i o.
(Applicative m, ExpandableHandle es es') =>
HandleIo' i o m es -> (i -> m o) -> HandleIo' i o m es'
expandIo HandleIo' i x m es
l i -> m x
nhl EvReqs (es :+: es')
rqs i
st forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Maybe (OneOrMoreApp ('SetApp Occurred (Map Occurred (es :+: es'))))
mo, x
st') ->
	(forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) i o.
(Applicative m, ExpandableHandle es es') =>
HandleIo' i o m es -> (i -> m o) -> HandleIo' i o m es'
expandIo HandleIo' x o m es'
r x -> m o
nhr EvReqs (es :+: es')
rqs x
st' forall b a. b -> (a -> b) -> Maybe a -> b
`maybe` ((forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> x -> m o
nhr x
st') forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)) Maybe (OneOrMoreApp ('SetApp Occurred (Map Occurred (es :+: es'))))
mo

mergeIo :: (
	Monad m,
	ExpandableHandle es (es :+: es'), ExpandableHandle es' (es :+: es'),
	MergeableOccurred es es' (es :+: es') ) =>
	HandleIo' i x m es -> (i -> m x) ->
	HandleIo' x o m es' -> (x -> m o) -> HandleIo' i o m (es :+: es')
mergeIo :: forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) i x o.
(Monad m, ExpandableHandle es (es :+: es'),
 ExpandableHandle es' (es :+: es'),
 MergeableOccurred es es' (es :+: es')) =>
HandleIo' i x m es
-> (i -> m x)
-> HandleIo' x o m es'
-> (x -> m o)
-> HandleIo' i o m (es :+: es')
mergeIo HandleIo' i x m es
l i -> m x
nhl HandleIo' x o m es'
r x -> m o
nhr EvReqs (es :+: es')
rqs i
st = forall (m :: * -> *) (es' :: Set (*)) (es :: Set (*)) i o.
(Applicative m, Collapsable es' es) =>
HandleIo' i o m es
-> (i -> m o) -> EvReqs es' -> i -> m (Maybe (EvOccs es), o)
collapseIo HandleIo' i x m es
l i -> m x
nhl EvReqs (es :+: es')
rqs i
st forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Maybe (OneOrMoreApp ('SetApp Occurred (Map Occurred es)))
mo, x
st') ->
	forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Maybe (OneOrMoreApp ('SetApp Occurred (Map Occurred es)))
mo forall (as :: Set (*)) (as' :: Set (*)) (mrg :: Set (*))
       (f :: * -> *).
(Mergeable as as' mrg, Expandable as mrg, Expandable as' mrg) =>
Maybe (OneOrMoreApp ('SetApp f as))
-> Maybe (OneOrMoreApp ('SetApp f as'))
-> Maybe (OneOrMoreApp ('SetApp f mrg))
`merge'`) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) (es' :: Set (*)) (es :: Set (*)) i o.
(Applicative m, Collapsable es' es) =>
HandleIo' i o m es
-> (i -> m o) -> EvReqs es' -> i -> m (Maybe (EvOccs es), o)
collapseIo HandleIo' x o m es'
r x -> m o
nhr EvReqs (es :+: es')
rqs x
st'