{-# 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 ->
  -- | inputs
  [Value] ->
  -- | result
  Either Text Value
applyFunction :: Function -> [Value] -> Either Text Value
applyFunction Function
function [] =
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null (Function -> [SomeTypeRep]
collectInputTypes Function
function)
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> FunctionDescription
funDescription forall a b. (a -> b) -> a -> b
$ Function
function) forall a. Maybe a
Nothing) forall a. Monoid a => a
mempty
    else
      forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
        Text
"the function "
          forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show (Dynamic -> SomeTypeRep
dynTypeRep (Function -> Dynamic
funDyn Function
function))
          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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> FunctionDescription
funDescription forall a b. (a -> b) -> a -> b
$ Function
function) forall a. Maybe a
Nothing
    let dependencies :: Dependencies
dependencies = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Value -> Dependencies
dependenciesOf [Value]
values

    forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 ->
  -- | inputs
  Value ->
  -- | result
  Either Text Value
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> FunctionDescription
funDescription forall a b. (a -> b) -> a -> b
$ Function
function) forall a. Maybe a
Nothing
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Dynamic
-> ValueDescription
-> Maybe SpecializationContext
-> Dependencies
-> Value
CreatedValue Dynamic
created ValueDescription
description (Value -> Maybe SpecializationContext
valueSpecializationContext Value
value) (Value -> Dependencies
valueDependencies Value
value)

-- | Apply a Dynamic function to a list of Dynamic values
applyFunctionDyn ::
  -- | function
  Dynamic ->
  -- | inputs
  [Dynamic] ->
  -- | result
  Either Text Dynamic
applyFunctionDyn :: Dynamic -> [Dynamic] -> Either Text Dynamic
applyFunctionDyn Dynamic
f [] =
  forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
    Text
"the function "
      forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show (Dynamic -> SomeTypeRep
dynTypeRep Dynamic
f)
      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 =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"failed to apply " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show Dynamic
i forall a. Semigroup a => a -> a -> a
<> Text
" to : " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show Dynamic
f) 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 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)) = forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep TypeRep arg
in1 forall a. a -> [a] -> [a]
: SomeTypeRep -> [SomeTypeRep]
go (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 (forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep TypeRep res
out)
outputType SomeTypeRep
r = SomeTypeRep
r