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