{-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module LiveCoding.Handle where
import Control.Arrow (arr, (>>>))
import Data.Data
import Control.Monad.Trans.Class (MonadTrans (lift))
import Control.Monad.Morph
import LiveCoding.Cell
import LiveCoding.HandlingState
import LiveCoding.Migrate.NoMigration
data Handle m h = Handle
{ forall (m :: * -> *) h. Handle m h -> m h
create :: m h
, forall (m :: * -> *) h. Handle m h -> h -> m ()
destroy :: h -> m ()
}
instance MFunctor Handle where
hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> Handle m b -> Handle n b
hoist forall a. m a -> n a
morphism Handle {m b
b -> m ()
destroy :: b -> m ()
create :: m b
destroy :: forall (m :: * -> *) h. Handle m h -> h -> m ()
create :: forall (m :: * -> *) h. Handle m h -> m h
..} =
Handle
{ create :: n b
create = forall a. m a -> n a
morphism m b
create
, destroy :: b -> n ()
destroy = forall a. m a -> n a
morphism forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> m ()
destroy
}
combineHandles :: Applicative m => Handle m h1 -> Handle m h2 -> Handle m (h1, h2)
combineHandles :: forall (m :: * -> *) h1 h2.
Applicative m =>
Handle m h1 -> Handle m h2 -> Handle m (h1, h2)
combineHandles Handle m h1
handle1 Handle m h2
handle2 =
Handle
{ create :: m (h1, h2)
create = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) h. Handle m h -> m h
create Handle m h1
handle1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) h. Handle m h -> m h
create Handle m h2
handle2
, destroy :: (h1, h2) -> m ()
destroy = \(h1
h1, h2
h2) -> forall (m :: * -> *) h. Handle m h -> h -> m ()
destroy Handle m h2
handle2 h2
h2 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) h. Handle m h -> h -> m ()
destroy Handle m h1
handle1 h1
h1
}
handling ::
( Typeable h
, Monad m
) =>
Handle m h ->
Cell (HandlingStateT m) arbitrary h
handling :: forall h (m :: * -> *) arbitrary.
(Typeable h, Monad m) =>
Handle m h -> Cell (HandlingStateT m) arbitrary h
handling Handle m h
handle = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a b. a -> b -> a
const ()) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall h p (m :: * -> *).
(Typeable h, Typeable p, Monad m, Eq p) =>
ParametrisedHandle p m h -> Cell (HandlingStateT m) p h
handlingParametrised (forall (m :: * -> *) h.
Monad m =>
Handle m h -> ParametrisedHandle () m h
toParametrised Handle m h
handle)
data ParametrisedHandle p m h = ParametrisedHandle
{ forall p (m :: * -> *) h. ParametrisedHandle p m h -> p -> m h
createParametrised :: p -> m h
, forall p (m :: * -> *) h.
ParametrisedHandle p m h -> p -> p -> h -> m h
changeParametrised :: p -> p -> h -> m h
, forall p (m :: * -> *) h.
ParametrisedHandle p m h -> p -> h -> m ()
destroyParametrised :: p -> h -> m ()
}
instance MFunctor (ParametrisedHandle p) where
hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ParametrisedHandle p m b -> ParametrisedHandle p n b
hoist forall a. m a -> n a
morphism ParametrisedHandle {p -> m b
p -> p -> b -> m b
p -> b -> m ()
destroyParametrised :: p -> b -> m ()
changeParametrised :: p -> p -> b -> m b
createParametrised :: p -> m b
destroyParametrised :: forall p (m :: * -> *) h.
ParametrisedHandle p m h -> p -> h -> m ()
changeParametrised :: forall p (m :: * -> *) h.
ParametrisedHandle p m h -> p -> p -> h -> m h
createParametrised :: forall p (m :: * -> *) h. ParametrisedHandle p m h -> p -> m h
..} =
ParametrisedHandle
{ createParametrised :: p -> n b
createParametrised = forall a. m a -> n a
morphism forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> m b
createParametrised
, changeParametrised :: p -> p -> b -> n b
changeParametrised = ((forall a. m a -> n a
morphism forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> p -> b -> m b
changeParametrised
, destroyParametrised :: p -> b -> n ()
destroyParametrised = (forall a. m a -> n a
morphism forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> b -> m ()
destroyParametrised
}
defaultChange :: (Eq p, Monad m) => (p -> m h) -> (p -> h -> m ()) -> p -> p -> h -> m h
defaultChange :: forall p (m :: * -> *) h.
(Eq p, Monad m) =>
(p -> m h) -> (p -> h -> m ()) -> p -> p -> h -> m h
defaultChange p -> m h
creator p -> h -> m ()
destructor p
pOld p
pNew h
h
| p
pOld forall a. Eq a => a -> a -> Bool
== p
pNew = forall (m :: * -> *) a. Monad m => a -> m a
return h
h
| Bool
otherwise = do
p -> h -> m ()
destructor p
pOld h
h
p -> m h
creator p
pNew
combineParametrisedHandles ::
Applicative m =>
ParametrisedHandle p1 m h1 ->
ParametrisedHandle p2 m h2 ->
ParametrisedHandle (p1, p2) m (h1, h2)
combineParametrisedHandles :: forall (m :: * -> *) p1 h1 p2 h2.
Applicative m =>
ParametrisedHandle p1 m h1
-> ParametrisedHandle p2 m h2
-> ParametrisedHandle (p1, p2) m (h1, h2)
combineParametrisedHandles ParametrisedHandle p1 m h1
handle1 ParametrisedHandle p2 m h2
handle2 =
ParametrisedHandle
{ createParametrised :: (p1, p2) -> m (h1, h2)
createParametrised = \(p1
p1, p2
p2) -> (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall p (m :: * -> *) h. ParametrisedHandle p m h -> p -> m h
createParametrised ParametrisedHandle p1 m h1
handle1 p1
p1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall p (m :: * -> *) h. ParametrisedHandle p m h -> p -> m h
createParametrised ParametrisedHandle p2 m h2
handle2 p2
p2
, changeParametrised :: (p1, p2) -> (p1, p2) -> (h1, h2) -> m (h1, h2)
changeParametrised = \(p1
pOld1, p2
pOld2) (p1
pNew1, p2
pNew2) (h1
h1, h2
h2) -> (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall p (m :: * -> *) h.
ParametrisedHandle p m h -> p -> p -> h -> m h
changeParametrised ParametrisedHandle p1 m h1
handle1 p1
pOld1 p1
pNew1 h1
h1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall p (m :: * -> *) h.
ParametrisedHandle p m h -> p -> p -> h -> m h
changeParametrised ParametrisedHandle p2 m h2
handle2 p2
pOld2 p2
pNew2 h2
h2
, destroyParametrised :: (p1, p2) -> (h1, h2) -> m ()
destroyParametrised = \(p1
p1, p2
p2) (h1
h1, h2
h2) -> forall p (m :: * -> *) h.
ParametrisedHandle p m h -> p -> h -> m ()
destroyParametrised ParametrisedHandle p1 m h1
handle1 p1
p1 h1
h1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall p (m :: * -> *) h.
ParametrisedHandle p m h -> p -> h -> m ()
destroyParametrised ParametrisedHandle p2 m h2
handle2 p2
p2 h2
h2
}
handlingParametrised ::
( Typeable h
, Typeable p
, Monad m
, Eq p
) =>
ParametrisedHandle p m h ->
Cell (HandlingStateT m) p h
handlingParametrised :: forall h p (m :: * -> *).
(Typeable h, Typeable p, Monad m, Eq p) =>
ParametrisedHandle p m h -> Cell (HandlingStateT m) p h
handlingParametrised handleImpl :: ParametrisedHandle p m h
handleImpl@ParametrisedHandle {p -> m h
p -> h -> m ()
p -> p -> h -> m h
destroyParametrised :: p -> h -> m ()
changeParametrised :: p -> p -> h -> m h
createParametrised :: p -> m h
destroyParametrised :: forall p (m :: * -> *) h.
ParametrisedHandle p m h -> p -> h -> m ()
changeParametrised :: forall p (m :: * -> *) h.
ParametrisedHandle p m h -> p -> p -> h -> m h
createParametrised :: forall p (m :: * -> *) h. ParametrisedHandle p m h -> p -> m h
..} = Cell {NoMigration (Handling (h, p))
-> p
-> StateT (HandlingState m) m (h, NoMigration (Handling (h, p)))
forall {a}. NoMigration a
cellStep :: NoMigration (Handling (h, p))
-> p
-> StateT (HandlingState m) m (h, NoMigration (Handling (h, p)))
cellState :: NoMigration (Handling (h, p))
cellStep :: NoMigration (Handling (h, p))
-> p
-> StateT (HandlingState m) m (h, NoMigration (Handling (h, p)))
cellState :: forall {a}. NoMigration a
..}
where
cellState :: NoMigration a
cellState = forall {a}. NoMigration a
Uninitialized
cellStep :: NoMigration (Handling (h, p))
-> p
-> StateT (HandlingState m) m (h, NoMigration (Handling (h, p)))
cellStep NoMigration (Handling (h, p))
Uninitialized p
parameter = do
h
mereHandle <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ p -> m h
createParametrised p
parameter
let handle :: (h, p)
handle = (h
mereHandle, p
parameter)
Key
key <- forall (m :: * -> *). Monad m => m () -> HandlingStateT m Key
register forall a b. (a -> b) -> a -> b
$ p -> h -> m ()
destroyParametrised p
parameter h
mereHandle
forall (m :: * -> *) a. Monad m => a -> m a
return (h
mereHandle, forall a. a -> NoMigration a
Initialized Handling {handle :: (h, p)
handle = (h, p)
handle, Key
key :: Key
key :: Key
..})
cellStep handling :: NoMigration (Handling (h, p))
handling@(Initialized Handling {handle :: forall h. Handling h -> h
handle = (h
mereHandle, p
lastParameter), Key
key :: Key
key :: forall h. Handling h -> Key
..}) p
parameter
| p
parameter forall a. Eq a => a -> a -> Bool
== p
lastParameter = do
forall (m :: * -> *). Monad m => m () -> Key -> HandlingStateT m ()
reregister (p -> h -> m ()
destroyParametrised p
parameter h
mereHandle) Key
key
forall (m :: * -> *) a. Monad m => a -> m a
return (h
mereHandle, NoMigration (Handling (h, p))
handling)
| Bool
otherwise = do
h
mereHandle <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ p -> p -> h -> m h
changeParametrised p
lastParameter p
parameter h
mereHandle
forall (m :: * -> *). Monad m => m () -> Key -> HandlingStateT m ()
reregister (p -> h -> m ()
destroyParametrised p
parameter h
mereHandle) Key
key
forall (m :: * -> *) a. Monad m => a -> m a
return (h
mereHandle, forall a. a -> NoMigration a
Initialized Handling {handle :: (h, p)
handle = (h
mereHandle, p
parameter), Key
key :: Key
key :: Key
..})
toParametrised :: Monad m => Handle m h -> ParametrisedHandle () m h
toParametrised :: forall (m :: * -> *) h.
Monad m =>
Handle m h -> ParametrisedHandle () m h
toParametrised Handle {m h
h -> m ()
destroy :: h -> m ()
create :: m h
destroy :: forall (m :: * -> *) h. Handle m h -> h -> m ()
create :: forall (m :: * -> *) h. Handle m h -> m h
..} =
ParametrisedHandle
{ createParametrised :: () -> m h
createParametrised = forall a b. a -> b -> a
const m h
create
, changeParametrised :: () -> () -> h -> m h
changeParametrised = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall (m :: * -> *) a. Monad m => a -> m a
return
, destroyParametrised :: () -> h -> m ()
destroyParametrised = forall a b. a -> b -> a
const h -> m ()
destroy
}