{-# LANGUAGE GeneralizedNewtypeDeriving #-}
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)
data Value
= CreatedValue Dynamic ValueDescription (Maybe SpecializationContext) Dependencies
| ProvidedValue Dynamic ValueDescription
deriving (Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
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 SpecializationContext
sc1 Dependencies
ds1 == :: Value -> Value -> Bool
== CreatedValue Dynamic
_ ValueDescription
vd2 Maybe SpecializationContext
sc2 Dependencies
ds2 =
(ValueDescription
vd1, Maybe SpecializationContext
sc1, Dependencies
ds1) forall a. Eq a => a -> a -> Bool
== (ValueDescription
vd2, Maybe SpecializationContext
sc2, Dependencies
ds2)
ProvidedValue Dynamic
_ ValueDescription
vd1 == ProvidedValue Dynamic
_ ValueDescription
vd2 =
ValueDescription
vd1 forall a. Eq a => a -> a -> Bool
== ValueDescription
vd2
Value
_ == Value
_ = Bool
False
instance Hashable Value where
hash :: Value -> Int
hash Value
value = forall a. Hashable a => a -> Int
hash (Value -> ValueDescription
valDescription Value
value)
hashWithSalt :: Int -> Value -> Int
hashWithSalt Int
n Value
value = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
n (Value -> ValueDescription
valDescription Value
value)
data ValueDescription = ValueDescription
{ ValueDescription -> Text
_valueType :: Text,
ValueDescription -> Maybe Text
_valueValue :: Maybe Text
}
deriving (ValueDescription -> ValueDescription -> Bool
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
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) = 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) = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
n (Text
d, Maybe Text
v)
describeValue :: (Typeable a, Show a) => a -> ValueDescription
describeValue :: forall a. (Typeable a, Show a) => a -> ValueDescription
describeValue a
a = Text -> Maybe Text -> ValueDescription
ValueDescription (forall a. Typeable a => a -> Text
showFullValueType a
a) (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertText a b => a -> b
toS forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
a)
describeTypeableValue :: (Typeable a) => a -> ValueDescription
describeTypeableValue :: forall a. Typeable a => a -> ValueDescription
describeTypeableValue a
a = Text -> Maybe Text -> ValueDescription
ValueDescription (forall a. Typeable a => a -> Text
showFullValueType a
a) forall a. Maybe a
Nothing
showValue :: Value -> Text
showValue :: Value -> Text
showValue = ValueDescription -> Text
valDescriptionToText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ValueDescription
valDescription
createValue :: (Typeable a, Show a) => a -> Value
createValue :: forall a. (Typeable a, Show a) => a -> Value
createValue a
a = Dynamic -> ValueDescription -> Value
makeProvidedValue (forall a. Typeable a => a -> Dynamic
toDyn a
a) (forall a. (Typeable a, Show a) => a -> ValueDescription
describeValue a
a)
makeProvidedValue :: Dynamic -> ValueDescription -> Value
makeProvidedValue :: Dynamic -> ValueDescription -> Value
makeProvidedValue = Dynamic -> ValueDescription -> Value
ProvidedValue
makeCreatedValue :: Dynamic -> ValueDescription -> Dependencies -> Value
makeCreatedValue :: Dynamic -> ValueDescription -> Dependencies -> Value
makeCreatedValue Dynamic
d ValueDescription
desc = Dynamic
-> ValueDescription
-> Maybe SpecializationContext
-> Dependencies
-> Value
CreatedValue Dynamic
d ValueDescription
desc forall a. Maybe a
Nothing
createTypeableValue :: Typeable a => a -> Value
createTypeableValue :: forall a. Typeable a => a -> Value
createTypeableValue a
a = Dynamic -> ValueDescription -> Value
ProvidedValue (forall a. Typeable a => a -> Dynamic
toDyn a
a) (forall a. Typeable a => a -> ValueDescription
describeTypeableValue a
a)
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 forall a. Maybe a
Nothing)
valueDynTypeRep :: Value -> SomeTypeRep
valueDynTypeRep :: Value -> SomeTypeRep
valueDynTypeRep = Dynamic -> SomeTypeRep
dynTypeRep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Dynamic
valueDyn
valueDyn :: Value -> Dynamic
valueDyn :: Value -> Dynamic
valueDyn (CreatedValue Dynamic
d ValueDescription
_ Maybe SpecializationContext
_ Dependencies
_) = Dynamic
d
valueDyn (ProvidedValue Dynamic
d ValueDescription
_) = Dynamic
d
valDescription :: Value -> ValueDescription
valDescription :: Value -> ValueDescription
valDescription (CreatedValue Dynamic
_ ValueDescription
d Maybe SpecializationContext
_ Dependencies
_) = ValueDescription
d
valDescription (ProvidedValue Dynamic
_ ValueDescription
d) = ValueDescription
d
valueDependencies :: Value -> Dependencies
valueDependencies :: Value -> Dependencies
valueDependencies (CreatedValue Dynamic
_ ValueDescription
_ Maybe SpecializationContext
_ Dependencies
ds) = Dependencies
ds
valueDependencies (ProvidedValue Dynamic
_ ValueDescription
_) = forall a. Monoid a => a
mempty
valDescriptionToText :: ValueDescription -> Text
valDescriptionToText :: ValueDescription -> Text
valDescriptionToText (ValueDescription Text
t Maybe Text
Nothing) = Text
t
valDescriptionToText (ValueDescription Text
t (Just Text
v)) = Text
t forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> Text
v
valueSpecializationContext :: Value -> Maybe SpecializationContext
valueSpecializationContext :: Value -> Maybe SpecializationContext
valueSpecializationContext (CreatedValue Dynamic
_ ValueDescription
_ Maybe SpecializationContext
sc Dependencies
_) = Maybe SpecializationContext
sc
valueSpecializationContext Value
_ = forall a. Maybe a
Nothing
valueContext :: Value -> Maybe Context
valueContext :: Value -> Maybe Context
valueContext (CreatedValue Dynamic
_ ValueDescription
_ Maybe SpecializationContext
sc Dependencies
_) = SpecializationContext -> Context
scContext forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SpecializationContext
sc
valueContext Value
_ = forall a. Maybe a
Nothing
valueSpecialization :: Value -> Maybe Specialization
valueSpecialization :: Value -> Maybe Specialization
valueSpecialization (CreatedValue Dynamic
_ ValueDescription
_ Maybe SpecializationContext
sc Dependencies
_) = SpecializationContext -> Specialization
scSpecialization forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SpecializationContext
sc
valueSpecialization Value
_ = forall a. Maybe a
Nothing
isInSpecializationContext :: SomeTypeRep -> Value -> Bool
isInSpecializationContext :: SomeTypeRep -> Value -> Bool
isInSpecializationContext SomeTypeRep
target Value
value =
case Value -> Maybe Context
valueContext Value
value of
Just Context
context -> SomeTypeRep
target forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Context -> [SomeTypeRep]
contextTypes Context
context
Maybe Context
Nothing -> Bool
False
hasSpecializedDependencies :: Specializations -> Value -> Bool
hasSpecializedDependencies :: Specializations -> Value -> Bool
hasSpecializedDependencies (Specializations [Specialization]
ss) Value
v =
let DependenciesTypes [SomeTypeRep]
ds = Dependencies -> DependenciesTypes
dependenciesTypes forall a b. (a -> b) -> a -> b
$ Value -> Dependencies
valueDependencies Value
v
targetTypes :: [SomeTypeRep]
targetTypes = Specialization -> SomeTypeRep
specializationTargetType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Specialization]
ss
in Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null forall a b. (a -> b) -> a -> b
$ [SomeTypeRep]
targetTypes forall a. Eq a => [a] -> [a] -> [a]
`intersect` [SomeTypeRep]
ds
data Function = Function Dynamic FunctionDescription deriving (Int -> Function -> ShowS
[Function] -> ShowS
Function -> String
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)
createFunction :: (Typeable f) => f -> Function
createFunction :: forall f. Typeable f => f -> Function
createFunction f
f =
let dynType :: Dynamic
dynType = forall a. Typeable a => a -> Dynamic
toDyn f
f
in Dynamic -> FunctionDescription -> Function
Function Dynamic
dynType (forall a. Typeable a => a -> FunctionDescription
describeFunction f
f)
data FunctionDescription = FunctionDescription
{ FunctionDescription -> [Text]
_inputTypes :: [Text],
FunctionDescription -> Text
_outputType :: Text
}
deriving (FunctionDescription -> FunctionDescription -> Bool
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
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)
describeFunction :: Typeable a => a -> FunctionDescription
describeFunction :: forall a. Typeable a => a -> FunctionDescription
describeFunction = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Text] -> Text -> FunctionDescription
FunctionDescription forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Typeable a => a -> ([Text], Text)
showFullFunctionType
showFunction :: Function -> Text
showFunction :: Function -> Text
showFunction = FunctionDescription -> Text
funDescriptionToText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> FunctionDescription
funDescription
funDescription :: Function -> FunctionDescription
funDescription :: Function -> FunctionDescription
funDescription (Function Dynamic
_ FunctionDescription
t) = FunctionDescription
t
funDyn :: Function -> Dynamic
funDyn :: Function -> Dynamic
funDyn (Function Dynamic
d FunctionDescription
_) = Dynamic
d
funDynTypeRep :: Function -> SomeTypeRep
funDynTypeRep :: Function -> SomeTypeRep
funDynTypeRep = Dynamic -> SomeTypeRep
dynTypeRep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> Dynamic
funDyn
funDescriptionToText :: FunctionDescription -> Text
funDescriptionToText :: FunctionDescription -> Text
funDescriptionToText (FunctionDescription [Text]
ins Text
out) = Text -> [Text] -> Text
T.intercalate Text
" -> " ([Text]
ins forall a. Semigroup a => a -> a -> a
<> [Text
out])
hasParameters :: Function -> Bool
hasParameters :: Function -> Bool
hasParameters = SomeTypeRep -> Bool
isFunction forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> SomeTypeRep
funDynTypeRep
data Typed a
= TypedValue Value
| TypedFunction Function
newtype Functions = Functions [Function] deriving (Int -> Functions -> ShowS
[Functions] -> ShowS
Functions -> String
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, NonEmpty Functions -> Functions
Functions -> Functions -> 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 :: forall b. Integral b => 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
[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
Monoid)
describeFunctions :: Functions -> Text
describeFunctions :: Functions -> Text
describeFunctions (Functions [Function]
fs) =
if forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null [Function]
fs
then Text
""
else [Text] -> Text
unlines (FunctionDescription -> Text
funDescriptionToText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> FunctionDescription
funDescription forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Function]
fs)
addFunction :: Function -> Functions -> Functions
addFunction :: Function -> Functions -> Functions
addFunction Function
f (Functions [Function]
fs) = [Function] -> Functions
Functions (Function
f forall a. a -> [a] -> [a]
: [Function]
fs)
newtype Values = Values {Values -> [Value]
unValues :: [Value]} deriving (Int -> Values -> ShowS
[Values] -> ShowS
Values -> String
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, NonEmpty Values -> Values
Values -> Values -> 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 :: forall b. Integral b => 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
[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
Monoid)
describeValues :: Values -> Text
describeValues :: Values -> Text
describeValues (Values [Value]
vs) =
if forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null [Value]
vs
then Text
""
else [Text] -> Text
unlines (ValueDescription -> Text
valDescriptionToText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ValueDescription
valDescription forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value]
vs)
addValue :: Value -> Values -> Values
addValue :: Value -> Values -> Values
addValue Value
v (Values [Value]
vs) = [Value] -> Values
Values (Value
v forall a. a -> [a] -> [a]
: [Value]
vs)
newtype Context = Context
{ Context -> [(SomeTypeRep, Maybe SomeTypeRep)]
_contextStack :: [(SomeTypeRep, Maybe SomeTypeRep)]
}
deriving (Context -> Context -> Bool
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
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 forall a. Semigroup a => a -> a -> a
<> [(SomeTypeRep, Maybe SomeTypeRep)]
c2)
instance Monoid Context where
mempty :: Context
mempty = [(SomeTypeRep, Maybe SomeTypeRep)] -> Context
Context forall a. Monoid a => a
mempty
mappend :: Context -> Context -> Context
mappend = forall a. Semigroup a => a -> a -> a
(<>)
contextTypes :: Context -> [SomeTypeRep]
contextTypes :: Context -> [SomeTypeRep]
contextTypes (Context [(SomeTypeRep, Maybe SomeTypeRep)]
cs) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst [(SomeTypeRep, Maybe SomeTypeRep)]
cs
newtype Dependencies = Dependencies
{ Dependencies -> [Value]
unDependencies :: [Value]
}
deriving (Dependencies -> Dependencies -> Bool
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
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, NonEmpty Dependencies -> Dependencies
Dependencies -> Dependencies -> 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 :: forall b. Integral b => 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
[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
Monoid)
newtype DependenciesTypes = DependenciesTypes
{ DependenciesTypes -> [SomeTypeRep]
unDependenciesTypes :: [SomeTypeRep]
}
deriving (DependenciesTypes -> DependenciesTypes -> Bool
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
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, NonEmpty DependenciesTypes -> DependenciesTypes
DependenciesTypes -> DependenciesTypes -> 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 :: forall b. Integral b => 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
[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
Monoid)
dependenciesTypes :: Dependencies -> DependenciesTypes
dependenciesTypes :: Dependencies -> DependenciesTypes
dependenciesTypes (Dependencies [Value]
ds) = [SomeTypeRep] -> DependenciesTypes
DependenciesTypes (Value -> SomeTypeRep
valueDynTypeRep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value]
ds)
dependenciesOn :: Value -> Dependencies
dependenciesOn :: Value -> Dependencies
dependenciesOn Value
value = [Value] -> Dependencies
Dependencies forall a b. (a -> b) -> a -> b
$ Value
value forall a. a -> [a] -> [a]
: (Dependencies -> [Value]
unDependencies forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Dependencies
valueDependencies forall a b. (a -> b) -> a -> b
$ Value
value)
newtype Specializations = Specializations
{ Specializations -> [Specialization]
unSpecializations :: [Specialization]
}
deriving (Int -> Specializations -> ShowS
[Specializations] -> ShowS
Specializations -> String
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, NonEmpty Specializations -> Specializations
Specializations -> Specializations -> 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 :: forall b. Integral b => 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
[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
Monoid)
data Specialization = Specialization
{ Specialization -> SpecializationPath
_specializationPath :: SpecializationPath,
Specialization -> Value
_specializationValue :: Value
}
deriving (Specialization -> Specialization -> Bool
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
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 forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Value -> Maybe Specialization
valueSpecialization (Dependencies -> [Value]
unDependencies forall a b. (a -> b) -> a -> b
$ Value -> Dependencies
dependenciesOn Value
v) of
[] -> forall a. Maybe a
Nothing
[Specialization]
ss -> forall a. a -> Maybe a
Just (Specialization -> SpecializationPath
_specializationPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Specialization]
ss)
specializationStart :: Specialization -> SomeTypeRep
specializationStart :: Specialization -> SomeTypeRep
specializationStart = forall a. NonEmpty a -> a
NonEmpty.head forall b c a. (b -> c) -> (a -> b) -> a -> c
. Specialization -> SpecializationPath
_specializationPath
specializationEnd :: Specialization -> SomeTypeRep
specializationEnd :: Specialization -> SomeTypeRep
specializationEnd = forall a. NonEmpty a -> a
NonEmpty.last forall b c a. (b -> c) -> (a -> b) -> a -> c
. Specialization -> SpecializationPath
_specializationPath
specializationTargetType :: Specialization -> SomeTypeRep
specializationTargetType :: Specialization -> SomeTypeRep
specializationTargetType = Value -> SomeTypeRep
valueDynTypeRep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Specialization -> Value
_specializationValue
data SpecializationContext = SpecializationContext { SpecializationContext -> Context
scContext :: Context, SpecializationContext -> Specialization
scSpecialization :: Specialization } deriving (SpecializationContext -> SpecializationContext -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpecializationContext -> SpecializationContext -> Bool
$c/= :: SpecializationContext -> SpecializationContext -> Bool
== :: SpecializationContext -> SpecializationContext -> Bool
$c== :: SpecializationContext -> SpecializationContext -> Bool
Eq, Int -> SpecializationContext -> ShowS
[SpecializationContext] -> ShowS
SpecializationContext -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpecializationContext] -> ShowS
$cshowList :: [SpecializationContext] -> ShowS
show :: SpecializationContext -> String
$cshow :: SpecializationContext -> String
showsPrec :: Int -> SpecializationContext -> ShowS
$cshowsPrec :: Int -> SpecializationContext -> ShowS
Show)
isContextApplicable :: Context -> Specialization -> Bool
isContextApplicable :: Context -> Specialization -> Bool
isContextApplicable Context
context (Specialization SpecializationPath
specializationPath Value
_value) =
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
P.all (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Context -> [SomeTypeRep]
contextTypes Context
context) SpecializationPath
specializationPath
applicableTo :: Specializations -> Context -> Specializations
applicableTo :: Specializations -> Context -> Specializations
applicableTo (Specializations [Specialization]
ss) Context
context =
[Specialization] -> Specializations
Specializations (forall a. (a -> Bool) -> [a] -> [a]
P.filter (Context -> Specialization -> Bool
isContextApplicable Context
context) [Specialization]
ss)
specializationRange :: Context -> Specialization -> SpecializationRange
specializationRange :: Context -> Specialization -> SpecializationRange
specializationRange Context
context Specialization
specialization =
Maybe Int -> Maybe Int -> SpecializationRange
SpecializationRange
(Specialization -> SomeTypeRep
specializationStart Specialization
specialization forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` Context -> [SomeTypeRep]
contextTypes Context
context)
(Specialization -> SomeTypeRep
specializationEnd Specialization
specialization forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` Context -> [SomeTypeRep]
contextTypes Context
context)
data SpecializationRange = SpecializationRange
{ SpecializationRange -> Maybe Int
_startRange :: Maybe Int,
SpecializationRange -> Maybe Int
_endRange :: Maybe Int
}
deriving (SpecializationRange -> SpecializationRange -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpecializationRange -> SpecializationRange -> Bool
$c/= :: SpecializationRange -> SpecializationRange -> Bool
== :: SpecializationRange -> SpecializationRange -> Bool
$c== :: SpecializationRange -> SpecializationRange -> Bool
Eq, Int -> SpecializationRange -> ShowS
[SpecializationRange] -> ShowS
SpecializationRange -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpecializationRange] -> ShowS
$cshowList :: [SpecializationRange] -> ShowS
show :: SpecializationRange -> String
$cshow :: SpecializationRange -> String
showsPrec :: Int -> SpecializationRange -> ShowS
$cshowsPrec :: Int -> SpecializationRange -> ShowS
Show)
instance Ord SpecializationRange where
SpecializationRange Maybe Int
s1 Maybe Int
e1 <= :: SpecializationRange -> SpecializationRange -> Bool
<= SpecializationRange Maybe Int
s2 Maybe Int
e2
| Maybe Int
e1 forall a. Eq a => a -> a -> Bool
/= Maybe Int
s1 Bool -> Bool -> Bool
&& Maybe Int
e2 forall a. Eq a => a -> a -> Bool
/= Maybe Int
s2 = Maybe Int
e1 forall a. Ord a => a -> a -> Bool
<= Maybe Int
e2 Bool -> Bool -> Bool
|| (Maybe Int
e1 forall a. Eq a => a -> a -> Bool
== Maybe Int
e2 Bool -> Bool -> Bool
&& Maybe Int
s1 forall a. Ord a => a -> a -> Bool
<= Maybe Int
s2)
| Maybe Int
e1 forall a. Eq a => a -> a -> Bool
== Maybe Int
s1 Bool -> Bool -> Bool
&& Maybe Int
e2 forall a. Eq a => a -> a -> Bool
/= Maybe Int
s2 = Maybe Int
e1 forall a. Ord a => a -> a -> Bool
< Maybe Int
e2
| Bool
otherwise = Maybe Int
e1 forall a. Ord a => a -> a -> Bool
<= Maybe Int
e2
createValueFromSpecialization :: Context -> Specialization -> Value
createValueFromSpecialization :: Context -> Specialization -> Value
createValueFromSpecialization Context
context specialization :: Specialization
specialization@(Specialization SpecializationPath
_ (ProvidedValue Dynamic
d ValueDescription
desc)) =
Dynamic
-> ValueDescription
-> Maybe SpecializationContext
-> Dependencies
-> Value
CreatedValue Dynamic
d ValueDescription
desc (forall a. a -> Maybe a
Just (Context -> Specialization -> SpecializationContext
SpecializationContext Context
context Specialization
specialization)) forall a. Monoid a => a
mempty
createValueFromSpecialization Context
_ Specialization
v = Specialization -> Value
_specializationValue Specialization
v
describeSpecializations :: Specializations -> Text
describeSpecializations :: Specializations -> Text
describeSpecializations (Specializations [Specialization]
ss) =
if forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null [Specialization]
ss
then Text
""
else Text
"specializations\n" forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
unlines (forall a b. (Show a, StringConv String b) => a -> b
P.show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Specialization]
ss)
newtype Modifiers = Modifiers [(SomeTypeRep, ModifierFunction)] deriving (NonEmpty Modifiers -> Modifiers
Modifiers -> Modifiers -> 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 :: forall b. Integral b => 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
[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
Monoid)
type ModifierFunction = Maybe [SpecializationPath] -> Function
createConstModifierFunction :: (Typeable f) => f -> ModifierFunction
createConstModifierFunction :: forall f. Typeable f => f -> ModifierFunction
createConstModifierFunction f
f = forall a b. a -> b -> a
const (forall f. Typeable f => f -> Function
createFunction f
f)
instance Show Modifiers where
show :: Modifiers -> String
show = forall a b. ConvertText a b => a -> b
toS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Modifiers -> Text
describeModifiers
describeModifiers :: Modifiers -> Text
describeModifiers :: Modifiers -> Text
describeModifiers (Modifiers [(SomeTypeRep, ModifierFunction)]
ms) =
if forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null [(SomeTypeRep, ModifierFunction)]
ms
then Text
""
else Text
"modifiers for types\n" forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
unlines (forall a b. (Show a, StringConv String b) => a -> b
P.show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(SomeTypeRep, ModifierFunction)]
ms)