{-# 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           Data.Text                         as T hiding (last)
import           Prelude                           (show)
import           Protolude                         as P hiding (show)
import qualified Protolude                         as P
import           Type.Reflection


-- | 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 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 (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 (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, ConvertText 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, ConvertText 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)