{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Registry.Make where
import Data.Dynamic
import Data.Registry.Internal.Make
import Data.Registry.Internal.Stack
import Data.Registry.Internal.Types
import Data.Registry.Registry
import Data.Registry.Solver
import Protolude as P hiding (Constructor)
import Type.Reflection
import qualified Prelude (error)
make :: forall a ins out. (Typeable a) => Registry ins out -> a
make :: Registry ins out -> a
make Registry ins out
registry =
case Registry ins out -> Either Text a
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Registry ins out -> Either Text a
makeEither Registry ins out
registry of
Right a
a -> a
a
Left Text
e -> [Char] -> a
forall a. HasCallStack => [Char] -> a
Prelude.error (Text -> [Char]
forall a b. ConvertText a b => a -> b
toS Text
e)
makeSafe :: forall a ins out. (Typeable a, Solvable ins out) => Registry ins out -> a
makeSafe :: Registry ins out -> a
makeSafe = Registry ins out -> a
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Registry ins out -> a
make
makeEither :: forall a ins out. (Typeable a) => Registry ins out -> Either Text a
makeEither :: Registry ins out -> Either Text a
makeEither = Context -> Registry ins out -> Either Text a
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Context -> Registry ins out -> Either Text a
makeEitherWithContext ([(SomeTypeRep, Maybe SomeTypeRep)] -> Context
Context [(Proxy a -> SomeTypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
someTypeRep (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a), Maybe SomeTypeRep
forall a. Maybe a
Nothing)])
makeSpecialized :: forall a b ins out. (Typeable a, Typeable b) => Registry ins out -> b
makeSpecialized :: Registry ins out -> b
makeSpecialized Registry ins out
registry =
case Registry ins out -> Either Text b
forall k (a :: k) b (ins :: [*]) (out :: [*]).
(Typeable a, Typeable b) =>
Registry ins out -> Either Text b
makeSpecializedEither @a @b Registry ins out
registry of
Right b
a -> b
a
Left Text
e -> [Char] -> b
forall a. HasCallStack => [Char] -> a
Prelude.error (Text -> [Char]
forall a b. ConvertText a b => a -> b
toS Text
e)
makeSpecializedPath :: forall path b ins out. (PathToTypeReps path, Typeable b) => Registry ins out -> b
makeSpecializedPath :: Registry ins out -> b
makeSpecializedPath Registry ins out
registry =
case Registry ins out -> Either Text b
forall (path :: [*]) b (ins :: [*]) (out :: [*]).
(PathToTypeReps path, Typeable b) =>
Registry ins out -> Either Text b
makeSpecializedPathEither @path @b Registry ins out
registry of
Right b
a -> b
a
Left Text
e -> [Char] -> b
forall a. HasCallStack => [Char] -> a
Prelude.error (Text -> [Char]
forall a b. ConvertText a b => a -> b
toS Text
e)
makeSpecializedEither :: forall a b ins out. (Typeable a, Typeable b) => Registry ins out -> Either Text b
makeSpecializedEither :: Registry ins out -> Either Text b
makeSpecializedEither = Context -> Registry ins out -> Either Text b
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Context -> Registry ins out -> Either Text a
makeEitherWithContext ([(SomeTypeRep, Maybe SomeTypeRep)] -> Context
Context [(Proxy a -> SomeTypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
someTypeRep (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a), Maybe SomeTypeRep
forall a. Maybe a
Nothing), (Proxy b -> SomeTypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
someTypeRep (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b), Maybe SomeTypeRep
forall a. Maybe a
Nothing)])
makeSpecializedPathEither :: forall path b ins out. (PathToTypeReps path, Typeable b) => Registry ins out -> Either Text b
makeSpecializedPathEither :: Registry ins out -> Either Text b
makeSpecializedPathEither = Context -> Registry ins out -> Either Text b
forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Context -> Registry ins out -> Either Text a
makeEitherWithContext ([(SomeTypeRep, Maybe SomeTypeRep)] -> Context
Context ((,Maybe SomeTypeRep
forall a. Maybe a
Nothing) (SomeTypeRep -> (SomeTypeRep, Maybe SomeTypeRep))
-> [SomeTypeRep] -> [(SomeTypeRep, Maybe SomeTypeRep)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty SomeTypeRep -> [SomeTypeRep]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Proxy path -> NonEmpty SomeTypeRep
forall (path :: [*]).
PathToTypeReps path =>
Proxy path -> NonEmpty SomeTypeRep
someTypeReps (Proxy path
forall k (t :: k). Proxy t
Proxy :: Proxy path))))
makeEitherWithContext :: forall a ins out. (Typeable a) => Context -> Registry ins out -> Either Text a
makeEitherWithContext :: Context -> Registry ins out -> Either Text a
makeEitherWithContext Context
context Registry ins out
registry =
let values :: Values
values = Registry ins out -> Values
forall (inputs :: [*]) (outputs :: [*]).
Registry inputs outputs -> Values
_values Registry ins out
registry
functions :: Functions
functions = Registry ins out -> Functions
forall (inputs :: [*]) (outputs :: [*]).
Registry inputs outputs -> Functions
_functions Registry ins out
registry
specializations :: Specializations
specializations = Registry ins out -> Specializations
forall (inputs :: [*]) (outputs :: [*]).
Registry inputs outputs -> Specializations
_specializations Registry ins out
registry
modifiers :: Modifiers
modifiers = Registry ins out -> Modifiers
forall (inputs :: [*]) (outputs :: [*]).
Registry inputs outputs -> Modifiers
_modifiers Registry ins out
registry
targetType :: SomeTypeRep
targetType = Proxy a -> SomeTypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
someTypeRep (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
in
case Values -> Stack (Maybe Value) -> Either Text (Maybe Value)
forall a. Values -> Stack a -> Either Text a
runStackWithValues
Values
values
(SomeTypeRep
-> Context
-> Functions
-> Specializations
-> Modifiers
-> Stack (Maybe Value)
makeUntyped SomeTypeRep
targetType Context
context Functions
functions Specializations
specializations Modifiers
modifiers) of
Left Text
e ->
Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$
Text
"\nThe registry is"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Registry ins out -> Text
forall a b. (Show a, StringConv [Char] b) => a -> b
show Registry ins out
registry
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=====================\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\nCould not create a "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SomeTypeRep -> Text
forall a b. (Show a, StringConv [Char] b) => a -> b
show SomeTypeRep
targetType
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" out of the registry:"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\nYou can check the registry displayed above the ===== line to verify the current values and constructors\n"
Right Maybe Value
Nothing ->
Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$
Registry ins out -> Text
forall a b. (Show a, StringConv [Char] b) => a -> b
show Registry ins out
registry
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n could not create a "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SomeTypeRep -> Text
forall a b. (Show a, StringConv [Char] b) => a -> b
show SomeTypeRep
targetType
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" out of the registry"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\nYou can check the registry displayed above the ===== line to verify the current values and constructors\n"
Right (Just Value
result) ->
Either Text a -> Maybe (Either Text a) -> Either Text a
forall a. a -> Maybe a -> a
fromMaybe
(Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ Text
"could not cast the computed value to a " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SomeTypeRep -> Text
forall a b. (Show a, StringConv [Char] b) => a -> b
show SomeTypeRep
targetType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". The value is of type: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SomeTypeRep -> Text
forall a b. (Show a, StringConv [Char] b) => a -> b
show (Value -> SomeTypeRep
valueDynTypeRep Value
result))
(a -> Either Text a
forall a b. b -> Either a b
Right (a -> Either Text a) -> Maybe a -> Maybe (Either Text a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic -> Maybe a
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic (Value -> Dynamic
valueDyn Value
result))