{-# LANGUAGE AllowAmbiguousTypes #-}

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 :: Registry ins out -> m (StateT (Registry ins out) n) a -> m n a
runS Registry ins out
r = (forall a. StateT (Registry ins out) n a -> n a)
-> m (StateT (Registry ins out) n) a -> m n a
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 (StateT (Registry ins out) n a -> Registry ins out -> n a
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 :: a -> Registry ins out -> Registry ins out
addFunTo = forall (out :: [*]) (ins :: [*]).
(Typeable b, IsSubset (Inputs b) out b) =>
Typed b -> Registry ins out -> Registry ins out
forall a (out :: [*]) (ins :: [*]).
(Typeable a, IsSubset (Inputs a) out a) =>
Typed a -> Registry ins out -> Registry ins out
addToRegistry @b (Typed b -> Registry ins out -> Registry ins out)
-> (a -> Typed b) -> a -> Registry ins out -> Registry ins out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
(ApplyVariadic m a b, Typeable a, Typeable b) =>
a -> Typed b
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 :: a -> Registry ins out -> Registry ins out
addFunToUnsafe = forall (ins :: [*]) (out :: [*]).
Typeable b =>
Typed b -> Registry ins out -> Registry ins out
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Typed a -> Registry ins out -> Registry ins out
addToRegistryUnsafe @b (Typed b -> Registry ins out -> Registry ins out)
-> (a -> Typed b) -> a -> Registry ins out -> Registry ins out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
(ApplyVariadic m a b, Typeable a, Typeable b) =>
a -> Typed b
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 :: a -> m ()
addFunS = (Registry ins out -> Registry ins out) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Registry ins out -> Registry ins out) -> m ())
-> (a -> Registry ins out -> Registry ins out) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Registry ins out -> Registry ins out
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 :: a -> m ()
addFunUnsafeS = (Registry ins out -> Registry ins out) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Registry ins out -> Registry ins out) -> m ())
-> (a -> Registry ins out -> Registry ins out) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Registry ins out -> Registry ins out
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 :: a -> m ()
addToS = (Registry ins out -> Registry ins out) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Registry ins out -> Registry ins out) -> m ())
-> (a -> Registry ins out -> Registry ins out) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (ins :: [*]) (out :: [*]).
(ApplyVariadic n a b, Typeable a, Typeable b,
 IsSubset (Inputs b) out b) =>
a -> Registry ins out -> Registry ins out
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 :: a -> m ()
addToUnsafeS = (Registry ins out -> Registry ins out) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Registry ins out -> Registry ins out) -> m ())
-> (a -> Registry ins out -> Registry ins out) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (ins :: [*]) (out :: [*]).
(ApplyVariadic n a b, Typeable a, Typeable b) =>
a -> Registry ins out -> Registry ins out
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 :: a -> Registry ins out -> Registry ins out
addFun = Typed a -> Registry ins out -> Registry ins out
forall a (out :: [*]) (ins :: [*]).
(Typeable a, IsSubset (Inputs a) out a) =>
Typed a -> Registry ins out -> Registry ins out
addToRegistry (Typed a -> Registry ins out -> Registry ins out)
-> (a -> Typed a) -> a -> Registry ins out -> Registry ins out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Typed a
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 :: a -> Registry ins out -> Registry ins out
addFunUnsafe = Typed a -> Registry ins out -> Registry ins out
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Typed a -> Registry ins out -> Registry ins out
addToRegistryUnsafe (Typed a -> Registry ins out -> Registry ins out)
-> (a -> Typed a) -> a -> Registry ins out -> Registry ins out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Typed a
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 :: Typed a -> Registry ins out -> Registry ins out
addToRegistry (TypedValue Value
v) (Registry (Values [Value]
vs) Functions
functions Specializations
specializations Modifiers
modifiers) =
  Values
-> Functions -> Specializations -> Modifiers -> Registry ins out
forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry ([Value] -> Values
Values (Value
v Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
vs)) Functions
functions Specializations
specializations Modifiers
modifiers
addToRegistry (TypedFunction Function
f) (Registry (Values [Value]
vs) (Functions [Function]
fs) Specializations
specializations Modifiers
modifiers) =
  Values
-> Functions -> Specializations -> Modifiers -> Registry ins out
forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry ([Value] -> Values
Values [Value]
vs) ([Function] -> Functions
Functions (Function
f Function -> [Function] -> [Function]
forall a. a -> [a] -> [a]
: [Function]
fs)) 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 :: Registry ins' out' -> m ()
concatUnsafeS Registry ins' out'
r = (Registry ins out -> Registry ins out) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Registry ins' out' -> Registry ins out -> Registry ins out
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 :: Typed a -> Registry ins out -> Registry ins out
addToRegistryUnsafe (TypedValue Value
v) (Registry (Values [Value]
vs) Functions
functions Specializations
specializations Modifiers
modifiers) =
  Values
-> Functions -> Specializations -> Modifiers -> Registry ins out
forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry ([Value] -> Values
Values (Value
v Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
vs)) Functions
functions Specializations
specializations Modifiers
modifiers
addToRegistryUnsafe (TypedFunction Function
f) (Registry (Values [Value]
vs) (Functions [Function]
fs) Specializations
specializations Modifiers
modifiers) =
  Values
-> Functions -> Specializations -> Modifiers -> Registry ins out
forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry ([Value] -> Values
Values [Value]
vs) ([Function] -> Functions
Functions (Function
f Function -> [Function] -> [Function]
forall a. a -> [a] -> [a]
: [Function]
fs)) Specializations
specializations Modifiers
modifiers

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