{-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module LiveCoding.Handle where

-- base
import Control.Arrow (arr, (>>>))
import Data.Data

-- transformers
import Control.Monad.Trans.Class (MonadTrans (lift))

-- mmorph
import Control.Monad.Morph

-- essence-of-live-coding
import LiveCoding.Cell
import LiveCoding.HandlingState
import LiveCoding.Migrate.NoMigration

{- | Container for unserialisable values,
such as 'IORef's, threads, 'MVar's, pointers, and device handles.

In a 'Handle', you can store a mechanism to create and destroy a value
that survives reloads occuring during live coding
even if does not have a 'Data' instance.
Using the function 'handling', you can create a cell that will
automatically initialise your value,
and register it in the 'HandlingStateT' monad transformer,
which takes care of automatically destroying it (if necessary) when it does not occur anymore in a later revision of your live program.

Have a look at 'LiveCoding.Handle.Examples' for some ready-to-use implementations.

In short, 'Handle' is an opaque, automatically constructing and garbage collecting container for arbitrary values in the live coding environment.
-}
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
      }

{- | Combine two handles to one.

'Handle's are not quite 'Monoid's because of the extra type parameter,
but it is possible to combine them.
In the combined handle, the first handle is created first and destroyed last.

Note: 'Handle' is not an 'Applicative' because it is not a 'Functor'
(because the destructor is contravariant in @h@).
-}
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
    }

{- | Hide a handle in a cell,
taking care of initialisation and destruction.

Upon the first tick (or directly after migration),
the 'create' method of the 'Handle' is called,
and the result stored.
This result is then not changed anymore until the cell is removed again.
Once it is removed, the destructor will be called on the next tick.

Migrations will by default not inspect the interior of a 'handling' cell.
This means that handles are only migrated if they have exactly the same type.
-}
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)

{- | Generalisation of 'Handle' carrying an additional parameter which may change at runtime.

Like in a 'Handle', the @h@ value of a 'ParametrisedHandle' is preserved through live coding reloads.
Additionally, the parameter @p@ value can be adjusted,
and triggers a destruction and reinitialisation whenever it changes.
-}
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
      }

{- | Given the methods 'createParametrised' and 'destroyParametrised',
   build a fitting method for 'changeParametrised' which
-}
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

-- | Like 'combineHandles', but for 'ParametrisedHandle's.
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
    }

{- | Hide a 'ParametrisedHandle' in a cell,
taking care of initialisation and destruction.

Upon the first tick, directly after migration, and after each parameter change,
the 'create' method of the 'Handle' is called,
and the result stored.
This result is then not changed anymore until the cell is removed again, or the parameter changes.
A parameter change triggers the destructor immediately,
but if the cell is removed, the destructor will be called on the next tick.

Migrations will by default not inspect the interior of a 'handling' cell.
This means that parametrised handles are only migrated if they have exactly the same type.
-}
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
..})

{- | Every 'Handle' is trivially a 'ParametrisedHandle'
   when the parameter is the trivial type.
-}
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
    }