{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Registry.Registry where
import Data.Dynamic
import Data.Registry.Internal.Cache
import Data.Registry.Internal.Types
import Data.Registry.Lift
import Data.Registry.Solver
import Data.Semigroup ((<>))
import Protolude as P hiding ((<>))
import Type.Reflection
import qualified Prelude (show)
data Registry (inputs :: [Type]) (outputs :: [Type]) = Registry
{ forall (inputs :: [*]) (outputs :: [*]).
Registry inputs outputs -> Values
_values :: Values,
forall (inputs :: [*]) (outputs :: [*]).
Registry inputs outputs -> Functions
_functions :: Functions,
forall (inputs :: [*]) (outputs :: [*]).
Registry inputs outputs -> Specializations
_specializations :: Specializations,
forall (inputs :: [*]) (outputs :: [*]).
Registry inputs outputs -> Modifiers
_modifiers :: Modifiers
}
instance Show (Registry inputs outputs) where
show :: Registry inputs outputs -> String
show (Registry Values
vs Functions
fs ss :: Specializations
ss@(Specializations [Specialization]
ss') ms :: Modifiers
ms@(Modifiers [(SomeTypeRep, ModifierFunction)]
ms')) =
forall a b. ConvertText a b => a -> b
toS forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
unlines forall a b. (a -> b) -> a -> b
$
[ Text
"Values\n",
Values -> Text
describeValues Values
vs,
Text
"Constructors\n",
Functions -> Text
describeFunctions Functions
fs
]
forall a. Semigroup a => a -> a -> a
<> ( if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Specialization]
ss')
then
[ Text
"Specializations\n",
Specializations -> Text
describeSpecializations Specializations
ss
]
else []
)
forall a. Semigroup a => a -> a -> a
<> ( if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(SomeTypeRep, ModifierFunction)]
ms')
then
[ Text
"Modifiers\n",
Modifiers -> Text
describeModifiers Modifiers
ms
]
else []
)
instance Semigroup (Registry inputs outputs) where
<> :: Registry inputs outputs
-> Registry inputs outputs -> Registry inputs outputs
(<>)
(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)) =
forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry ([Value] -> Values
Values ([Value]
vs1 forall a. Semigroup a => a -> a -> a
<> [Value]
vs2)) ([Function] -> Functions
Functions ([Function]
fs1 forall a. Semigroup a => a -> a -> a
<> [Function]
fs2)) ([Specialization] -> Specializations
Specializations ([Specialization]
ss1 forall a. Semigroup a => a -> a -> a
<> [Specialization]
ss2)) ([(SomeTypeRep, ModifierFunction)] -> Modifiers
Modifiers ([(SomeTypeRep, ModifierFunction)]
ms1 forall a. Semigroup a => a -> a -> a
<> [(SomeTypeRep, ModifierFunction)]
ms2))
instance Semigroup (Registry inputs outputs) => Monoid (Registry inputs outputs) where
mempty :: Registry inputs outputs
mempty = forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry ([Value] -> Values
Values []) ([Function] -> Functions
Functions []) ([Specialization] -> Specializations
Specializations []) ([(SomeTypeRep, ModifierFunction)] -> Modifiers
Modifiers [])
mappend :: Registry inputs outputs
-> Registry inputs outputs -> Registry inputs outputs
mappend = forall a. Semigroup a => a -> a -> a
(<>)
infixr 4 <+>
(<+>) :: Registry is1 os1 -> Registry is2 os2 -> Registry (is1 :++ is2) (os1 :++ os2)
<+> :: forall (is1 :: [*]) (os1 :: [*]) (is2 :: [*]) (os2 :: [*]).
Registry is1 os1
-> Registry is2 os2 -> Registry (is1 :++ is2) (os1 :++ os2)
(<+>)
(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)) =
forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry ([Value] -> Values
Values ([Value]
vs1 forall a. Semigroup a => a -> a -> a
<> [Value]
vs2)) ([Function] -> Functions
Functions ([Function]
fs1 forall a. Semigroup a => a -> a -> a
<> [Function]
fs2)) ([Specialization] -> Specializations
Specializations ([Specialization]
ss1 forall a. Semigroup a => a -> a -> a
<> [Specialization]
ss2)) ([(SomeTypeRep, ModifierFunction)] -> Modifiers
Modifiers ([(SomeTypeRep, ModifierFunction)]
ms1 forall a. Semigroup a => a -> a -> a
<> [(SomeTypeRep, ModifierFunction)]
ms2))
register :: (Typeable a, IsSubset (Inputs a) out a) => Typed a -> Registry ins out -> Registry (Inputs a :++ ins) (Output a ': out)
register :: forall a (out :: [*]) (ins :: [*]).
(Typeable a, IsSubset (Inputs a) out a) =>
Typed a
-> Registry ins out -> Registry (Inputs a :++ ins) (Output a : out)
register = forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Typed a
-> Registry ins out -> Registry (Inputs a :++ ins) (Output a : out)
registerUnchecked
registerUnchecked :: (Typeable a) => Typed a -> Registry ins out -> Registry (Inputs a :++ ins) (Output a ': out)
registerUnchecked :: forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Typed a
-> Registry ins out -> Registry (Inputs a :++ ins) (Output a : out)
registerUnchecked (TypedValue Value
v) (Registry (Values [Value]
vs) Functions
functions Specializations
specializations Modifiers
modifiers) =
forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry ([Value] -> Values
Values (Value
v forall a. a -> [a] -> [a]
: [Value]
vs)) Functions
functions Specializations
specializations Modifiers
modifiers
registerUnchecked (TypedFunction Function
f) (Registry (Values [Value]
vs) (Functions [Function]
fs) Specializations
specializations Modifiers
modifiers) =
forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry ([Value] -> Values
Values [Value]
vs) ([Function] -> Functions
Functions (Function
f forall a. a -> [a] -> [a]
: [Function]
fs)) Specializations
specializations Modifiers
modifiers
appendUnchecked :: (Typeable a) => Registry ins out -> Typed a -> Registry (ins :++ Inputs a) (out :++ '[Output a])
appendUnchecked :: forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Registry ins out
-> Typed a -> Registry (ins :++ Inputs a) (out :++ '[Output a])
appendUnchecked (Registry (Values [Value]
vs) Functions
functions Specializations
specializations Modifiers
modifiers) (TypedValue Value
v) =
forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry ([Value] -> Values
Values ([Value]
vs forall a. Semigroup a => a -> a -> a
<> [Value
v])) Functions
functions Specializations
specializations Modifiers
modifiers
appendUnchecked (Registry (Values [Value]
vs) (Functions [Function]
fs) Specializations
specializations Modifiers
modifiers) (TypedFunction Function
f) =
forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry ([Value] -> Values
Values [Value]
vs) ([Function] -> Functions
Functions ([Function]
fs forall a. Semigroup a => a -> a -> a
<> [Function
f])) Specializations
specializations Modifiers
modifiers
addTypedUnchecked :: (Typeable a, Typeable b, ins ~ (Inputs a :++ Inputs b), out ~ '[Output a, Output b]) => Typed a -> Typed b -> Registry ins out
addTypedUnchecked :: forall a b (ins :: [*]) (out :: [*]).
(Typeable a, Typeable b, ins ~ (Inputs a :++ Inputs b),
out ~ '[Output a, Output b]) =>
Typed a -> Typed b -> Registry ins out
addTypedUnchecked (TypedValue Value
v1) (TypedValue Value
v2) = forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry ([Value] -> Values
Values [Value
v1, Value
v2]) forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
addTypedUnchecked (TypedValue Value
v1) (TypedFunction Function
f2) = forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry ([Value] -> Values
Values [Value
v1]) ([Function] -> Functions
Functions [Function
f2]) forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
addTypedUnchecked (TypedFunction Function
f1) (TypedValue Value
v2) = forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry ([Value] -> Values
Values [Value
v2]) ([Function] -> Functions
Functions [Function
f1]) forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
addTypedUnchecked (TypedFunction Function
f1) (TypedFunction Function
f2) = forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry forall a. Monoid a => a
mempty ([Function] -> Functions
Functions [Function
f1, Function
f2]) forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
infixr 5 +:
(+:) :: (Typeable a) => Typed a -> Registry ins out -> Registry (Inputs a :++ ins) (Output a ': out)
+: :: forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Typed a
-> Registry ins out -> Registry (Inputs a :++ ins) (Output a : out)
(+:) = forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Typed a
-> Registry ins out -> Registry (Inputs a :++ ins) (Output a : out)
registerUnchecked
infixr 5 <:
class AddRegistryLike a b c | a b -> c where
(<:) :: a -> b -> c
instance (insr ~ (ins1 :++ ins2), outr ~ (out1 :++ out2), AreSubset ins1 outr out1) => AddRegistryLike (Registry ins1 out1) (Registry ins2 out2) (Registry insr outr) where
<: :: Registry ins1 out1 -> Registry ins2 out2 -> Registry insr outr
(<:) = forall (is1 :: [*]) (os1 :: [*]) (is2 :: [*]) (os2 :: [*]).
Registry is1 os1
-> Registry is2 os2 -> Registry (is1 :++ is2) (os1 :++ os2)
(<+>)
instance
(Typeable a, IsSubset (Inputs a) out2 a, insr ~ (Inputs a :++ ins2), outr ~ (Output a : out2)) =>
AddRegistryLike (Typed a) (Registry ins2 out2) (Registry insr outr)
where
<: :: Typed a -> Registry ins2 out2 -> Registry insr outr
(<:) = forall a (out :: [*]) (ins :: [*]).
(Typeable a, IsSubset (Inputs a) out a) =>
Typed a
-> Registry ins out -> Registry (Inputs a :++ ins) (Output a : out)
register
instance
(Typeable a, AreSubset ins2 outr out2, insr ~ (ins2 :++ Inputs a), outr ~ (out2 :++ '[Output a])) =>
AddRegistryLike (Registry ins2 out2) (Typed a) (Registry insr outr)
where
<: :: Registry ins2 out2 -> Typed a -> Registry insr outr
(<:) = forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Registry ins out
-> Typed a -> Registry (ins :++ Inputs a) (out :++ '[Output a])
appendUnchecked
instance
(Typeable a, IsSubset (Inputs a) '[Output b] a, Typeable b, insr ~ (Inputs a :++ Inputs b), outr ~ (Output a : '[Output b])) =>
AddRegistryLike (Typed a) (Typed b) (Registry insr outr)
where
<: :: Typed a -> Typed b -> Registry insr outr
(<:) = forall a b (ins :: [*]) (out :: [*]).
(Typeable a, Typeable b, ins ~ (Inputs a :++ Inputs b),
out ~ '[Output a, Output b]) =>
Typed a -> Typed b -> Registry ins out
addTypedUnchecked
infixr 5 <+
class AddRegistryUncheckedLike a b c | a b -> c where
(<+) :: a -> b -> c
instance (insr ~ (ins1 :++ ins2), outr ~ (out1 :++ out2)) => AddRegistryUncheckedLike (Registry ins1 out1) (Registry ins2 out2) (Registry insr outr) where
<+ :: Registry ins1 out1 -> Registry ins2 out2 -> Registry insr outr
(<+) = forall (is1 :: [*]) (os1 :: [*]) (is2 :: [*]) (os2 :: [*]).
Registry is1 os1
-> Registry is2 os2 -> Registry (is1 :++ is2) (os1 :++ os2)
(<+>)
instance
(Typeable a, insr ~ (Inputs a :++ ins2), outr ~ (Output a : out2)) =>
AddRegistryUncheckedLike (Typed a) (Registry ins2 out2) (Registry insr outr)
where
<+ :: Typed a -> Registry ins2 out2 -> Registry insr outr
(<+) = forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Typed a
-> Registry ins out -> Registry (Inputs a :++ ins) (Output a : out)
registerUnchecked
instance
(Typeable a, insr ~ (ins2 :++ Inputs a), outr ~ (out2 :++ '[Output a])) =>
AddRegistryUncheckedLike (Registry ins2 out2) (Typed a) (Registry insr outr)
where
<+ :: Registry ins2 out2 -> Typed a -> Registry insr outr
(<+) = forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Registry ins out
-> Typed a -> Registry (ins :++ Inputs a) (out :++ '[Output a])
appendUnchecked
instance
(Typeable a, Typeable b, insr ~ (Inputs a :++ Inputs b), outr ~ '[Output a, Output b]) =>
AddRegistryUncheckedLike (Typed a) (Typed b) (Registry insr outr)
where
<+ :: Typed a -> Typed b -> Registry insr outr
(<+) = forall a b (ins :: [*]) (out :: [*]).
(Typeable a, Typeable b, ins ~ (Inputs a :++ Inputs b),
out ~ '[Output a, Output b]) =>
Typed a -> Typed b -> Registry ins out
addTypedUnchecked
normalize :: Registry ins out -> Registry (Normalized ins) (Normalized out)
normalize :: forall (ins :: [*]) (out :: [*]).
Registry ins out -> Registry (Normalized ins) (Normalized out)
normalize (Registry Values
vs Functions
fs Specializations
ss Modifiers
ms) = forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry Values
vs Functions
fs Specializations
ss Modifiers
ms
eraseTypes :: Registry ins out -> Registry '[ERASED_TYPES] '[ERASED_TYPES]
eraseTypes :: forall (ins :: [*]) (out :: [*]).
Registry ins out -> Registry '[ERASED_TYPES] '[ERASED_TYPES]
eraseTypes (Registry Values
values Functions
functions Specializations
specializations Modifiers
modifiers) = forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry Values
values Functions
functions Specializations
specializations Modifiers
modifiers
data ERASED_TYPES
safeCoerce :: (IsSameSet out out1) => Registry ins out -> Registry ins1 out1
safeCoerce :: forall (out :: [*]) (out1 :: [*]) (ins :: [*]) (ins1 :: [*]).
IsSameSet out out1 =>
Registry ins out -> Registry ins1 out1
safeCoerce (Registry Values
a Functions
b Specializations
c Modifiers
d) = forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry Values
a Functions
b Specializations
c Modifiers
d
unsafeCoerce :: Registry ins out -> Registry ins1 out1
unsafeCoerce :: forall (ins :: [*]) (out :: [*]) (ins1 :: [*]) (out1 :: [*]).
Registry ins out -> Registry ins1 out1
unsafeCoerce (Registry Values
a Functions
b Specializations
c Modifiers
d) = forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry Values
a Functions
b Specializations
c Modifiers
d
end :: Registry '[] '[]
end :: Registry '[] '[]
end = forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
val :: (Typeable a, Show a) => a -> Typed a
val :: forall a. (Typeable a, Show a) => a -> Typed a
val a
a = forall {k} (a :: k). Value -> Typed a
TypedValue (Dynamic -> ValueDescription -> Value
ProvidedValue (forall a. Typeable a => a -> Dynamic
toDyn a
a) (forall a. (Typeable a, Show a) => a -> ValueDescription
describeValue a
a))
valTo :: forall m a. (Applicative m, Typeable a, Typeable (m a), Show a) => a -> Typed (m a)
valTo :: forall (m :: * -> *) a.
(Applicative m, Typeable a, Typeable (m a), Show a) =>
a -> Typed (m a)
valTo a
a = forall {k} (a :: k). Value -> Typed a
TypedValue (forall (m :: * -> *) a.
(Applicative m, Typeable a, Typeable (m a), Show a) =>
a -> Value
liftProvidedValue @m a
a)
liftProvidedValue :: forall m a. (Applicative m, Typeable a, Typeable (m a), Show a) => a -> Value
liftProvidedValue :: forall (m :: * -> *) a.
(Applicative m, Typeable a, Typeable (m a), Show a) =>
a -> Value
liftProvidedValue a
a = Dynamic -> ValueDescription -> Value
ProvidedValue (forall a. Typeable a => a -> Dynamic
toDyn (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a :: m a)) (forall a. (Typeable a, Show a) => a -> ValueDescription
describeValue a
a)
fun :: (Typeable a) => a -> Typed a
fun :: forall a. Typeable a => a -> Typed a
fun a
a = forall {k} (a :: k). Function -> Typed a
TypedFunction (forall f. Typeable f => f -> Function
createFunction a
a)
funTo :: forall m a b. (ApplyVariadic m a b, Typeable a, Typeable b) => a -> Typed b
funTo :: forall (m :: * -> *) a b.
(ApplyVariadic m a b, Typeable a, Typeable b) =>
a -> Typed b
funTo a
a = forall a. Typeable a => a -> Typed a
fun (forall (f :: * -> *) a b. ApplyVariadic f a b => a -> b
allTo @m a
a)
funAs :: forall m a b. (ApplyVariadic1 m a b, Typeable a, Typeable b) => a -> Typed b
funAs :: forall (m :: * -> *) a b.
(ApplyVariadic1 m a b, Typeable a, Typeable b) =>
a -> Typed b
funAs a
a = forall a. Typeable a => a -> Typed a
fun (forall (f :: * -> *) a b. ApplyVariadic1 f a b => a -> b
argsTo @m a
a)
specialize :: forall a b ins out. (Typeable a, Typeable b) => b -> Registry ins out -> Registry ins out
specialize :: forall {k} (a :: k) b (ins :: [*]) (out :: [*]).
(Typeable a, Typeable b) =>
b -> Registry ins out -> Registry ins out
specialize b
b (Registry Values
values Functions
functions (Specializations [Specialization]
c) Modifiers
modifiers) =
forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry
Values
values
Functions
functions
([Specialization] -> Specializations
Specializations (SpecializationPath -> Value -> Specialization
Specialization (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
someTypeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)) (forall a. Typeable a => a -> Value
createTypeableValue b
b) forall a. a -> [a] -> [a]
: [Specialization]
c))
Modifiers
modifiers
specializePath :: forall path b ins out. (PathToTypeReps path, Typeable b) => b -> Registry ins out -> Registry ins out
specializePath :: forall (path :: [*]) b (ins :: [*]) (out :: [*]).
(PathToTypeReps path, Typeable b) =>
b -> Registry ins out -> Registry ins out
specializePath b
b (Registry Values
values Functions
functions (Specializations [Specialization]
c) Modifiers
modifiers) =
forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry
Values
values
Functions
functions
([Specialization] -> Specializations
Specializations (SpecializationPath -> Value -> Specialization
Specialization (forall (path :: [*]).
PathToTypeReps path =>
Proxy path -> SpecializationPath
someTypeReps (forall {k} (t :: k). Proxy t
Proxy :: Proxy path)) (forall a. Typeable a => a -> Value
createTypeableValue b
b) forall a. a -> [a] -> [a]
: [Specialization]
c))
Modifiers
modifiers
specializeVal :: forall a b ins out. (Typeable a, Contains a out, Typeable b, Show b) => b -> Registry ins out -> Registry ins out
specializeVal :: forall a b (ins :: [*]) (out :: [*]).
(Typeable a, Contains a out, Typeable b, Show b) =>
b -> Registry ins out -> Registry ins out
specializeVal b
b (Registry Values
values Functions
functions (Specializations [Specialization]
c) Modifiers
modifiers) =
forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry
Values
values
Functions
functions
([Specialization] -> Specializations
Specializations (SpecializationPath -> Value -> Specialization
Specialization (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
someTypeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)) (forall a. (Typeable a, Show a) => a -> Value
createValue b
b) forall a. a -> [a] -> [a]
: [Specialization]
c))
Modifiers
modifiers
specializePathVal :: forall path b ins out. (PathToTypeReps path, Typeable b, Show b) => b -> Registry ins out -> Registry ins out
specializePathVal :: forall (path :: [*]) b (ins :: [*]) (out :: [*]).
(PathToTypeReps path, Typeable b, Show b) =>
b -> Registry ins out -> Registry ins out
specializePathVal b
b (Registry Values
values Functions
functions (Specializations [Specialization]
c) Modifiers
modifiers) =
forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry
Values
values
Functions
functions
([Specialization] -> Specializations
Specializations (SpecializationPath -> Value -> Specialization
Specialization (forall (path :: [*]).
PathToTypeReps path =>
Proxy path -> SpecializationPath
someTypeReps (forall {k} (t :: k). Proxy t
Proxy :: Proxy path)) (forall a. (Typeable a, Show a) => a -> Value
createValue b
b) forall a. a -> [a] -> [a]
: [Specialization]
c))
Modifiers
modifiers
specializeValTo :: forall m a b ins out. (Applicative m, Typeable a, Typeable (m b), Typeable b, Show b) => b -> Registry ins out -> Registry ins out
specializeValTo :: forall {k} (m :: * -> *) (a :: k) b (ins :: [*]) (out :: [*]).
(Applicative m, Typeable a, Typeable (m b), Typeable b, Show b) =>
b -> Registry ins out -> Registry ins out
specializeValTo b
b (Registry Values
values Functions
functions (Specializations [Specialization]
c) Modifiers
modifiers) =
forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry
Values
values
Functions
functions
([Specialization] -> Specializations
Specializations (SpecializationPath -> Value -> Specialization
Specialization (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
someTypeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)) (forall (m :: * -> *) a.
(Applicative m, Typeable a, Typeable (m a), Show a) =>
a -> Value
liftProvidedValue @m b
b) forall a. a -> [a] -> [a]
: [Specialization]
c))
Modifiers
modifiers
specializePathValTo :: forall m path b ins out. (Applicative m, PathToTypeReps path, Typeable (m b), Typeable b, Show b) => b -> Registry ins out -> Registry ins out
specializePathValTo :: forall (m :: * -> *) (path :: [*]) b (ins :: [*]) (out :: [*]).
(Applicative m, PathToTypeReps path, Typeable (m b), Typeable b,
Show b) =>
b -> Registry ins out -> Registry ins out
specializePathValTo b
b (Registry Values
values Functions
functions (Specializations [Specialization]
c) Modifiers
modifiers) =
forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry
Values
values
Functions
functions
([Specialization] -> Specializations
Specializations (SpecializationPath -> Value -> Specialization
Specialization (forall (path :: [*]).
PathToTypeReps path =>
Proxy path -> SpecializationPath
someTypeReps (forall {k} (t :: k). Proxy t
Proxy :: Proxy path)) (forall (m :: * -> *) a.
(Applicative m, Typeable a, Typeable (m a), Show a) =>
a -> Value
liftProvidedValue @m b
b) forall a. a -> [a] -> [a]
: [Specialization]
c))
Modifiers
modifiers
class PathToTypeReps (path :: [Type]) where
someTypeReps :: Proxy path -> NonEmpty SomeTypeRep
instance {-# OVERLAPPING #-} (Typeable a) => PathToTypeReps '[a] where
someTypeReps :: Proxy '[a] -> SpecializationPath
someTypeReps = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
someTypeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))
instance (Typeable a, PathToTypeReps rest) => PathToTypeReps (a : rest) where
someTypeReps :: Proxy (a : rest) -> SpecializationPath
someTypeReps = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
someTypeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) forall a. a -> [a] -> NonEmpty a
:| forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall (path :: [*]).
PathToTypeReps path =>
Proxy path -> SpecializationPath
someTypeReps (forall {k} (t :: k). Proxy t
Proxy :: Proxy rest))
tweak :: forall a ins out. (Typeable a) => (a -> a) -> Registry ins out -> Registry ins out
tweak :: forall a (ins :: [*]) (out :: [*]).
Typeable a =>
(a -> a) -> Registry ins out -> Registry ins out
tweak a -> a
f (Registry Values
values Functions
functions Specializations
specializations (Modifiers [(SomeTypeRep, ModifierFunction)]
mf)) =
forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry
Values
values
Functions
functions
Specializations
specializations
([(SomeTypeRep, ModifierFunction)] -> Modifiers
Modifiers ((forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
someTypeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy a), forall f. Typeable f => f -> ModifierFunction
createConstModifierFunction a -> a
f) forall a. a -> [a] -> [a]
: [(SomeTypeRep, ModifierFunction)]
mf))
memoize :: forall m a ins out. (MonadIO m, Typeable a, Typeable (m a)) => Registry ins out -> IO (Registry ins out)
memoize :: forall (m :: * -> *) a (ins :: [*]) (out :: [*]).
(MonadIO m, Typeable a, Typeable (m a)) =>
Registry ins out -> IO (Registry ins out)
memoize (Registry Values
values Functions
functions Specializations
specializations (Modifiers [(SomeTypeRep, ModifierFunction)]
mf)) = do
Cache a
cache <- forall a. IO (Cache a)
newCache @a
let modifiers :: Modifiers
modifiers = [(SomeTypeRep, ModifierFunction)] -> Modifiers
Modifiers ((forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
someTypeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy (m a)), forall f. Typeable f => f -> Function
createFunction forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *).
(MonadIO m, Typeable a) =>
Cache a -> Key -> m a -> m a
fetch @a @m Cache a
cache) forall a. a -> [a] -> [a]
: [(SomeTypeRep, ModifierFunction)]
mf)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (inputs :: [*]) (outputs :: [*]).
Values
-> Functions
-> Specializations
-> Modifiers
-> Registry inputs outputs
Registry Values
values Functions
functions Specializations
specializations Modifiers
modifiers
memoizeAll :: forall m ins out. (MonadIO m, MemoizedActions out) => Registry ins out -> IO (Registry ins out)
memoizeAll :: forall (m :: * -> *) (ins :: [*]) (out :: [*]).
(MonadIO m, MemoizedActions out) =>
Registry ins out -> IO (Registry ins out)
memoizeAll Registry ins out
r =
forall (todo :: [*]) (ins :: [*]) (out :: [*]).
MemoizeRegistry todo ins out -> Registry ins out
_unMemoizeRegistry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (ls :: [*]) (ins :: [*]) (out :: [*]).
MemoizedActions ls =>
MemoizeRegistry ls ins out -> IO (MemoizeRegistry '[] ins out)
memoizeActions (forall (ins :: [*]) (out :: [*]).
Registry ins out -> MemoizeRegistry out ins out
startMemoizeRegistry Registry ins out
r)
newtype MemoizeRegistry (todo :: [Type]) (ins :: [Type]) (out :: [Type]) = MemoizeRegistry {forall (todo :: [*]) (ins :: [*]) (out :: [*]).
MemoizeRegistry todo ins out -> Registry ins out
_unMemoizeRegistry :: Registry ins out}
startMemoizeRegistry :: Registry ins out -> MemoizeRegistry out ins out
startMemoizeRegistry :: forall (ins :: [*]) (out :: [*]).
Registry ins out -> MemoizeRegistry out ins out
startMemoizeRegistry = forall (todo :: [*]) (ins :: [*]) (out :: [*]).
Registry ins out -> MemoizeRegistry todo ins out
MemoizeRegistry
makeMemoizeRegistry :: forall todo ins out. Registry ins out -> MemoizeRegistry todo ins out
makeMemoizeRegistry :: forall (todo :: [*]) (ins :: [*]) (out :: [*]).
Registry ins out -> MemoizeRegistry todo ins out
makeMemoizeRegistry = forall (todo :: [*]) (ins :: [*]) (out :: [*]).
Registry ins out -> MemoizeRegistry todo ins out
MemoizeRegistry @todo
class MemoizedActions ls where
memoizeActions :: MemoizeRegistry ls ins out -> IO (MemoizeRegistry '[] ins out)
instance MemoizedActions '[] where
memoizeActions :: forall (ins :: [*]) (out :: [*]).
MemoizeRegistry '[] ins out -> IO (MemoizeRegistry '[] ins out)
memoizeActions = forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance {-# OVERLAPPING #-} (MonadIO m, Typeable a, Typeable (m a), MemoizedActions rest) => MemoizedActions (m a : rest) where
memoizeActions :: forall (ins :: [*]) (out :: [*]).
MemoizeRegistry (m a : rest) ins out
-> IO (MemoizeRegistry '[] ins out)
memoizeActions (MemoizeRegistry Registry ins out
r) = do
Registry ins out
r' <- forall (m :: * -> *) a (ins :: [*]) (out :: [*]).
(MonadIO m, Typeable a, Typeable (m a)) =>
Registry ins out -> IO (Registry ins out)
memoize @m @a Registry ins out
r
forall (ls :: [*]) (ins :: [*]) (out :: [*]).
MemoizedActions ls =>
MemoizeRegistry ls ins out -> IO (MemoizeRegistry '[] ins out)
memoizeActions (forall (todo :: [*]) (ins :: [*]) (out :: [*]).
Registry ins out -> MemoizeRegistry todo ins out
makeMemoizeRegistry @rest Registry ins out
r')
instance (MemoizedActions rest) => MemoizedActions (a : rest) where
memoizeActions :: forall (ins :: [*]) (out :: [*]).
MemoizeRegistry (a : rest) ins out
-> IO (MemoizeRegistry '[] ins out)
memoizeActions (MemoizeRegistry Registry ins out
r) =
forall (ls :: [*]) (ins :: [*]) (out :: [*]).
MemoizedActions ls =>
MemoizeRegistry ls ins out -> IO (MemoizeRegistry '[] ins out)
memoizeActions (forall (todo :: [*]) (ins :: [*]) (out :: [*]).
Registry ins out -> MemoizeRegistry todo ins out
makeMemoizeRegistry @rest Registry ins out
r)