{-# LANGUAGE AllowAmbiguousTypes #-}
module Data.Registry.Internal.Dynamic where
import Data.Dynamic
import Data.Registry.Internal.Types
import Data.Text
import Protolude as P
import Type.Reflection
applyFunction ::
Function
-> [Value]
-> Either Text Value
applyFunction function [] =
if P.null (collectInputTypes function) then
pure $ makeCreatedValue (funDyn function) (ValueDescription (_outputType . funDescription $ function) Nothing) mempty
else
Left $ "the function "
<> show (dynTypeRep (funDyn function))
<> " cannot be applied to an empty list of parameters"
applyFunction function values =
do created <- applyFunctionDyn (funDyn function) (valueDyn <$> values)
let description = ValueDescription (_outputType . funDescription $ function) Nothing
let dependencies = foldMap dependenciesOn values
pure $ makeCreatedValue created description dependencies
applyModification ::
Function
-> Value
-> Either Text Value
applyModification function value =
do created <- applyFunctionDyn (funDyn function) [valueDyn value]
let description = ValueDescription (_outputType . funDescription $ function) Nothing
pure $ CreatedValue created description (specializationContext value) (usedSpecialization value) (valDependencies value)
applyFunctionDyn ::
Dynamic
-> [Dynamic]
-> Either Text Dynamic
applyFunctionDyn f [] =
Left $ "the function "
<> show (dynTypeRep f)
<> " cannot be applied to an empty list of parameters"
applyFunctionDyn f [i ] = applyOneParam f i
applyFunctionDyn f (i : is) = do
f' <- applyOneParam f i
applyFunctionDyn f' is
applyOneParam :: Dynamic -> Dynamic -> Either Text Dynamic
applyOneParam f i =
maybe (Left $ "failed to apply " <> show i <> " to : " <> show f) Right (dynApply f i)
collectInputTypes :: Function -> [SomeTypeRep]
collectInputTypes = go . funDynTypeRep
where
go :: SomeTypeRep -> [SomeTypeRep]
go (SomeTypeRep (Fun in1 out)) = SomeTypeRep in1 : go (SomeTypeRep out)
go _ = []
outputType :: SomeTypeRep -> SomeTypeRep
outputType (SomeTypeRep (Fun _ out)) = outputType (SomeTypeRep out)
outputType r = r