{-# 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 Data.Text as T hiding (last)
import Prelude (show)
import Protolude as P hiding (show)
import qualified Protolude as P
import Type.Reflection
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)
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)
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)
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
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
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)
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 Context
-> Maybe Specialization
-> Dependencies
-> Value
CreatedValue Dynamic
d ValueDescription
desc Maybe Context
forall a. Maybe a
Nothing Maybe Specialization
forall a. Maybe a
Nothing
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)
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)
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
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
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
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
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
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
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
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
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
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)
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)
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)
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
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
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 (Dynamic -> SomeTypeRep)
-> (Function -> Dynamic) -> Function -> SomeTypeRep
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 [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
out])
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
data Typed a =
TypedValue Value
| TypedFunction Function
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)
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)
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)
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)
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)
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)
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
(<>)
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
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)
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)
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)
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)
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)
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
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
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
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
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)
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))
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)
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
createValueFromSpecialization :: Context -> Specialization -> Value
createValueFromSpecialization :: Context -> Specialization -> Value
createValueFromSpecialization Context
context specialization :: Specialization
specialization@(Specialization SpecializationPath
_ (ProvidedValue Dynamic
d ValueDescription
desc)) =
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
createValueFromSpecialization Context
_ Specialization
v = Specialization -> Value
_specializationValue Specialization
v
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)
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
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
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)