{-# LANGUAGE AllowAmbiguousTypes #-}

-- | This module is experimental and is not added to the top level module Data.Registry.
--   It is not quite sure if we can / should support a useful state monad for passing a registry around
module Data.Registry.State where

import Control.Monad.Morph
import Data.Registry.Internal.Types
import Data.Registry.Lift
import Data.Registry.Registry
import Data.Registry.Solver
import Protolude

-- | Run some registry modifications in the StateT monad
runS :: (MFunctor m, Monad n) => Registry ins out -> m (StateT (Registry ins out) n) a -> m n a
runS :: forall {k} (m :: (* -> *) -> k -> *) (n :: * -> *) (ins :: [*])
       (out :: [*]) (a :: k).
(MFunctor m, Monad n) =>
Registry ins out -> m (StateT (Registry ins out) n) a -> m n a
runS Registry ins out
r = forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
`evalStateT` Registry ins out
r)

-- | Add an element to the registry without changing its type
addFunTo :: forall m a b ins out. (ApplyVariadic m a b, Typeable a, Typeable b, IsSubset (Inputs b) out b) => a -> Registry ins out -> Registry ins out
addFunTo :: forall (m :: * -> *) a b (ins :: [*]) (out :: [*]).
(ApplyVariadic m a b, Typeable a, Typeable b,
 IsSubset (Inputs b) out b) =>
a -> Registry ins out -> Registry ins out
addFunTo = forall a (out :: [*]) (ins :: [*]).
(Typeable a, IsSubset (Inputs a) out a) =>
Typed a -> Registry ins out -> Registry ins out
addToRegistry @b forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
(ApplyVariadic m a b, Typeable a, Typeable b) =>
a -> Typed b
funTo @m

-- | Add an element to the registry without changing its type
--   *** This possibly adds untracked input types / output type! ***
addFunToUnsafe :: forall m a b ins out. (ApplyVariadic m a b, Typeable a, Typeable b) => a -> Registry ins out -> Registry ins out
addFunToUnsafe :: forall (m :: * -> *) a b (ins :: [*]) (out :: [*]).
(ApplyVariadic m a b, Typeable a, Typeable b) =>
a -> Registry ins out -> Registry ins out
addFunToUnsafe = forall {k} (a :: k) (ins :: [*]) (out :: [*]).
Typeable a =>
Typed a -> Registry ins out -> Registry ins out
addToRegistryUnsafe @b forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
(ApplyVariadic m a b, Typeable a, Typeable b) =>
a -> Typed b
funTo @m

-- | Add an element to the registry without changing its type, in the State monad
addFunS :: (Typeable a, IsSubset (Inputs a) out a, MonadState (Registry ins out) m) => a -> m ()
addFunS :: forall a (out :: [*]) (ins :: [*]) (m :: * -> *).
(Typeable a, IsSubset (Inputs a) out a,
 MonadState (Registry ins out) m) =>
a -> m ()
addFunS = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (out :: [*]) (ins :: [*]).
(Typeable a, IsSubset (Inputs a) out a) =>
a -> Registry ins out -> Registry ins out
addFun

-- | Add an element to the registry without changing its type, in the State monad
--   *** This possibly adds untracked input types / output type! ***
addFunUnsafeS :: (Typeable a, MonadState (Registry ins out) m) => a -> m ()
addFunUnsafeS :: forall a (ins :: [*]) (out :: [*]) (m :: * -> *).
(Typeable a, MonadState (Registry ins out) m) =>
a -> m ()
addFunUnsafeS = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (ins :: [*]) (out :: [*]).
Typeable a =>
a -> Registry ins out -> Registry ins out
addFunUnsafe

-- | Add an element to the registry without changing its type, in the State monad
addToS :: forall n a b m ins out. (ApplyVariadic n a b, Typeable a, Typeable b, Typeable a, IsSubset (Inputs b) out b, MonadState (Registry ins out) m) => a -> m ()
addToS :: forall (n :: * -> *) a b (m :: * -> *) (ins :: [*]) (out :: [*]).
(ApplyVariadic n a b, Typeable a, Typeable b, Typeable a,
 IsSubset (Inputs b) out b, MonadState (Registry ins out) m) =>
a -> m ()
addToS = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b (ins :: [*]) (out :: [*]).
(ApplyVariadic m a b, Typeable a, Typeable b,
 IsSubset (Inputs b) out b) =>
a -> Registry ins out -> Registry ins out
addFunTo @n @a @b

-- | Add an element to the registry without changing its type, in the State monad
--   *** This possibly adds untracked input types / output type! ***
addToUnsafeS :: forall n a b m ins out. (ApplyVariadic n a b, Typeable a, Typeable b, Typeable a, MonadState (Registry ins out) m) => a -> m ()
addToUnsafeS :: forall (n :: * -> *) a b (m :: * -> *) (ins :: [*]) (out :: [*]).
(ApplyVariadic n a b, Typeable a, Typeable b, Typeable a,
 MonadState (Registry ins out) m) =>
a -> m ()
addToUnsafeS = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b (ins :: [*]) (out :: [*]).
(ApplyVariadic m a b, Typeable a, Typeable b) =>
a -> Registry ins out -> Registry ins out
addFunToUnsafe @n @a @b

-- | Add an element to the registry without changing its type
addFun :: (Typeable a, IsSubset (Inputs a) out a) => a -> Registry ins out -> Registry ins out
addFun :: forall a (out :: [*]) (ins :: [*]).
(Typeable a, IsSubset (Inputs a) out a) =>
a -> Registry ins out -> Registry ins out
addFun = forall a (out :: [*]) (ins :: [*]).
(Typeable a, IsSubset (Inputs a) out a) =>
Typed a -> Registry ins out -> Registry ins out
addToRegistry forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Typeable a => a -> Typed a
fun

-- | Add an element to the registry without changing its type
--   *** This possibly adds untracked input types / output type! ***
addFunUnsafe :: (Typeable a) => a -> Registry ins out -> Registry ins out
addFunUnsafe :: forall a (ins :: [*]) (out :: [*]).
Typeable a =>
a -> Registry ins out -> Registry ins out
addFunUnsafe = forall {k} (a :: k) (ins :: [*]) (out :: [*]).
Typeable a =>
Typed a -> Registry ins out -> Registry ins out
addToRegistryUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Typeable a => a -> Typed a
fun

-- | Register modifications of elements which types are already in the registry
addToRegistry :: (Typeable a, IsSubset (Inputs a) out a) => Typed a -> Registry ins out -> Registry ins out
addToRegistry :: forall a (out :: [*]) (ins :: [*]).
(Typeable a, IsSubset (Inputs a) out a) =>
Typed a -> Registry ins out -> Registry ins out
addToRegistry (TypedValue Value
v) (Registry Values
values Functions
functions Specializations
specializations Modifiers
modifiers) =
  forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry (Value -> Values -> Values
addValue Value
v Values
values) Functions
functions Specializations
specializations Modifiers
modifiers
addToRegistry (TypedFunction Function
f) (Registry Values
values Functions
functions Specializations
specializations Modifiers
modifiers) =
  forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry Values
values (Function -> Functions -> Functions
addFunction Function
f Functions
functions) Specializations
specializations Modifiers
modifiers

-- | Concatenate a registry to another statefully (to be used with $(makeGenerators ''MyType))
concatUnsafeS :: (MonadState (Registry ins out) m) => Registry ins' out' -> m ()
concatUnsafeS :: forall (ins :: [*]) (out :: [*]) (m :: * -> *) (ins' :: [*])
       (out' :: [*]).
MonadState (Registry ins out) m =>
Registry ins' out' -> m ()
concatUnsafeS Registry ins' out'
r = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall (ins :: [*]) (out :: [*]) (ins' :: [*]) (out' :: [*]).
Registry ins out -> Registry ins' out' -> Registry ins' out'
concatRegistryUnsafe Registry ins' out'
r)

-- | Register modifications of the registry without changing its type
addToRegistryUnsafe :: (Typeable a) => Typed a -> Registry ins out -> Registry ins out
addToRegistryUnsafe :: forall {k} (a :: k) (ins :: [*]) (out :: [*]).
Typeable a =>
Typed a -> Registry ins out -> Registry ins out
addToRegistryUnsafe (TypedValue Value
v) (Registry Values
values Functions
functions Specializations
specializations Modifiers
modifiers) =
  forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry (Value -> Values -> Values
addValue Value
v Values
values) Functions
functions Specializations
specializations Modifiers
modifiers
addToRegistryUnsafe (TypedFunction Function
f) (Registry Values
values Functions
functions Specializations
specializations Modifiers
modifiers) =
  forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry Values
values (Function -> Functions -> Functions
addFunction Function
f Functions
functions) Specializations
specializations Modifiers
modifiers

-- | Concatenate 2 registries
concatRegistryUnsafe :: Registry ins out -> Registry ins' out' -> Registry ins' out'
concatRegistryUnsafe :: forall (ins :: [*]) (out :: [*]) (ins' :: [*]) (out' :: [*]).
Registry ins out -> Registry ins' out' -> Registry ins' out'
concatRegistryUnsafe
  (Registry Values
vs1 Functions
fs1 Specializations
ss1 Modifiers
ms1)
  (Registry Values
vs2 Functions
fs2 Specializations
ss2 Modifiers
ms2) = forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry (Values
vs1 forall a. Semigroup a => a -> a -> a
<> Values
vs2) (Functions
fs1 forall a. Semigroup a => a -> a -> a
<> Functions
fs2) (Specializations
ss1 forall a. Semigroup a => a -> a -> a
<> Specializations
ss2) (Modifiers
ms1 forall a. Semigroup a => a -> a -> a
<> Modifiers
ms2)