{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- |
--  List of types used inside the Registry
module Data.Registry.Internal.Types where

import Data.Dynamic
import Data.Hashable
import Data.List (elemIndex, intersect)
import Data.List.NonEmpty
import Data.List.NonEmpty as NonEmpty (head, last)
import Data.Registry.Internal.Reflection
import qualified Data.Text as T hiding (last)
import Protolude as P hiding (show)
import qualified Protolude as P
import Type.Reflection
import Prelude (show)

-- | A 'Value' is the 'Dynamic' representation of a Haskell value + its description
--   It is either provided by the user of the Registry or created as part of the
--   resolution algorithm
--   If a `Context` is present for a a created value this means that this value
--   has been written as the result of a specialization. The first type of the
--   list of types in the context is the types under which the specialization must
--   apply and the other types are "parents" of the current value in the value
--   graph
data Value
  = CreatedValue Dynamic ValueDescription (Maybe Context) (Maybe Specialization) Dependencies
  | ProvidedValue Dynamic ValueDescription
  deriving (Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Show)

instance Eq Value where
  CreatedValue Dynamic
_ ValueDescription
vd1 Maybe Context
mc1 Maybe Specialization
ms1 Dependencies
ds1 == :: Value -> Value -> Bool
== CreatedValue Dynamic
_ ValueDescription
vd2 Maybe Context
mc2 Maybe Specialization
ms2 Dependencies
ds2 =
    (ValueDescription
vd1, Maybe Context
mc1, Maybe Specialization
ms1, Dependencies
ds1) (ValueDescription, Maybe Context, Maybe Specialization,
 Dependencies)
-> (ValueDescription, Maybe Context, Maybe Specialization,
    Dependencies)
-> Bool
forall a. Eq a => a -> a -> Bool
== (ValueDescription
vd2, Maybe Context
mc2, Maybe Specialization
ms2, Dependencies
ds2)
  ProvidedValue Dynamic
_ ValueDescription
vd1 == ProvidedValue Dynamic
_ ValueDescription
vd2 =
    ValueDescription
vd1 ValueDescription -> ValueDescription -> Bool
forall a. Eq a => a -> a -> Bool
== ValueDescription
vd2
  Value
_ == Value
_ = Bool
False

instance Hashable Value where
  hash :: Value -> Int
hash Value
value = ValueDescription -> Int
forall a. Hashable a => a -> Int
hash (Value -> ValueDescription
valDescription Value
value)
  hashWithSalt :: Int -> Value -> Int
hashWithSalt Int
n Value
value = Int -> ValueDescription -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
n (Value -> ValueDescription
valDescription Value
value)

-- | Description of a value. It might just have
--   a description for its type when it is a value
--   created by the resolution algorithm
data ValueDescription = ValueDescription
  { ValueDescription -> Text
_valueType :: Text,
    ValueDescription -> Maybe Text
_valueValue :: Maybe Text
  }
  deriving (ValueDescription -> ValueDescription -> Bool
(ValueDescription -> ValueDescription -> Bool)
-> (ValueDescription -> ValueDescription -> Bool)
-> Eq ValueDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValueDescription -> ValueDescription -> Bool
$c/= :: ValueDescription -> ValueDescription -> Bool
== :: ValueDescription -> ValueDescription -> Bool
$c== :: ValueDescription -> ValueDescription -> Bool
Eq, Int -> ValueDescription -> ShowS
[ValueDescription] -> ShowS
ValueDescription -> String
(Int -> ValueDescription -> ShowS)
-> (ValueDescription -> String)
-> ([ValueDescription] -> ShowS)
-> Show ValueDescription
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValueDescription] -> ShowS
$cshowList :: [ValueDescription] -> ShowS
show :: ValueDescription -> String
$cshow :: ValueDescription -> String
showsPrec :: Int -> ValueDescription -> ShowS
$cshowsPrec :: Int -> ValueDescription -> ShowS
Show)

instance Hashable ValueDescription where
  hash :: ValueDescription -> Int
hash (ValueDescription Text
d Maybe Text
v) = (Text, Maybe Text) -> Int
forall a. Hashable a => a -> Int
hash (Text
d, Maybe Text
v)
  hashWithSalt :: Int -> ValueDescription -> Int
hashWithSalt Int
n (ValueDescription Text
d Maybe Text
v) = Int -> (Text, Maybe Text) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
n (Text
d, Maybe Text
v)

-- | Describe a value with its type and actual content
describeValue :: (Typeable a, Show a) => a -> ValueDescription
describeValue :: a -> ValueDescription
describeValue a
a = Text -> Maybe Text -> ValueDescription
ValueDescription (a -> Text
forall a. Typeable a => a -> Text
showFullValueType a
a) (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (String -> Text) -> String -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertText a b => a -> b
toS (String -> Maybe Text) -> String -> Maybe Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
a)

-- | Describe a value with only its type
describeTypeableValue :: (Typeable a) => a -> ValueDescription
describeTypeableValue :: a -> ValueDescription
describeTypeableValue a
a = Text -> Maybe Text -> ValueDescription
ValueDescription (a -> Text
forall a. Typeable a => a -> Text
showFullValueType a
a) Maybe Text
forall a. Maybe a
Nothing

-- | Show a Value from the 'Registry'
showValue :: Value -> Text
showValue :: Value -> Text
showValue = ValueDescription -> Text
valDescriptionToText (ValueDescription -> Text)
-> (Value -> ValueDescription) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ValueDescription
valDescription

-- | Create a Value from a Haskell value, using its Show instance for its description
createValue :: (Typeable a, Show a) => a -> Value
createValue :: a -> Value
createValue a
a = Dynamic -> ValueDescription -> Value
makeProvidedValue (a -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn a
a) (a -> ValueDescription
forall a. (Typeable a, Show a) => a -> ValueDescription
describeValue a
a)

-- | Make a ProvidedValue
makeProvidedValue :: Dynamic -> ValueDescription -> Value
makeProvidedValue :: Dynamic -> ValueDescription -> Value
makeProvidedValue = Dynamic -> ValueDescription -> Value
ProvidedValue

-- | make a CreatedValue in no particular context
makeCreatedValue :: Dynamic -> ValueDescription -> Dependencies -> Value
makeCreatedValue :: Dynamic -> ValueDescription -> Dependencies -> Value
makeCreatedValue Dynamic
d ValueDescription
desc = Dynamic
-> ValueDescription
-> Maybe Context
-> Maybe Specialization
-> Dependencies
-> Value
CreatedValue Dynamic
d ValueDescription
desc Maybe Context
forall a. Maybe a
Nothing Maybe Specialization
forall a. Maybe a
Nothing

-- | Create a Value from a Haskell value, with only its 'Typeable' description
createTypeableValue :: Typeable a => a -> Value
createTypeableValue :: a -> Value
createTypeableValue a
a = Dynamic -> ValueDescription -> Value
ProvidedValue (a -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn a
a) (a -> ValueDescription
forall a. Typeable a => a -> ValueDescription
describeTypeableValue a
a)

-- | Create a Value from a 'Dynamic' value and some description
createDynValue :: Dynamic -> Text -> Value
createDynValue :: Dynamic -> Text -> Value
createDynValue Dynamic
dyn Text
desc = Dynamic -> ValueDescription -> Value
ProvidedValue Dynamic
dyn (Text -> Maybe Text -> ValueDescription
ValueDescription Text
desc Maybe Text
forall a. Maybe a
Nothing)

-- | Type representation of a 'Value'
valueDynTypeRep :: Value -> SomeTypeRep
valueDynTypeRep :: Value -> SomeTypeRep
valueDynTypeRep = Dynamic -> SomeTypeRep
dynTypeRep (Dynamic -> SomeTypeRep)
-> (Value -> Dynamic) -> Value -> SomeTypeRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Dynamic
valueDyn

-- | Dynamic representation of a 'Value'
valueDyn :: Value -> Dynamic
valueDyn :: Value -> Dynamic
valueDyn (CreatedValue Dynamic
d ValueDescription
_ Maybe Context
_ Maybe Specialization
_ Dependencies
_) = Dynamic
d
valueDyn (ProvidedValue Dynamic
d ValueDescription
_) = Dynamic
d

-- | The description for a 'Value'
valDescription :: Value -> ValueDescription
valDescription :: Value -> ValueDescription
valDescription (CreatedValue Dynamic
_ ValueDescription
d Maybe Context
_ Maybe Specialization
_ Dependencies
_) = ValueDescription
d
valDescription (ProvidedValue Dynamic
_ ValueDescription
d) = ValueDescription
d

-- | The dependencies for a 'Value'
valDependencies :: Value -> Dependencies
valDependencies :: Value -> Dependencies
valDependencies (CreatedValue Dynamic
_ ValueDescription
_ Maybe Context
_ Maybe Specialization
_ Dependencies
ds) = Dependencies
ds
valDependencies (ProvidedValue Dynamic
_ ValueDescription
_) = Dependencies
forall a. Monoid a => a
mempty

-- | A ValueDescription as 'Text'. If the actual content of the 'Value'
--   is provided display the type first then the content
valDescriptionToText :: ValueDescription -> Text
valDescriptionToText :: ValueDescription -> Text
valDescriptionToText (ValueDescription Text
t Maybe Text
Nothing) = Text
t
valDescriptionToText (ValueDescription Text
t (Just Text
v)) = Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v

-- | Return the creation context for a given value when it was created
--   as the result of a "specialization"
specializationContext :: Value -> Maybe Context
specializationContext :: Value -> Maybe Context
specializationContext (CreatedValue Dynamic
_ ValueDescription
_ Maybe Context
context Maybe Specialization
_ Dependencies
_) = Maybe Context
context
specializationContext Value
_ = Maybe Context
forall a. Maybe a
Nothing

-- | Return the specialization used to create a specific values
usedSpecialization :: Value -> Maybe Specialization
usedSpecialization :: Value -> Maybe Specialization
usedSpecialization (CreatedValue Dynamic
_ ValueDescription
_ Maybe Context
_ Maybe Specialization
specialization Dependencies
_) = Maybe Specialization
specialization
usedSpecialization Value
_ = Maybe Specialization
forall a. Maybe a
Nothing

-- | Return True if a type is part of the specialization context of a Value
isInSpecializationContext :: SomeTypeRep -> Value -> Bool
isInSpecializationContext :: SomeTypeRep -> Value -> Bool
isInSpecializationContext SomeTypeRep
target Value
value =
  case Value -> Maybe Context
specializationContext Value
value of
    Just Context
context -> SomeTypeRep
target SomeTypeRep -> [SomeTypeRep] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Context -> [SomeTypeRep]
contextTypes Context
context)
    Maybe Context
Nothing -> Bool
False

-- | Return True if a value has transitives dependencies which are
--   specialized values
hasSpecializedDependencies :: Specializations -> Value -> Bool
hasSpecializedDependencies :: Specializations -> Value -> Bool
hasSpecializedDependencies (Specializations [Specialization]
ss) Value
v =
  let DependenciesTypes [SomeTypeRep]
ds = Dependencies -> DependenciesTypes
dependenciesTypes (Dependencies -> DependenciesTypes)
-> Dependencies -> DependenciesTypes
forall a b. (a -> b) -> a -> b
$ Value -> Dependencies
valDependencies Value
v
      targetTypes :: [SomeTypeRep]
targetTypes = Specialization -> SomeTypeRep
specializationTargetType (Specialization -> SomeTypeRep)
-> [Specialization] -> [SomeTypeRep]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Specialization]
ss
   in Bool -> Bool
not (Bool -> Bool) -> ([SomeTypeRep] -> Bool) -> [SomeTypeRep] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SomeTypeRep] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null ([SomeTypeRep] -> Bool) -> [SomeTypeRep] -> Bool
forall a b. (a -> b) -> a -> b
$ [SomeTypeRep]
targetTypes [SomeTypeRep] -> [SomeTypeRep] -> [SomeTypeRep]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [SomeTypeRep]
ds

-- | A Function is the 'Dynamic' representation of a Haskell function + its description
data Function = Function Dynamic FunctionDescription deriving (Int -> Function -> ShowS
[Function] -> ShowS
Function -> String
(Int -> Function -> ShowS)
-> (Function -> String) -> ([Function] -> ShowS) -> Show Function
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Function] -> ShowS
$cshowList :: [Function] -> ShowS
show :: Function -> String
$cshow :: Function -> String
showsPrec :: Int -> Function -> ShowS
$cshowsPrec :: Int -> Function -> ShowS
Show)

-- | Create a 'Function' value from a Haskell function
createFunction :: (Typeable f) => f -> Function
createFunction :: f -> Function
createFunction f
f =
  let dynType :: Dynamic
dynType = f -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn f
f
   in Dynamic -> FunctionDescription -> Function
Function Dynamic
dynType (f -> FunctionDescription
forall a. Typeable a => a -> FunctionDescription
describeFunction f
f)

-- | Description of a 'Function' with input types and output type
data FunctionDescription = FunctionDescription
  { FunctionDescription -> [Text]
_inputTypes :: [Text],
    FunctionDescription -> Text
_outputType :: Text
  }
  deriving (FunctionDescription -> FunctionDescription -> Bool
(FunctionDescription -> FunctionDescription -> Bool)
-> (FunctionDescription -> FunctionDescription -> Bool)
-> Eq FunctionDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionDescription -> FunctionDescription -> Bool
$c/= :: FunctionDescription -> FunctionDescription -> Bool
== :: FunctionDescription -> FunctionDescription -> Bool
$c== :: FunctionDescription -> FunctionDescription -> Bool
Eq, Int -> FunctionDescription -> ShowS
[FunctionDescription] -> ShowS
FunctionDescription -> String
(Int -> FunctionDescription -> ShowS)
-> (FunctionDescription -> String)
-> ([FunctionDescription] -> ShowS)
-> Show FunctionDescription
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionDescription] -> ShowS
$cshowList :: [FunctionDescription] -> ShowS
show :: FunctionDescription -> String
$cshow :: FunctionDescription -> String
showsPrec :: Int -> FunctionDescription -> ShowS
$cshowsPrec :: Int -> FunctionDescription -> ShowS
Show)

-- | Describe a 'Function' (which doesn't have a 'Show' instance)
--   that can be put in the 'Registry'
describeFunction :: Typeable a => a -> FunctionDescription
describeFunction :: a -> FunctionDescription
describeFunction = ([Text] -> Text -> FunctionDescription)
-> ([Text], Text) -> FunctionDescription
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Text] -> Text -> FunctionDescription
FunctionDescription (([Text], Text) -> FunctionDescription)
-> (a -> ([Text], Text)) -> a -> FunctionDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ([Text], Text)
forall a. Typeable a => a -> ([Text], Text)
showFullFunctionType

-- | Show a Function as 'Text' using its Description
showFunction :: Function -> Text
showFunction :: Function -> Text
showFunction = FunctionDescription -> Text
funDescriptionToText (FunctionDescription -> Text)
-> (Function -> FunctionDescription) -> Function -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> FunctionDescription
funDescription

-- | The Description of a 'Function'
funDescription :: Function -> FunctionDescription
funDescription :: Function -> FunctionDescription
funDescription (Function Dynamic
_ FunctionDescription
t) = FunctionDescription
t

-- | Dynamic representation of a 'Function'
funDyn :: Function -> Dynamic
funDyn :: Function -> Dynamic
funDyn (Function Dynamic
d FunctionDescription
_) = Dynamic
d

-- | Type representation of a 'Function'
funDynTypeRep :: Function -> SomeTypeRep
funDynTypeRep :: Function -> SomeTypeRep
funDynTypeRep = Dynamic -> SomeTypeRep
dynTypeRep (Dynamic -> SomeTypeRep)
-> (Function -> Dynamic) -> Function -> SomeTypeRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> Dynamic
funDyn

-- | A 'FunctionDescription' as 'Text'
funDescriptionToText :: FunctionDescription -> Text
funDescriptionToText :: FunctionDescription -> Text
funDescriptionToText (FunctionDescription [Text]
ins Text
out) = Text -> [Text] -> Text
T.intercalate Text
" -> " ([Text]
ins [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
out])

-- | Return True if a 'Function' has some input parameters
hasParameters :: Function -> Bool
hasParameters :: Function -> Bool
hasParameters = SomeTypeRep -> Bool
isFunction (SomeTypeRep -> Bool)
-> (Function -> SomeTypeRep) -> Function -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> SomeTypeRep
funDynTypeRep

-- | A Typed value or function can be added to a 'Registry'
--   It is either a value, having both 'Show' and 'Typeable' information
--   or a function having just 'Typeable' information
data Typed a
  = TypedValue Value
  | TypedFunction Function

-- | This is a list of functions (or "constructors") available for constructing values
newtype Functions = Functions [Function] deriving (Int -> Functions -> ShowS
[Functions] -> ShowS
Functions -> String
(Int -> Functions -> ShowS)
-> (Functions -> String)
-> ([Functions] -> ShowS)
-> Show Functions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Functions] -> ShowS
$cshowList :: [Functions] -> ShowS
show :: Functions -> String
$cshow :: Functions -> String
showsPrec :: Int -> Functions -> ShowS
$cshowsPrec :: Int -> Functions -> ShowS
Show, b -> Functions -> Functions
NonEmpty Functions -> Functions
Functions -> Functions -> Functions
(Functions -> Functions -> Functions)
-> (NonEmpty Functions -> Functions)
-> (forall b. Integral b => b -> Functions -> Functions)
-> Semigroup Functions
forall b. Integral b => b -> Functions -> Functions
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Functions -> Functions
$cstimes :: forall b. Integral b => b -> Functions -> Functions
sconcat :: NonEmpty Functions -> Functions
$csconcat :: NonEmpty Functions -> Functions
<> :: Functions -> Functions -> Functions
$c<> :: Functions -> Functions -> Functions
Semigroup, Semigroup Functions
Functions
Semigroup Functions
-> Functions
-> (Functions -> Functions -> Functions)
-> ([Functions] -> Functions)
-> Monoid Functions
[Functions] -> Functions
Functions -> Functions -> Functions
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Functions] -> Functions
$cmconcat :: [Functions] -> Functions
mappend :: Functions -> Functions -> Functions
$cmappend :: Functions -> Functions -> Functions
mempty :: Functions
$cmempty :: Functions
$cp1Monoid :: Semigroup Functions
Monoid)

-- | Display a list of constructors
describeFunctions :: Functions -> Text
describeFunctions :: Functions -> Text
describeFunctions (Functions [Function]
fs) =
  if [Function] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null [Function]
fs
    then Text
""
    else [Text] -> Text
unlines (FunctionDescription -> Text
funDescriptionToText (FunctionDescription -> Text)
-> (Function -> FunctionDescription) -> Function -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> FunctionDescription
funDescription (Function -> Text) -> [Function] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Function]
fs)

-- | Add one more Function to the list of Functions
addFunction :: Function -> Functions -> Functions
addFunction :: Function -> Functions -> Functions
addFunction Function
f (Functions [Function]
fs) = [Function] -> Functions
Functions (Function
f Function -> [Function] -> [Function]
forall a. a -> [a] -> [a]
: [Function]
fs)

-- | List of values available which can be used as parameters to
--   constructors for building other values
newtype Values = Values {Values -> [Value]
unValues :: [Value]} deriving (Int -> Values -> ShowS
[Values] -> ShowS
Values -> String
(Int -> Values -> ShowS)
-> (Values -> String) -> ([Values] -> ShowS) -> Show Values
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Values] -> ShowS
$cshowList :: [Values] -> ShowS
show :: Values -> String
$cshow :: Values -> String
showsPrec :: Int -> Values -> ShowS
$cshowsPrec :: Int -> Values -> ShowS
Show, b -> Values -> Values
NonEmpty Values -> Values
Values -> Values -> Values
(Values -> Values -> Values)
-> (NonEmpty Values -> Values)
-> (forall b. Integral b => b -> Values -> Values)
-> Semigroup Values
forall b. Integral b => b -> Values -> Values
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Values -> Values
$cstimes :: forall b. Integral b => b -> Values -> Values
sconcat :: NonEmpty Values -> Values
$csconcat :: NonEmpty Values -> Values
<> :: Values -> Values -> Values
$c<> :: Values -> Values -> Values
Semigroup, Semigroup Values
Values
Semigroup Values
-> Values
-> (Values -> Values -> Values)
-> ([Values] -> Values)
-> Monoid Values
[Values] -> Values
Values -> Values -> Values
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Values] -> Values
$cmconcat :: [Values] -> Values
mappend :: Values -> Values -> Values
$cmappend :: Values -> Values -> Values
mempty :: Values
$cmempty :: Values
$cp1Monoid :: Semigroup Values
Monoid)

-- | Display a list of values
describeValues :: Values -> Text
describeValues :: Values -> Text
describeValues (Values [Value]
vs) =
  if [Value] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null [Value]
vs
    then Text
""
    else [Text] -> Text
unlines (ValueDescription -> Text
valDescriptionToText (ValueDescription -> Text)
-> (Value -> ValueDescription) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ValueDescription
valDescription (Value -> Text) -> [Value] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value]
vs)

-- | Add one more Value to the list of Values
addValue :: Value -> Values -> Values
addValue :: Value -> Values -> Values
addValue Value
v (Values [Value]
vs) = [Value] -> Values
Values (Value
v Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
vs)

-- | The types of values that we are trying to build at a given moment
--   of the resolution algorithm.
--   We also store the function requiring a given value type to provide
--   better error messages
--   IMPORTANT: this is a *stack*, the deepest elements in the value
--   graph are first in the list
data Context = Context
  { Context -> [(SomeTypeRep, Maybe SomeTypeRep)]
_contextStack :: [(SomeTypeRep, Maybe SomeTypeRep)]
  }
  deriving (Context -> Context -> Bool
(Context -> Context -> Bool)
-> (Context -> Context -> Bool) -> Eq Context
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c== :: Context -> Context -> Bool
Eq, Int -> Context -> ShowS
[Context] -> ShowS
Context -> String
(Int -> Context -> ShowS)
-> (Context -> String) -> ([Context] -> ShowS) -> Show Context
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Context] -> ShowS
$cshowList :: [Context] -> ShowS
show :: Context -> String
$cshow :: Context -> String
showsPrec :: Int -> Context -> ShowS
$cshowsPrec :: Int -> Context -> ShowS
Show)

instance Semigroup Context where
  Context [(SomeTypeRep, Maybe SomeTypeRep)]
c1 <> :: Context -> Context -> Context
<> Context [(SomeTypeRep, Maybe SomeTypeRep)]
c2 = [(SomeTypeRep, Maybe SomeTypeRep)] -> Context
Context ([(SomeTypeRep, Maybe SomeTypeRep)]
c1 [(SomeTypeRep, Maybe SomeTypeRep)]
-> [(SomeTypeRep, Maybe SomeTypeRep)]
-> [(SomeTypeRep, Maybe SomeTypeRep)]
forall a. Semigroup a => a -> a -> a
<> [(SomeTypeRep, Maybe SomeTypeRep)]
c2)

instance Monoid Context where
  mempty :: Context
mempty = [(SomeTypeRep, Maybe SomeTypeRep)] -> Context
Context [(SomeTypeRep, Maybe SomeTypeRep)]
forall a. Monoid a => a
mempty
  mappend :: Context -> Context -> Context
mappend = Context -> Context -> Context
forall a. Semigroup a => a -> a -> a
(<>)

-- | Return the target types for a given context
contextTypes :: Context -> [SomeTypeRep]
contextTypes :: Context -> [SomeTypeRep]
contextTypes (Context [(SomeTypeRep, Maybe SomeTypeRep)]
cs) = ((SomeTypeRep, Maybe SomeTypeRep) -> SomeTypeRep)
-> [(SomeTypeRep, Maybe SomeTypeRep)] -> [SomeTypeRep]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SomeTypeRep, Maybe SomeTypeRep) -> SomeTypeRep
forall a b. (a, b) -> a
fst [(SomeTypeRep, Maybe SomeTypeRep)]
cs

-- | The values that a value depends on
newtype Dependencies = Dependencies
  { Dependencies -> [Value]
unDependencies :: [Value]
  }
  deriving (Dependencies -> Dependencies -> Bool
(Dependencies -> Dependencies -> Bool)
-> (Dependencies -> Dependencies -> Bool) -> Eq Dependencies
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dependencies -> Dependencies -> Bool
$c/= :: Dependencies -> Dependencies -> Bool
== :: Dependencies -> Dependencies -> Bool
$c== :: Dependencies -> Dependencies -> Bool
Eq, Int -> Dependencies -> ShowS
[Dependencies] -> ShowS
Dependencies -> String
(Int -> Dependencies -> ShowS)
-> (Dependencies -> String)
-> ([Dependencies] -> ShowS)
-> Show Dependencies
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dependencies] -> ShowS
$cshowList :: [Dependencies] -> ShowS
show :: Dependencies -> String
$cshow :: Dependencies -> String
showsPrec :: Int -> Dependencies -> ShowS
$cshowsPrec :: Int -> Dependencies -> ShowS
Show, b -> Dependencies -> Dependencies
NonEmpty Dependencies -> Dependencies
Dependencies -> Dependencies -> Dependencies
(Dependencies -> Dependencies -> Dependencies)
-> (NonEmpty Dependencies -> Dependencies)
-> (forall b. Integral b => b -> Dependencies -> Dependencies)
-> Semigroup Dependencies
forall b. Integral b => b -> Dependencies -> Dependencies
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Dependencies -> Dependencies
$cstimes :: forall b. Integral b => b -> Dependencies -> Dependencies
sconcat :: NonEmpty Dependencies -> Dependencies
$csconcat :: NonEmpty Dependencies -> Dependencies
<> :: Dependencies -> Dependencies -> Dependencies
$c<> :: Dependencies -> Dependencies -> Dependencies
Semigroup, Semigroup Dependencies
Dependencies
Semigroup Dependencies
-> Dependencies
-> (Dependencies -> Dependencies -> Dependencies)
-> ([Dependencies] -> Dependencies)
-> Monoid Dependencies
[Dependencies] -> Dependencies
Dependencies -> Dependencies -> Dependencies
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Dependencies] -> Dependencies
$cmconcat :: [Dependencies] -> Dependencies
mappend :: Dependencies -> Dependencies -> Dependencies
$cmappend :: Dependencies -> Dependencies -> Dependencies
mempty :: Dependencies
$cmempty :: Dependencies
$cp1Monoid :: Semigroup Dependencies
Monoid)

-- | The values types that a value depends on
newtype DependenciesTypes = DependenciesTypes
  { DependenciesTypes -> [SomeTypeRep]
unDependenciesTypes :: [SomeTypeRep]
  }
  deriving (DependenciesTypes -> DependenciesTypes -> Bool
(DependenciesTypes -> DependenciesTypes -> Bool)
-> (DependenciesTypes -> DependenciesTypes -> Bool)
-> Eq DependenciesTypes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DependenciesTypes -> DependenciesTypes -> Bool
$c/= :: DependenciesTypes -> DependenciesTypes -> Bool
== :: DependenciesTypes -> DependenciesTypes -> Bool
$c== :: DependenciesTypes -> DependenciesTypes -> Bool
Eq, Int -> DependenciesTypes -> ShowS
[DependenciesTypes] -> ShowS
DependenciesTypes -> String
(Int -> DependenciesTypes -> ShowS)
-> (DependenciesTypes -> String)
-> ([DependenciesTypes] -> ShowS)
-> Show DependenciesTypes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DependenciesTypes] -> ShowS
$cshowList :: [DependenciesTypes] -> ShowS
show :: DependenciesTypes -> String
$cshow :: DependenciesTypes -> String
showsPrec :: Int -> DependenciesTypes -> ShowS
$cshowsPrec :: Int -> DependenciesTypes -> ShowS
Show, b -> DependenciesTypes -> DependenciesTypes
NonEmpty DependenciesTypes -> DependenciesTypes
DependenciesTypes -> DependenciesTypes -> DependenciesTypes
(DependenciesTypes -> DependenciesTypes -> DependenciesTypes)
-> (NonEmpty DependenciesTypes -> DependenciesTypes)
-> (forall b.
    Integral b =>
    b -> DependenciesTypes -> DependenciesTypes)
-> Semigroup DependenciesTypes
forall b. Integral b => b -> DependenciesTypes -> DependenciesTypes
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> DependenciesTypes -> DependenciesTypes
$cstimes :: forall b. Integral b => b -> DependenciesTypes -> DependenciesTypes
sconcat :: NonEmpty DependenciesTypes -> DependenciesTypes
$csconcat :: NonEmpty DependenciesTypes -> DependenciesTypes
<> :: DependenciesTypes -> DependenciesTypes -> DependenciesTypes
$c<> :: DependenciesTypes -> DependenciesTypes -> DependenciesTypes
Semigroup, Semigroup DependenciesTypes
DependenciesTypes
Semigroup DependenciesTypes
-> DependenciesTypes
-> (DependenciesTypes -> DependenciesTypes -> DependenciesTypes)
-> ([DependenciesTypes] -> DependenciesTypes)
-> Monoid DependenciesTypes
[DependenciesTypes] -> DependenciesTypes
DependenciesTypes -> DependenciesTypes -> DependenciesTypes
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [DependenciesTypes] -> DependenciesTypes
$cmconcat :: [DependenciesTypes] -> DependenciesTypes
mappend :: DependenciesTypes -> DependenciesTypes -> DependenciesTypes
$cmappend :: DependenciesTypes -> DependenciesTypes -> DependenciesTypes
mempty :: DependenciesTypes
$cmempty :: DependenciesTypes
$cp1Monoid :: Semigroup DependenciesTypes
Monoid)

dependenciesTypes :: Dependencies -> DependenciesTypes
dependenciesTypes :: Dependencies -> DependenciesTypes
dependenciesTypes (Dependencies [Value]
ds) = [SomeTypeRep] -> DependenciesTypes
DependenciesTypes (Value -> SomeTypeRep
valueDynTypeRep (Value -> SomeTypeRep) -> [Value] -> [SomeTypeRep]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value]
ds)

-- | The dependencies of a value + the value itself
dependenciesOn :: Value -> Dependencies
dependenciesOn :: Value -> Dependencies
dependenciesOn Value
value =
  [Value] -> Dependencies
Dependencies ([Value] -> Dependencies) -> [Value] -> Dependencies
forall a b. (a -> b) -> a -> b
$
    Value
value Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: (Dependencies -> [Value]
unDependencies (Dependencies -> [Value])
-> (Value -> Dependencies) -> Value -> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Dependencies
valDependencies (Value -> [Value]) -> Value -> [Value]
forall a b. (a -> b) -> a -> b
$ Value
value)

-- | Specification of values which become available for
--   construction when a corresponding type comes in context
newtype Specializations = Specializations
  { Specializations -> [Specialization]
unSpecializations :: [Specialization]
  }
  deriving (Int -> Specializations -> ShowS
[Specializations] -> ShowS
Specializations -> String
(Int -> Specializations -> ShowS)
-> (Specializations -> String)
-> ([Specializations] -> ShowS)
-> Show Specializations
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Specializations] -> ShowS
$cshowList :: [Specializations] -> ShowS
show :: Specializations -> String
$cshow :: Specializations -> String
showsPrec :: Int -> Specializations -> ShowS
$cshowsPrec :: Int -> Specializations -> ShowS
Show, b -> Specializations -> Specializations
NonEmpty Specializations -> Specializations
Specializations -> Specializations -> Specializations
(Specializations -> Specializations -> Specializations)
-> (NonEmpty Specializations -> Specializations)
-> (forall b.
    Integral b =>
    b -> Specializations -> Specializations)
-> Semigroup Specializations
forall b. Integral b => b -> Specializations -> Specializations
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Specializations -> Specializations
$cstimes :: forall b. Integral b => b -> Specializations -> Specializations
sconcat :: NonEmpty Specializations -> Specializations
$csconcat :: NonEmpty Specializations -> Specializations
<> :: Specializations -> Specializations -> Specializations
$c<> :: Specializations -> Specializations -> Specializations
Semigroup, Semigroup Specializations
Specializations
Semigroup Specializations
-> Specializations
-> (Specializations -> Specializations -> Specializations)
-> ([Specializations] -> Specializations)
-> Monoid Specializations
[Specializations] -> Specializations
Specializations -> Specializations -> Specializations
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Specializations] -> Specializations
$cmconcat :: [Specializations] -> Specializations
mappend :: Specializations -> Specializations -> Specializations
$cmappend :: Specializations -> Specializations -> Specializations
mempty :: Specializations
$cmempty :: Specializations
$cp1Monoid :: Semigroup Specializations
Monoid)

-- | A specialization is defined by
--   a path of types, from top to bottom in the
--    value graph and target value, which is the
--   value to use when we need a value on that type
--   on that path.
--   For example:
--      specializationPath = [App, PaymentEngine, TransactionRepository]
--      specializationValue = DatabaseConfig "localhost" 5432
--   This means that need to use this `DatabaseConfig` whenever
--   trying to find inputs needed to create a TransactionRepository
--   if that repository is necessary to create a PaymentEngine, itself
--   involved in the creation of the App
data Specialization = Specialization
  { Specialization -> SpecializationPath
_specializationPath :: SpecializationPath,
    Specialization -> Value
_specializationValue :: Value
  }
  deriving (Specialization -> Specialization -> Bool
(Specialization -> Specialization -> Bool)
-> (Specialization -> Specialization -> Bool) -> Eq Specialization
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Specialization -> Specialization -> Bool
$c/= :: Specialization -> Specialization -> Bool
== :: Specialization -> Specialization -> Bool
$c== :: Specialization -> Specialization -> Bool
Eq, Int -> Specialization -> ShowS
[Specialization] -> ShowS
Specialization -> String
(Int -> Specialization -> ShowS)
-> (Specialization -> String)
-> ([Specialization] -> ShowS)
-> Show Specialization
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Specialization] -> ShowS
$cshowList :: [Specialization] -> ShowS
show :: Specialization -> String
$cshow :: Specialization -> String
showsPrec :: Int -> Specialization -> ShowS
$cshowsPrec :: Int -> Specialization -> ShowS
Show)

type SpecializationPath = NonEmpty SomeTypeRep

specializationPaths :: Value -> Maybe [SpecializationPath]
specializationPaths :: Value -> Maybe [SpecializationPath]
specializationPaths Value
v =
  case [Maybe Specialization] -> [Specialization]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Specialization] -> [Specialization])
-> [Maybe Specialization] -> [Specialization]
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Specialization
usedSpecialization (Value -> Maybe Specialization)
-> [Value] -> [Maybe Specialization]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value
v Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: (Dependencies -> [Value]
unDependencies (Dependencies -> [Value])
-> (Value -> Dependencies) -> Value -> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Dependencies
valDependencies (Value -> [Value]) -> Value -> [Value]
forall a b. (a -> b) -> a -> b
$ Value
v)) of
    [] -> Maybe [SpecializationPath]
forall a. Maybe a
Nothing
    [Specialization]
ss -> [SpecializationPath] -> Maybe [SpecializationPath]
forall a. a -> Maybe a
Just (Specialization -> SpecializationPath
_specializationPath (Specialization -> SpecializationPath)
-> [Specialization] -> [SpecializationPath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Specialization]
ss)

-- | First type of a specialization
specializationStart :: Specialization -> SomeTypeRep
specializationStart :: Specialization -> SomeTypeRep
specializationStart = SpecializationPath -> SomeTypeRep
forall a. NonEmpty a -> a
NonEmpty.head (SpecializationPath -> SomeTypeRep)
-> (Specialization -> SpecializationPath)
-> Specialization
-> SomeTypeRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Specialization -> SpecializationPath
_specializationPath

-- | Last type of a specialization
specializationEnd :: Specialization -> SomeTypeRep
specializationEnd :: Specialization -> SomeTypeRep
specializationEnd = SpecializationPath -> SomeTypeRep
forall a. NonEmpty a -> a
NonEmpty.last (SpecializationPath -> SomeTypeRep)
-> (Specialization -> SpecializationPath)
-> Specialization
-> SomeTypeRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Specialization -> SpecializationPath
_specializationPath

-- | Return the type of the replaced value in a specialization
specializationTargetType :: Specialization -> SomeTypeRep
specializationTargetType :: Specialization -> SomeTypeRep
specializationTargetType = Value -> SomeTypeRep
valueDynTypeRep (Value -> SomeTypeRep)
-> (Specialization -> Value) -> Specialization -> SomeTypeRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Specialization -> Value
_specializationValue

-- | A specialization is applicable to a context if all its types
--   are part of that context, in the right order
isContextApplicable :: Context -> Specialization -> Bool
isContextApplicable :: Context -> Specialization -> Bool
isContextApplicable Context
context (Specialization SpecializationPath
specializationPath Value
_) =
  (SomeTypeRep -> Bool) -> SpecializationPath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
P.all (SomeTypeRep -> [SomeTypeRep] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Context -> [SomeTypeRep]
contextTypes Context
context)) SpecializationPath
specializationPath

-- | Return the specifications valid in a given context
applicableTo :: Specializations -> Context -> Specializations
applicableTo :: Specializations -> Context -> Specializations
applicableTo (Specializations [Specialization]
ss) Context
context =
  [Specialization] -> Specializations
Specializations ((Specialization -> Bool) -> [Specialization] -> [Specialization]
forall a. (a -> Bool) -> [a] -> [a]
P.filter (Context -> Specialization -> Bool
isContextApplicable Context
context) [Specialization]
ss)

-- | The depth of a specialization in a context is the
--   the index of the 'deepest' type of that specialization
--   in the stack of types of that context
--   is the one having its "deepest" type (in the value graph)
--     the "deepest" in the current context
--   If there is a tie we take the "highest" highest type of each
specializedContext :: Context -> Specialization -> SpecializedContext
specializedContext :: Context -> Specialization -> SpecializedContext
specializedContext Context
context Specialization
specialization =
  Maybe Int -> Maybe Int -> SpecializedContext
SpecializedContext
    (Specialization -> SomeTypeRep
specializationStart Specialization
specialization SomeTypeRep -> [SomeTypeRep] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` (Context -> [SomeTypeRep]
contextTypes Context
context))
    (Specialization -> SomeTypeRep
specializationEnd Specialization
specialization SomeTypeRep -> [SomeTypeRep] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` (Context -> [SomeTypeRep]
contextTypes Context
context))

-- | For a given context this represents the position of a specialization path
--   in that context. startRange is the index of the start type of the specialization
--   endRange is the index of the last type.
data SpecializedContext = SpecializedContext
  { SpecializedContext -> Maybe Int
_startRange :: Maybe Int,
    SpecializedContext -> Maybe Int
_endRange :: Maybe Int
  }
  deriving (SpecializedContext -> SpecializedContext -> Bool
(SpecializedContext -> SpecializedContext -> Bool)
-> (SpecializedContext -> SpecializedContext -> Bool)
-> Eq SpecializedContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpecializedContext -> SpecializedContext -> Bool
$c/= :: SpecializedContext -> SpecializedContext -> Bool
== :: SpecializedContext -> SpecializedContext -> Bool
$c== :: SpecializedContext -> SpecializedContext -> Bool
Eq, Int -> SpecializedContext -> ShowS
[SpecializedContext] -> ShowS
SpecializedContext -> String
(Int -> SpecializedContext -> ShowS)
-> (SpecializedContext -> String)
-> ([SpecializedContext] -> ShowS)
-> Show SpecializedContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpecializedContext] -> ShowS
$cshowList :: [SpecializedContext] -> ShowS
show :: SpecializedContext -> String
$cshow :: SpecializedContext -> String
showsPrec :: Int -> SpecializedContext -> ShowS
$cshowsPrec :: Int -> SpecializedContext -> ShowS
Show)

-- | A specialization range is preferrable to another one if its types
--   are more specific (or "deepest" in the value graph) than the other
--   If a path is limited to just one type then a path ending with the same
--   type but specifying other types will take precedence
--   See TypesSpec for some concrete examples.
instance Ord SpecializedContext where
  SpecializedContext Maybe Int
s1 Maybe Int
e1 <= :: SpecializedContext -> SpecializedContext -> Bool
<= SpecializedContext Maybe Int
s2 Maybe Int
e2
    | Maybe Int
e1 Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Int
s1 Bool -> Bool -> Bool
&& Maybe Int
e2 Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Int
s2 = Maybe Int
e1 Maybe Int -> Maybe Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Maybe Int
e2 Bool -> Bool -> Bool
|| (Maybe Int
e1 Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
e2 Bool -> Bool -> Bool
&& Maybe Int
s1 Maybe Int -> Maybe Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Maybe Int
s2)
    | Maybe Int
e1 Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
s1 Bool -> Bool -> Bool
&& Maybe Int
e2 Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Int
s2 = Maybe Int
e1 Maybe Int -> Maybe Int -> Bool
forall a. Ord a => a -> a -> Bool
< Maybe Int
e2
    | Bool
otherwise = Maybe Int
e1 Maybe Int -> Maybe Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Maybe Int
e2

-- | Restrict a given context to the types of a specialization
-- specializedContext :: Context -> Specialization -> Context
-- specializedContext (Context cs) specialization = Context $
--   P.dropWhile    (/= specializationEnd specialization) .
--   dropWhileEnd (/= specializationStart specialization) $ cs

-- | In a given context, create a value as specified by a specialization
--   the full context is necessary since the specificationPath is
--   only a subpath of a given creation context
createValueFromSpecialization :: Context -> Specialization -> Value
createValueFromSpecialization :: Context -> Specialization -> Value
createValueFromSpecialization Context
context specialization :: Specialization
specialization@(Specialization SpecializationPath
_ (ProvidedValue Dynamic
d ValueDescription
desc)) =
  -- the creation context for that value
  Dynamic
-> ValueDescription
-> Maybe Context
-> Maybe Specialization
-> Dependencies
-> Value
CreatedValue Dynamic
d ValueDescription
desc (Context -> Maybe Context
forall a. a -> Maybe a
Just Context
context) (Specialization -> Maybe Specialization
forall a. a -> Maybe a
Just Specialization
specialization) Dependencies
forall a. Monoid a => a
mempty
-- this is not supposed to happen since specialization are always
-- using ProvidedValues
createValueFromSpecialization Context
_ Specialization
v = Specialization -> Value
_specializationValue Specialization
v

-- | Display a list of specializations for the Registry, just showing the
--   context (a type) in which a value must be selected
describeSpecializations :: Specializations -> Text
describeSpecializations :: Specializations -> Text
describeSpecializations (Specializations [Specialization]
ss) =
  if [Specialization] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null [Specialization]
ss
    then Text
""
    else Text
"specializations\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
unlines (Specialization -> Text
forall a b. (Show a, StringConv String b) => a -> b
P.show (Specialization -> Text) -> [Specialization] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Specialization]
ss)

-- | List of functions modifying some values right after they have been
--   built. This enables "tweaking" the creation process with slightly
--   different results. Here SomeTypeRep is the target value type 'a' and
newtype Modifiers = Modifiers [(SomeTypeRep, ModifierFunction)] deriving (b -> Modifiers -> Modifiers
NonEmpty Modifiers -> Modifiers
Modifiers -> Modifiers -> Modifiers
(Modifiers -> Modifiers -> Modifiers)
-> (NonEmpty Modifiers -> Modifiers)
-> (forall b. Integral b => b -> Modifiers -> Modifiers)
-> Semigroup Modifiers
forall b. Integral b => b -> Modifiers -> Modifiers
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Modifiers -> Modifiers
$cstimes :: forall b. Integral b => b -> Modifiers -> Modifiers
sconcat :: NonEmpty Modifiers -> Modifiers
$csconcat :: NonEmpty Modifiers -> Modifiers
<> :: Modifiers -> Modifiers -> Modifiers
$c<> :: Modifiers -> Modifiers -> Modifiers
Semigroup, Semigroup Modifiers
Modifiers
Semigroup Modifiers
-> Modifiers
-> (Modifiers -> Modifiers -> Modifiers)
-> ([Modifiers] -> Modifiers)
-> Monoid Modifiers
[Modifiers] -> Modifiers
Modifiers -> Modifiers -> Modifiers
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Modifiers] -> Modifiers
$cmconcat :: [Modifiers] -> Modifiers
mappend :: Modifiers -> Modifiers -> Modifiers
$cmappend :: Modifiers -> Modifiers -> Modifiers
mempty :: Modifiers
$cmempty :: Modifiers
$cp1Monoid :: Semigroup Modifiers
Monoid)

type ModifierFunction = Maybe [SpecializationPath] -> Function

-- | Create a 'Function' value from a Haskell function
createConstModifierFunction :: (Typeable f) => f -> ModifierFunction
createConstModifierFunction :: f -> ModifierFunction
createConstModifierFunction f
f = Function -> ModifierFunction
forall a b. a -> b -> a
const (f -> Function
forall f. Typeable f => f -> Function
createFunction f
f)

instance Show Modifiers where
  show :: Modifiers -> String
show = Text -> String
forall a b. ConvertText a b => a -> b
toS (Text -> String) -> (Modifiers -> Text) -> Modifiers -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Modifiers -> Text
describeModifiers

-- | Display a list of modifiers for the Registry, just showing the
--   type of the modified value
describeModifiers :: Modifiers -> Text
describeModifiers :: Modifiers -> Text
describeModifiers (Modifiers [(SomeTypeRep, ModifierFunction)]
ms) =
  if [(SomeTypeRep, ModifierFunction)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null [(SomeTypeRep, ModifierFunction)]
ms
    then Text
""
    else Text
"modifiers for types\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
unlines (SomeTypeRep -> Text
forall a b. (Show a, StringConv String b) => a -> b
P.show (SomeTypeRep -> Text)
-> ((SomeTypeRep, ModifierFunction) -> SomeTypeRep)
-> (SomeTypeRep, ModifierFunction)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeTypeRep, ModifierFunction) -> SomeTypeRep
forall a b. (a, b) -> a
fst ((SomeTypeRep, ModifierFunction) -> Text)
-> [(SomeTypeRep, ModifierFunction)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(SomeTypeRep, ModifierFunction)]
ms)