{-# LANGUAGE AllowAmbiguousTypes #-}

{- |
  Utility functions to work with 'Dynamic' values
-}
module Data.Registry.Internal.Dynamic where

import           Data.Dynamic
import           Data.Registry.Internal.Types
import           Data.Text
import           Protolude as P
import           Type.Reflection

-- | Apply a function to a list of 'Dynamic' values
applyFunction ::
     Function           -- ^ function
  -> [Value]            -- ^ inputs
  -> Either Text Value  -- ^ result
applyFunction :: Function -> [Value] -> Either Text Value
applyFunction Function
function [] =
  if [SomeTypeRep] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null (Function -> [SomeTypeRep]
collectInputTypes Function
function) then
    Value -> Either Text Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either Text Value) -> Value -> Either Text Value
forall a b. (a -> b) -> a -> b
$ Dynamic -> ValueDescription -> Dependencies -> Value
makeCreatedValue (Function -> Dynamic
funDyn Function
function) (Text -> Maybe Text -> ValueDescription
ValueDescription (FunctionDescription -> Text
_outputType (FunctionDescription -> Text)
-> (Function -> FunctionDescription) -> Function -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> FunctionDescription
funDescription (Function -> Text) -> Function -> Text
forall a b. (a -> b) -> a -> b
$ Function
function) Maybe Text
forall a. Maybe a
Nothing) Dependencies
forall a. Monoid a => a
mempty
  else
    Text -> Either Text Value
forall a b. a -> Either a b
Left (Text -> Either Text Value) -> Text -> Either Text Value
forall a b. (a -> b) -> a -> b
$  Text
"the function "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SomeTypeRep -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Dynamic -> SomeTypeRep
dynTypeRep (Function -> Dynamic
funDyn Function
function))
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" cannot be applied to an empty list of parameters"

applyFunction Function
function [Value]
values =
  do Dynamic
created <- Dynamic -> [Dynamic] -> Either Text Dynamic
applyFunctionDyn (Function -> Dynamic
funDyn Function
function) (Value -> Dynamic
valueDyn (Value -> Dynamic) -> [Value] -> [Dynamic]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value]
values)
     let description :: ValueDescription
description  = Text -> Maybe Text -> ValueDescription
ValueDescription (FunctionDescription -> Text
_outputType (FunctionDescription -> Text)
-> (Function -> FunctionDescription) -> Function -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> FunctionDescription
funDescription (Function -> Text) -> Function -> Text
forall a b. (a -> b) -> a -> b
$ Function
function) Maybe Text
forall a. Maybe a
Nothing
     let dependencies :: Dependencies
dependencies = (Value -> Dependencies) -> [Value] -> Dependencies
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Value -> Dependencies
dependenciesOn [Value]
values

     Value -> Either Text Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either Text Value) -> Value -> Either Text Value
forall a b. (a -> b) -> a -> b
$ Dynamic -> ValueDescription -> Dependencies -> Value
makeCreatedValue Dynamic
created ValueDescription
description Dependencies
dependencies

-- | Apply a function modifying a single value and keeping its type
--   to be used with Modifiers
applyModification ::
     Function           -- ^ function
  -> Value              -- ^ inputs
  -> Either Text Value  -- ^ result
applyModification :: Function -> Value -> Either Text Value
applyModification Function
function Value
value =
  do Dynamic
created <- Dynamic -> [Dynamic] -> Either Text Dynamic
applyFunctionDyn (Function -> Dynamic
funDyn Function
function) [Value -> Dynamic
valueDyn Value
value]
     let description :: ValueDescription
description  = Text -> Maybe Text -> ValueDescription
ValueDescription (FunctionDescription -> Text
_outputType (FunctionDescription -> Text)
-> (Function -> FunctionDescription) -> Function -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> FunctionDescription
funDescription (Function -> Text) -> Function -> Text
forall a b. (a -> b) -> a -> b
$ Function
function) Maybe Text
forall a. Maybe a
Nothing
     Value -> Either Text Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either Text Value) -> Value -> Either Text Value
forall a b. (a -> b) -> a -> b
$ Dynamic
-> ValueDescription
-> Maybe Context
-> Maybe Specialization
-> Dependencies
-> Value
CreatedValue Dynamic
created ValueDescription
description (Value -> Maybe Context
specializationContext Value
value) (Value -> Maybe Specialization
usedSpecialization  Value
value) (Value -> Dependencies
valDependencies Value
value)

-- | Apply a Dynamic function to a list of Dynamic values
applyFunctionDyn ::
     Dynamic             -- ^ function
  -> [Dynamic]           -- ^ inputs
  -> Either Text Dynamic -- ^ result
applyFunctionDyn :: Dynamic -> [Dynamic] -> Either Text Dynamic
applyFunctionDyn Dynamic
f [] =
  Text -> Either Text Dynamic
forall a b. a -> Either a b
Left (Text -> Either Text Dynamic) -> Text -> Either Text Dynamic
forall a b. (a -> b) -> a -> b
$  Text
"the function "
         Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SomeTypeRep -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Dynamic -> SomeTypeRep
dynTypeRep Dynamic
f)
         Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" cannot be applied to an empty list of parameters"
applyFunctionDyn Dynamic
f [Dynamic
i     ] = Dynamic -> Dynamic -> Either Text Dynamic
applyOneParam Dynamic
f Dynamic
i
applyFunctionDyn Dynamic
f (Dynamic
i : [Dynamic]
is) = do
  Dynamic
f' <- Dynamic -> Dynamic -> Either Text Dynamic
applyOneParam Dynamic
f Dynamic
i
  Dynamic -> [Dynamic] -> Either Text Dynamic
applyFunctionDyn Dynamic
f' [Dynamic]
is

-- | Apply just one dynamic parameter to a dynamic function
applyOneParam :: Dynamic -> Dynamic -> Either Text Dynamic
applyOneParam :: Dynamic -> Dynamic -> Either Text Dynamic
applyOneParam Dynamic
f Dynamic
i =
  Either Text Dynamic
-> (Dynamic -> Either Text Dynamic)
-> Maybe Dynamic
-> Either Text Dynamic
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text Dynamic
forall a b. a -> Either a b
Left (Text -> Either Text Dynamic) -> Text -> Either Text Dynamic
forall a b. (a -> b) -> a -> b
$ Text
"failed to apply " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Dynamic -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Dynamic
i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to : " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Dynamic -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Dynamic
f) Dynamic -> Either Text Dynamic
forall a b. b -> Either a b
Right (Dynamic -> Dynamic -> Maybe Dynamic
dynApply Dynamic
f Dynamic
i)

-- | If Dynamic is a function collect all its input types
collectInputTypes :: Function -> [SomeTypeRep]
collectInputTypes :: Function -> [SomeTypeRep]
collectInputTypes = SomeTypeRep -> [SomeTypeRep]
go (SomeTypeRep -> [SomeTypeRep])
-> (Function -> SomeTypeRep) -> Function -> [SomeTypeRep]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> SomeTypeRep
funDynTypeRep
 where
  go :: SomeTypeRep -> [SomeTypeRep]
  go :: SomeTypeRep -> [SomeTypeRep]
go (SomeTypeRep (Fun TypeRep arg
in1 TypeRep res
out)) = TypeRep arg -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep TypeRep arg
in1 SomeTypeRep -> [SomeTypeRep] -> [SomeTypeRep]
forall a. a -> [a] -> [a]
: SomeTypeRep -> [SomeTypeRep]
go (TypeRep res -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep TypeRep res
out)
  go SomeTypeRep
_                           = []

-- | If the input type is a function type return its output type
outputType :: SomeTypeRep -> SomeTypeRep
outputType :: SomeTypeRep -> SomeTypeRep
outputType (SomeTypeRep (Fun TypeRep arg
_ TypeRep res
out)) = SomeTypeRep -> SomeTypeRep
outputType (TypeRep res -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep TypeRep res
out)
outputType SomeTypeRep
r                         = SomeTypeRep
r