{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.Registry.Internal.Types where
import Data.Dynamic
import Data.Registry.Internal.Reflection
import Data.Text as T
import Prelude (show)
import Protolude hiding (show)
import Type.Reflection
data Value =
CreatedValue Dynamic ValueDescription
| ProvidedValue Dynamic ValueDescription
deriving (Show)
data ValueDescription = ValueDescription {
_valueType :: Text
, _valueValue :: Maybe Text
} deriving (Eq, Show)
describeValue :: (Typeable a, Show a) => a -> ValueDescription
describeValue a = ValueDescription (showFullValueType a) (Just . toS $ show a)
describeTypeableValue :: (Typeable a) => a -> ValueDescription
describeTypeableValue a = ValueDescription (showFullValueType a) Nothing
showValue :: Value -> Text
showValue = valDescriptionToText . valDescription
createValue :: (Show a, Typeable a) => a -> Value
createValue a = ProvidedValue (toDyn a) (describeValue a)
createTypeableValue :: Typeable a => a -> Value
createTypeableValue a = ProvidedValue (toDyn a) (describeTypeableValue a)
createDynValue :: Dynamic -> Text -> Value
createDynValue dyn desc = ProvidedValue dyn (ValueDescription desc Nothing)
valueDynTypeRep :: Value -> SomeTypeRep
valueDynTypeRep (CreatedValue d _) = dynTypeRep d
valueDynTypeRep (ProvidedValue d _) = dynTypeRep d
valueDyn :: Value -> Dynamic
valueDyn (CreatedValue d _) = d
valueDyn (ProvidedValue d _) = d
valDescription :: Value -> ValueDescription
valDescription (CreatedValue _ d) = d
valDescription (ProvidedValue _ d) = d
valDescriptionToText :: ValueDescription -> Text
valDescriptionToText (ValueDescription t Nothing) = t
valDescriptionToText (ValueDescription t (Just v)) = t <> ": " <> v
data Function = Function Dynamic FunctionDescription deriving (Show)
createFunction :: (Typeable a) => a -> Function
createFunction a =
let dynType = toDyn a
in Function dynType (describeFunction a)
data FunctionDescription = FunctionDescription {
_inputTypes :: [Text]
, _outputType :: Text
} deriving (Eq, Show)
describeFunction :: Typeable a => a -> FunctionDescription
describeFunction = uncurry FunctionDescription . showFullFunctionType
showFunction :: Function -> Text
showFunction = funDescriptionToText . funDescription
funDescription :: Function -> FunctionDescription
funDescription (Function _ t) = t
funDyn :: Function -> Dynamic
funDyn (Function d _) = d
funDynTypeRep :: Function -> SomeTypeRep
funDynTypeRep = dynTypeRep . funDyn
funDescriptionToText :: FunctionDescription -> Text
funDescriptionToText (FunctionDescription ins out) = T.intercalate " -> " (ins <> [out])
hasParameters :: Function -> Bool
hasParameters = isFunction . funDynTypeRep
data Typed a =
TypedValue Value
| TypedFunction Function
newtype Functions = Functions [Function] deriving (Show, Semigroup, Monoid)
addFunction :: Function -> Functions -> Functions
addFunction f (Functions fs) = Functions (f : fs)
newtype Values = Values [Value] deriving (Show, Semigroup, Monoid)
addValue :: Value -> Values -> Values
addValue v (Values vs) = Values (v : vs)
newtype Context = Context { _context :: [SomeTypeRep] } deriving (Show, Semigroup, Monoid)
newtype Specializations = Specializations [(SomeTypeRep, Value)] deriving (Show, Semigroup, Monoid)
newtype Modifiers = Modifiers [(SomeTypeRep, Function)] deriving (Show, Semigroup, Monoid)