{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Registry.Internal.Registry where
import Data.Registry.Internal.Dynamic
import Data.Registry.Internal.Types
import Data.Registry.Internal.Stack
import Protolude as P
import Type.Reflection
findValue
:: SomeTypeRep
-> Context
-> Specializations
-> Values
-> Maybe Value
findValue _ _ (Specializations []) (Values []) = Nothing
findValue target (Context context) (Specializations ((t, v) : rest)) values =
if target == valueDynTypeRep v && t `elem` context then
Just v
else
findValue target (Context context) (Specializations rest) values
findValue target context specializations (Values (v : rest)) =
if valueDynTypeRep v == target then
Just v
else
findValue target context specializations (Values rest)
findConstructor
:: SomeTypeRep
-> Functions
-> Maybe Function
findConstructor _ (Functions [] ) = Nothing
findConstructor target (Functions (f : rest)) =
case funDynTypeRep f of
SomeTypeRep (Fun _ out) ->
if outputType (SomeTypeRep out) == target then
Just f
else
findConstructor target (Functions rest)
SomeTypeRep out ->
if outputType (SomeTypeRep out) == target then
Just f
else
findConstructor target (Functions rest)
storeValue
:: Modifiers
-> Value
-> Stack Value
storeValue (Modifiers ms) value =
let modifiers = findModifiers ms
in do valueToStore <- modifyValue value modifiers
modifyValues (addValue valueToStore)
pure valueToStore
where
findModifiers = filter (\(m, _) -> valueDynTypeRep value == m)
modifyValue :: Value -> [(SomeTypeRep, Function)] -> Stack Value
modifyValue v [] = pure v
modifyValue v ((_, f) : rest) = do
applied <- lift $ applyFunction f [v]
modifyValue applied rest