{-# 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 Data.Typeable (Typeable)
import qualified Prelude (error)
import Protolude as P hiding (Constructor)
import Type.Reflection
make :: forall a ins out .
(Typeable a, Contains a out, Solvable ins out)
=> Registry ins out
-> a
make = makeUnsafe
makeFast :: forall a ins out .
(Typeable a, Contains a out)
=> Registry ins out
-> a
makeFast = makeUnsafe
makeEither :: forall a ins out . (Typeable a) => Registry ins out -> Either Text a
makeEither = makeEitherWithContext (Context [(someTypeRep (Proxy :: Proxy a), Nothing)])
makeUnsafe :: forall a ins out . (Typeable a) => Registry ins out -> a
makeUnsafe registry =
case makeEither registry of
Right a -> a
Left e -> Prelude.error (toS e)
makeSpecialized :: forall a b ins out . (Typeable a, Typeable b, Contains b out, Solvable ins out) => Registry ins out -> b
makeSpecialized = makeSpecializedUnsafe @a @b
makeSpecializedPath :: forall path b ins out . (PathToTypeReps path, Typeable b, Contains b out, Solvable ins out) => Registry ins out -> b
makeSpecializedPath = makeSpecializedPathUnsafe @path @b
makeSpecializedFast :: forall a b ins out . (Typeable a, Typeable b, Contains b out) => Registry ins out -> b
makeSpecializedFast = makeSpecializedUnsafe @a @b
makeSpecializedPathFast :: forall path b ins out . (PathToTypeReps path, Typeable b, Contains b out) => Registry ins out -> b
makeSpecializedPathFast = makeSpecializedPathUnsafe @path @b
makeSpecializedUnsafe :: forall a b ins out . (Typeable a, Typeable b) => Registry ins out -> b
makeSpecializedUnsafe registry =
case makeSpecializedEither @a @b registry of
Right a -> a
Left e -> Prelude.error (toS e)
makeSpecializedPathUnsafe :: forall path b ins out . (PathToTypeReps path, Typeable b) => Registry ins out -> b
makeSpecializedPathUnsafe registry =
case makeSpecializedPathEither @path @b registry of
Right a -> a
Left e -> Prelude.error (toS e)
makeSpecializedEither :: forall a b ins out . (Typeable a, Typeable b) => Registry ins out -> Either Text b
makeSpecializedEither = makeEitherWithContext (Context [(someTypeRep (Proxy :: Proxy a), Nothing), (someTypeRep (Proxy :: Proxy b), Nothing)])
makeSpecializedPathEither :: forall path b ins out . (PathToTypeReps path, Typeable b) => Registry ins out -> Either Text b
makeSpecializedPathEither = makeEitherWithContext (Context (fmap (\t -> (t, Nothing)) $ toList $ someTypeReps (Proxy :: Proxy path)))
makeEitherWithContext :: forall a ins out . (Typeable a) => Context -> Registry ins out -> Either Text a
makeEitherWithContext context registry =
let values = _values registry
functions = _functions registry
specializations = _specializations registry
modifiers = _modifiers registry
targetType = someTypeRep (Proxy :: Proxy a)
in
case
runStackWithValues values
(makeUntyped targetType context functions specializations modifiers)
of
Left e ->
Left $
"\nThe registry is"
<> "\n\n" <> show registry
<> "=====================\n"
<> "\nCould not create a " <> show targetType <> " out of the registry:"
<> "\n\n" <> e
<> "\n\nYou can check the registry displayed above the ===== line to verify the current values and constructors\n"
Right Nothing ->
Left $
show registry
<> "\n could not create a " <> show targetType <> " out of the registry"
<> "\n\nYou can check the registry displayed above the ===== line to verify the current values and constructors\n"
Right (Just result) -> fromMaybe
(Left $ "could not cast the computed value to a " <> show targetType <> ". The value is of type: " <> show (valueDynTypeRep result))
(Right <$> fromDynamic (valueDyn result))