module Lorentz.Errors.Numeric.Doc
( DDescribeErrorTagMap (..)
, applyErrorTagToErrorsDoc
, applyErrorTagToErrorsDocWith
, NumericErrorDocHandler
, NumericErrorDocHandlerError
, customErrorDocHandler
, voidResultDocHandler
, baseErrorDocHandlers
, NumericErrorWrapper
) where
import Control.Monad.Cont (callCC, runCont)
import Data.Bimap qualified as Bimap
import Data.Typeable (typeRep)
import Fmt (build, pretty)
import GHC.TypeNats (Nat)
import Lorentz.Base
import Lorentz.Doc
import Lorentz.Errors
import Lorentz.Errors.Numeric.Contract
import Lorentz.Macro
import Morley.Michelson.Text (MText)
import Morley.Michelson.Typed
import Morley.Util.Markdown
import Morley.Util.Typeable
data DDescribeErrorTagMap = DDescribeErrorTagMap
{ DDescribeErrorTagMap -> Text
detmSrcLoc :: Text
}
deriving stock (DDescribeErrorTagMap -> DDescribeErrorTagMap -> Bool
(DDescribeErrorTagMap -> DDescribeErrorTagMap -> Bool)
-> (DDescribeErrorTagMap -> DDescribeErrorTagMap -> Bool)
-> Eq DDescribeErrorTagMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DDescribeErrorTagMap -> DDescribeErrorTagMap -> Bool
$c/= :: DDescribeErrorTagMap -> DDescribeErrorTagMap -> Bool
== :: DDescribeErrorTagMap -> DDescribeErrorTagMap -> Bool
$c== :: DDescribeErrorTagMap -> DDescribeErrorTagMap -> Bool
Eq, Eq DDescribeErrorTagMap
Eq DDescribeErrorTagMap
-> (DDescribeErrorTagMap -> DDescribeErrorTagMap -> Ordering)
-> (DDescribeErrorTagMap -> DDescribeErrorTagMap -> Bool)
-> (DDescribeErrorTagMap -> DDescribeErrorTagMap -> Bool)
-> (DDescribeErrorTagMap -> DDescribeErrorTagMap -> Bool)
-> (DDescribeErrorTagMap -> DDescribeErrorTagMap -> Bool)
-> (DDescribeErrorTagMap
-> DDescribeErrorTagMap -> DDescribeErrorTagMap)
-> (DDescribeErrorTagMap
-> DDescribeErrorTagMap -> DDescribeErrorTagMap)
-> Ord DDescribeErrorTagMap
DDescribeErrorTagMap -> DDescribeErrorTagMap -> Bool
DDescribeErrorTagMap -> DDescribeErrorTagMap -> Ordering
DDescribeErrorTagMap
-> DDescribeErrorTagMap -> DDescribeErrorTagMap
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DDescribeErrorTagMap
-> DDescribeErrorTagMap -> DDescribeErrorTagMap
$cmin :: DDescribeErrorTagMap
-> DDescribeErrorTagMap -> DDescribeErrorTagMap
max :: DDescribeErrorTagMap
-> DDescribeErrorTagMap -> DDescribeErrorTagMap
$cmax :: DDescribeErrorTagMap
-> DDescribeErrorTagMap -> DDescribeErrorTagMap
>= :: DDescribeErrorTagMap -> DDescribeErrorTagMap -> Bool
$c>= :: DDescribeErrorTagMap -> DDescribeErrorTagMap -> Bool
> :: DDescribeErrorTagMap -> DDescribeErrorTagMap -> Bool
$c> :: DDescribeErrorTagMap -> DDescribeErrorTagMap -> Bool
<= :: DDescribeErrorTagMap -> DDescribeErrorTagMap -> Bool
$c<= :: DDescribeErrorTagMap -> DDescribeErrorTagMap -> Bool
< :: DDescribeErrorTagMap -> DDescribeErrorTagMap -> Bool
$c< :: DDescribeErrorTagMap -> DDescribeErrorTagMap -> Bool
compare :: DDescribeErrorTagMap -> DDescribeErrorTagMap -> Ordering
$ccompare :: DDescribeErrorTagMap -> DDescribeErrorTagMap -> Ordering
Ord)
instance DocItem DDescribeErrorTagMap where
type DocItemPlacement DDescribeErrorTagMap = 'DocItemInDefinitions
type DocItemReferenced DDescribeErrorTagMap = 'True
docItemPos :: Natural
docItemPos = Natural
4090
docItemSectionName :: Maybe Text
docItemSectionName = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"About error tags mapping"
docItemRef :: DDescribeErrorTagMap
-> DocItemRef
(DocItemPlacement DDescribeErrorTagMap)
(DocItemReferenced DDescribeErrorTagMap)
docItemRef DDescribeErrorTagMap{Text
detmSrcLoc :: Text
detmSrcLoc :: DDescribeErrorTagMap -> Text
..} = DocItemId -> DocItemRef 'DocItemInDefinitions 'True
DocItemRef (DocItemId -> DocItemRef 'DocItemInDefinitions 'True)
-> DocItemId -> DocItemRef 'DocItemInDefinitions 'True
forall a b. (a -> b) -> a -> b
$
Text -> DocItemId
DocItemId (Text -> DocItemId) -> Text -> DocItemId
forall a b. (a -> b) -> a -> b
$ Text
"error-mapping-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
detmSrcLoc
docItemToMarkdown :: HeaderLevel -> DDescribeErrorTagMap -> Markdown
docItemToMarkdown HeaderLevel
_ DDescribeErrorTagMap{Text
detmSrcLoc :: Text
detmSrcLoc :: DDescribeErrorTagMap -> Text
..} = [md|
This contract uses numeric representation of error tags.
Nevertheless, the original Lorentz code operates with string tags which are
later mapped to naturals.
If you need to handle errors produced by this contract, we recommend
converting numeric tags back to strings first, preserving textual tags which
are already present, and then pattern-match on textual tags.
This conversion can be performed with the help of the error tag map defined
at `#{detmSrcLoc}`.
Note that some errors can still use a textual tag, for instance to
satisfy rules of an interface.
In [TM-376](https://issues.serokell.io/issue/TM-376) we are going to provide
more type-safe and convenient mechanisms for errors handling.
|]
dDescribeErrorTagMapAnchor :: Anchor
dDescribeErrorTagMapAnchor :: Anchor
dDescribeErrorTagMapAnchor = Text -> Anchor
Anchor Text
"about-error-tags-mapping"
data NumericErrorDocHandlerError
= EheNotApplicable
| EheConversionUnnecessary
data SomeErrorWithDoc = forall err. ErrorHasDoc err => SomeErrorWithDoc (Proxy err)
newtype NumericErrorDocHandler =
NumericErrorDocHandler
{ NumericErrorDocHandler
-> forall givenErr.
ErrorHasDoc givenErr =>
ErrorTagMap
-> Proxy givenErr
-> Either NumericErrorDocHandlerError SomeErrorWithDoc
_unNumericErrorDocHandler
:: forall givenErr.
(ErrorHasDoc givenErr)
=> ErrorTagMap
-> Proxy givenErr
-> Either NumericErrorDocHandlerError SomeErrorWithDoc
}
applyErrorTagToErrorsDoc
:: HasCallStack
=> ErrorTagMap -> inp :-> out -> inp :-> out
applyErrorTagToErrorsDoc :: forall (inp :: [*]) (out :: [*]).
HasCallStack =>
ErrorTagMap -> (inp :-> out) -> inp :-> out
applyErrorTagToErrorsDoc = [NumericErrorDocHandler]
-> ErrorTagMap -> (inp :-> out) -> inp :-> out
forall (inp :: [*]) (out :: [*]).
HasCallStack =>
[NumericErrorDocHandler]
-> ErrorTagMap -> (inp :-> out) -> inp :-> out
applyErrorTagToErrorsDocWith [NumericErrorDocHandler]
baseErrorDocHandlers
applyErrorTagToErrorsDocWith
:: HasCallStack
=> [NumericErrorDocHandler]
-> ErrorTagMap
-> inp :-> out
-> inp :-> out
applyErrorTagToErrorsDocWith :: forall (inp :: [*]) (out :: [*]).
HasCallStack =>
[NumericErrorDocHandler]
-> ErrorTagMap -> (inp :-> out) -> inp :-> out
applyErrorTagToErrorsDocWith [NumericErrorDocHandler]
handlers ErrorTagMap
errorTagMap =
forall a i1 i2.
(ContainsUpdateableDoc a, DocItem i1, DocItem i2) =>
(i1 -> Maybe i2) -> a -> a
modifyDoc @_ @DThrows ((DThrows -> Maybe DThrows) -> (inp :-> out) -> inp :-> out)
-> (DThrows -> Maybe DThrows) -> (inp :-> out) -> inp :-> out
forall a b. (a -> b) -> a -> b
$
\(DThrows Proxy e
ep) ->
(Cont (Maybe DThrows) (Maybe DThrows)
-> (Maybe DThrows -> Maybe DThrows) -> Maybe DThrows)
-> (Maybe DThrows -> Maybe DThrows)
-> Cont (Maybe DThrows) (Maybe DThrows)
-> Maybe DThrows
forall a b c. (a -> b -> c) -> b -> a -> c
flip Cont (Maybe DThrows) (Maybe DThrows)
-> (Maybe DThrows -> Maybe DThrows) -> Maybe DThrows
forall r a. Cont r a -> (a -> r) -> r
runCont Maybe DThrows -> Maybe DThrows
forall a. a -> a
id (Cont (Maybe DThrows) (Maybe DThrows) -> Maybe DThrows)
-> Cont (Maybe DThrows) (Maybe DThrows) -> Maybe DThrows
forall a b. (a -> b) -> a -> b
$
((Maybe DThrows -> ContT (Maybe DThrows) Identity ())
-> Cont (Maybe DThrows) (Maybe DThrows))
-> Cont (Maybe DThrows) (Maybe DThrows)
forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC (((Maybe DThrows -> ContT (Maybe DThrows) Identity ())
-> Cont (Maybe DThrows) (Maybe DThrows))
-> Cont (Maybe DThrows) (Maybe DThrows))
-> ((Maybe DThrows -> ContT (Maybe DThrows) Identity ())
-> Cont (Maybe DThrows) (Maybe DThrows))
-> Cont (Maybe DThrows) (Maybe DThrows)
forall a b. (a -> b) -> a -> b
$ \Maybe DThrows -> ContT (Maybe DThrows) Identity ()
quitWith -> do
[NumericErrorDocHandler]
-> (Element [NumericErrorDocHandler]
-> ContT (Maybe DThrows) Identity ())
-> ContT (Maybe DThrows) Identity ()
forall t (m :: * -> *) b.
(Container t, Monad m) =>
t -> (Element t -> m b) -> m ()
forM_ [NumericErrorDocHandler]
handlers ((Element [NumericErrorDocHandler]
-> ContT (Maybe DThrows) Identity ())
-> ContT (Maybe DThrows) Identity ())
-> (Element [NumericErrorDocHandler]
-> ContT (Maybe DThrows) Identity ())
-> ContT (Maybe DThrows) Identity ()
forall a b. (a -> b) -> a -> b
$ \(NumericErrorDocHandler forall givenErr.
ErrorHasDoc givenErr =>
ErrorTagMap
-> Proxy givenErr
-> Either NumericErrorDocHandlerError SomeErrorWithDoc
handler) ->
case ErrorTagMap
-> Proxy e -> Either NumericErrorDocHandlerError SomeErrorWithDoc
forall givenErr.
ErrorHasDoc givenErr =>
ErrorTagMap
-> Proxy givenErr
-> Either NumericErrorDocHandlerError SomeErrorWithDoc
handler ErrorTagMap
errorTagMap Proxy e
ep of
Left NumericErrorDocHandlerError
EheNotApplicable -> ContT (Maybe DThrows) Identity ()
forall (f :: * -> *). Applicative f => f ()
pass
Left NumericErrorDocHandlerError
EheConversionUnnecessary -> Maybe DThrows -> ContT (Maybe DThrows) Identity ()
quitWith Maybe DThrows
forall a. Maybe a
Nothing
Right (SomeErrorWithDoc Proxy err
nep) -> Maybe DThrows -> ContT (Maybe DThrows) Identity ()
quitWith (Maybe DThrows -> ContT (Maybe DThrows) Identity ())
-> Maybe DThrows -> ContT (Maybe DThrows) Identity ()
forall a b. (a -> b) -> a -> b
$ DThrows -> Maybe DThrows
forall a. a -> Maybe a
Just (Proxy err -> DThrows
forall e. ErrorHasDoc e => Proxy e -> DThrows
DThrows Proxy err
nep)
Text -> Cont (Maybe DThrows) (Maybe DThrows)
forall a. HasCallStack => Text -> a
error (Text -> Cont (Maybe DThrows) (Maybe DThrows))
-> Text -> Cont (Maybe DThrows) (Maybe DThrows)
forall a b. (a -> b) -> a -> b
$ Text
"No handler found for error " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show (Proxy e -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy e
ep)
mkGeneralNumericWrapper
:: forall err.
(ErrorHasDoc err, ErrorHasNumericDoc err)
=> ErrorTagMap
-> MText
-> Either NumericErrorDocHandlerError SomeErrorWithDoc
mkGeneralNumericWrapper :: forall err.
(ErrorHasDoc err, ErrorHasNumericDoc err) =>
ErrorTagMap
-> MText -> Either NumericErrorDocHandlerError SomeErrorWithDoc
mkGeneralNumericWrapper ErrorTagMap
errorTagMap MText
strTag = do
Natural
numErrTag <- MText -> ErrorTagMap -> Maybe Natural
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
b -> Bimap a b -> m a
Bimap.lookupR MText
strTag ErrorTagMap
errorTagMap
Maybe Natural
-> (Maybe Natural -> Either NumericErrorDocHandlerError Natural)
-> Either NumericErrorDocHandlerError Natural
forall a b. a -> (a -> b) -> b
& NumericErrorDocHandlerError
-> Maybe Natural -> Either NumericErrorDocHandlerError Natural
forall l r. l -> Maybe r -> Either l r
maybeToRight NumericErrorDocHandlerError
EheConversionUnnecessary
SomeNat (Proxy n
_ :: Proxy numTag) <- SomeNat -> Either NumericErrorDocHandlerError SomeNat
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeNat -> Either NumericErrorDocHandlerError SomeNat)
-> SomeNat -> Either NumericErrorDocHandlerError SomeNat
forall a b. (a -> b) -> a -> b
$ Natural -> SomeNat
someNatVal Natural
numErrTag
SomeErrorWithDoc
-> Either NumericErrorDocHandlerError SomeErrorWithDoc
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeErrorWithDoc
-> Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> SomeErrorWithDoc
-> Either NumericErrorDocHandlerError SomeErrorWithDoc
forall a b. (a -> b) -> a -> b
$ Proxy (NumericErrorWrapper n err) -> SomeErrorWithDoc
forall err. ErrorHasDoc err => Proxy err -> SomeErrorWithDoc
SomeErrorWithDoc (Proxy (NumericErrorWrapper n err) -> SomeErrorWithDoc)
-> Proxy (NumericErrorWrapper n err) -> SomeErrorWithDoc
forall a b. (a -> b) -> a -> b
$ forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(NumericErrorWrapper numTag err)
customErrorDocHandler :: NumericErrorDocHandler
customErrorDocHandler :: NumericErrorDocHandler
customErrorDocHandler = (forall givenErr.
ErrorHasDoc givenErr =>
ErrorTagMap
-> Proxy givenErr
-> Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> NumericErrorDocHandler
NumericErrorDocHandler ((forall givenErr.
ErrorHasDoc givenErr =>
ErrorTagMap
-> Proxy givenErr
-> Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> NumericErrorDocHandler)
-> (forall givenErr.
ErrorHasDoc givenErr =>
ErrorTagMap
-> Proxy givenErr
-> Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> NumericErrorDocHandler
forall a b. (a -> b) -> a -> b
$
\ErrorTagMap
errorTagMap (Proxy givenErr
_ :: Proxy givenErr) ->
Either
NumericErrorDocHandlerError
(Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> Either NumericErrorDocHandlerError SomeErrorWithDoc
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either
NumericErrorDocHandlerError
(Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> (Maybe (Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> Either
NumericErrorDocHandlerError
(Either NumericErrorDocHandlerError SomeErrorWithDoc))
-> Maybe (Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> Either NumericErrorDocHandlerError SomeErrorWithDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumericErrorDocHandlerError
-> Maybe (Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> Either
NumericErrorDocHandlerError
(Either NumericErrorDocHandlerError SomeErrorWithDoc)
forall l r. l -> Maybe r -> Either l r
maybeToRight NumericErrorDocHandlerError
EheNotApplicable (Maybe (Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> Maybe (Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> Either NumericErrorDocHandlerError SomeErrorWithDoc
forall a b. (a -> b) -> a -> b
$
forall {k1} {k2} (c :: k1 -> k2) (x :: k2) r.
(Typeable x, Typeable c) =>
(forall (a :: k1). Typeable a => (c a :~: x) -> Proxy a -> r)
-> Maybe r
forall (c :: Symbol -> *) x r.
(Typeable x, Typeable c) =>
(forall (a :: Symbol). Typeable a => (c a :~: x) -> Proxy a -> r)
-> Maybe r
eqTypeIgnoringPhantom @CustomError @givenErr ((forall (a :: Symbol).
Typeable a =>
(CustomError a :~: givenErr)
-> Proxy a -> Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> Maybe (Either NumericErrorDocHandlerError SomeErrorWithDoc))
-> (forall (a :: Symbol).
Typeable a =>
(CustomError a :~: givenErr)
-> Proxy a -> Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> Maybe (Either NumericErrorDocHandlerError SomeErrorWithDoc)
forall a b. (a -> b) -> a -> b
$ \CustomError a :~: givenErr
Refl (Proxy a
_ :: Proxy strTag) ->
case forall e. ErrorHasDoc e => Dict (ErrorRequirements e)
errorDocRequirements @(CustomError strTag) of
Dict (ErrorRequirements (CustomError a))
Dict -> do
let strTag :: MText
strTag = Label a -> MText
forall (tag :: Symbol). Label tag -> MText
errorTagToMText (forall (x :: Symbol) a. IsLabel x a => a
fromLabel @strTag)
forall err.
(ErrorHasDoc err, ErrorHasNumericDoc err) =>
ErrorTagMap
-> MText -> Either NumericErrorDocHandlerError SomeErrorWithDoc
mkGeneralNumericWrapper @givenErr ErrorTagMap
errorTagMap MText
strTag
voidResultDocHandler :: NumericErrorDocHandler
voidResultDocHandler :: NumericErrorDocHandler
voidResultDocHandler = (forall givenErr.
ErrorHasDoc givenErr =>
ErrorTagMap
-> Proxy givenErr
-> Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> NumericErrorDocHandler
NumericErrorDocHandler ((forall givenErr.
ErrorHasDoc givenErr =>
ErrorTagMap
-> Proxy givenErr
-> Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> NumericErrorDocHandler)
-> (forall givenErr.
ErrorHasDoc givenErr =>
ErrorTagMap
-> Proxy givenErr
-> Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> NumericErrorDocHandler
forall a b. (a -> b) -> a -> b
$
\ErrorTagMap
errorTagMap (Proxy givenErr
_ :: Proxy givenErr) ->
Either
NumericErrorDocHandlerError
(Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> Either NumericErrorDocHandlerError SomeErrorWithDoc
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either
NumericErrorDocHandlerError
(Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> (Maybe (Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> Either
NumericErrorDocHandlerError
(Either NumericErrorDocHandlerError SomeErrorWithDoc))
-> Maybe (Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> Either NumericErrorDocHandlerError SomeErrorWithDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumericErrorDocHandlerError
-> Maybe (Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> Either
NumericErrorDocHandlerError
(Either NumericErrorDocHandlerError SomeErrorWithDoc)
forall l r. l -> Maybe r -> Either l r
maybeToRight NumericErrorDocHandlerError
EheNotApplicable (Maybe (Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> Maybe (Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> Either NumericErrorDocHandlerError SomeErrorWithDoc
forall a b. (a -> b) -> a -> b
$
forall {k1} {k2} (c :: k1 -> k2) (x :: k2) r.
(Typeable x, Typeable c) =>
(forall (a :: k1). Typeable a => (c a :~: x) -> Proxy a -> r)
-> Maybe r
forall (c :: * -> *) x r.
(Typeable x, Typeable c) =>
(forall a. Typeable a => (c a :~: x) -> Proxy a -> r) -> Maybe r
eqTypeIgnoringPhantom @VoidResult @givenErr ((forall a.
Typeable a =>
(VoidResult a :~: givenErr)
-> Proxy a -> Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> Maybe (Either NumericErrorDocHandlerError SomeErrorWithDoc))
-> (forall a.
Typeable a =>
(VoidResult a :~: givenErr)
-> Proxy a -> Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> Maybe (Either NumericErrorDocHandlerError SomeErrorWithDoc)
forall a b. (a -> b) -> a -> b
$ \VoidResult a :~: givenErr
Refl (Proxy a
_ :: Proxy res) -> do
forall err.
(ErrorHasDoc err, ErrorHasNumericDoc err) =>
ErrorTagMap
-> MText -> Either NumericErrorDocHandlerError SomeErrorWithDoc
mkGeneralNumericWrapper @givenErr ErrorTagMap
errorTagMap MText
voidResultTag
textErrorDocHandler :: NumericErrorDocHandler
textErrorDocHandler :: NumericErrorDocHandler
textErrorDocHandler = (forall givenErr.
ErrorHasDoc givenErr =>
ErrorTagMap
-> Proxy givenErr
-> Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> NumericErrorDocHandler
NumericErrorDocHandler ((forall givenErr.
ErrorHasDoc givenErr =>
ErrorTagMap
-> Proxy givenErr
-> Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> NumericErrorDocHandler)
-> (forall givenErr.
ErrorHasDoc givenErr =>
ErrorTagMap
-> Proxy givenErr
-> Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> NumericErrorDocHandler
forall a b. (a -> b) -> a -> b
$
\ErrorTagMap
_errorTagMap (Proxy givenErr
_ :: Proxy givenErr) ->
case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @givenErr @MText of
Maybe (givenErr :~: MText)
Nothing -> NumericErrorDocHandlerError
-> Either NumericErrorDocHandlerError SomeErrorWithDoc
forall a b. a -> Either a b
Left NumericErrorDocHandlerError
EheNotApplicable
Just givenErr :~: MText
Refl -> SomeErrorWithDoc
-> Either NumericErrorDocHandlerError SomeErrorWithDoc
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeErrorWithDoc
-> Either NumericErrorDocHandlerError SomeErrorWithDoc)
-> SomeErrorWithDoc
-> Either NumericErrorDocHandlerError SomeErrorWithDoc
forall a b. (a -> b) -> a -> b
$ Proxy NumericTextError -> SomeErrorWithDoc
forall err. ErrorHasDoc err => Proxy err -> SomeErrorWithDoc
SomeErrorWithDoc (Proxy NumericTextError -> SomeErrorWithDoc)
-> Proxy NumericTextError -> SomeErrorWithDoc
forall a b. (a -> b) -> a -> b
$ forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @NumericTextError
baseErrorDocHandlers :: [NumericErrorDocHandler]
baseErrorDocHandlers :: [NumericErrorDocHandler]
baseErrorDocHandlers =
[ NumericErrorDocHandler
customErrorDocHandler
, NumericErrorDocHandler
voidResultDocHandler
, NumericErrorDocHandler
textErrorDocHandler
]
data NumericTextError
instance ErrorHasDoc NumericTextError where
errorDocName :: Text
errorDocName = forall e. ErrorHasDoc e => Text
errorDocName @MText
errorDocMdCause :: Markdown
errorDocMdCause = forall e. ErrorHasDoc e => Markdown
errorDocMdCause @MText
errorDocMdCauseInEntrypoint :: Markdown
errorDocMdCauseInEntrypoint = forall e. ErrorHasDoc e => Markdown
errorDocMdCauseInEntrypoint @MText
errorDocClass :: ErrorClass
errorDocClass = forall e. ErrorHasDoc e => ErrorClass
errorDocClass @MText
errorDocDependencies :: [SomeDocDefinitionItem]
errorDocDependencies = [DType -> SomeDocDefinitionItem
forall d.
(DocItem d, DocItemPlacement d ~ 'DocItemInDefinitions) =>
d -> SomeDocDefinitionItem
SomeDocDefinitionItem (Proxy Natural -> DType
forall a. TypeHasDoc a => Proxy a -> DType
DType (Proxy Natural -> DType) -> Proxy Natural -> DType
forall a b. (a -> b) -> a -> b
$ forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Natural)]
errorDocHaskellRep :: Markdown
errorDocHaskellRep =
Markdown
"Numeric code for an error message, see also " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<>
Markdown -> Anchor -> Markdown
forall anchor. ToAnchor anchor => Markdown -> anchor -> Markdown
mdLocalRef Markdown
"error tags mapping" Anchor
dDescribeErrorTagMapAnchor Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
"."
data NumericErrorWrapper (numTag :: Nat) (err :: Type)
instance ( ErrorHasDoc err
, KnownNat numTag, ErrorHasNumericDoc err
) =>
ErrorHasDoc (NumericErrorWrapper numTag err) where
errorDocName :: Text
errorDocName = forall e. ErrorHasDoc e => Text
errorDocName @err
errorDocMdCause :: Markdown
errorDocMdCause = forall e. ErrorHasDoc e => Markdown
errorDocMdCause @err
errorDocMdCauseInEntrypoint :: Markdown
errorDocMdCauseInEntrypoint = forall e. ErrorHasDoc e => Markdown
errorDocMdCauseInEntrypoint @err
errorDocClass :: ErrorClass
errorDocClass = forall e. ErrorHasDoc e => ErrorClass
errorDocClass @err
errorDocDependencies :: [SomeDocDefinitionItem]
errorDocDependencies = forall e. ErrorHasDoc e => [SomeDocDefinitionItem]
errorDocDependencies @err
errorDocHaskellRep :: Markdown
errorDocHaskellRep =
case forall e. ErrorHasDoc e => Dict (ErrorRequirements e)
errorDocRequirements @err of
Dict (ErrorRequirements err)
Dict -> [Markdown] -> Markdown
forall a. Monoid a => [a] -> a
mconcat
[ let numTag :: Text
numTag = Natural -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (Proxy numTag -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal (Proxy numTag -> Natural) -> Proxy numTag -> Natural
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall {t :: Nat}. Proxy t
Proxy @numTag) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" :: nat"
in forall err.
(ErrorHasNumericDoc err, ErrorRequirements err) =>
Text -> Markdown
numericErrorDocHaskellRep @err Text
numTag
, Markdown
"\n\n"
, Markdown -> Markdown -> Markdown
mdSubsection Markdown
"Respective textual tag" (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$
Markdown -> Markdown
mdTicked (Text -> Markdown
forall p. Buildable p => p -> Markdown
build (Text -> Markdown) -> Text -> Markdown
forall a b. (a -> b) -> a -> b
$ forall err. (ErrorHasNumericDoc err, ErrorRequirements err) => Text
numericErrorDocTextualTag @err)
]
class ErrorHasNumericDoc err where
numericErrorDocHaskellRep :: ErrorRequirements err => Text -> Markdown
numericErrorDocTextualTag :: ErrorRequirements err => Text
instance ErrorHasNumericDoc (CustomError tag) where
numericErrorDocHaskellRep :: ErrorRequirements (CustomError tag) => Text -> Markdown
numericErrorDocHaskellRep Text
_ = forall a (tag :: Symbol).
(IsCustomErrorArgRep a, KnownSymbol tag, CustomErrorHasDoc tag) =>
Proxy tag -> Markdown
customErrorHaskellRep @(CustomErrorRep tag) (forall {k} (t :: k). Proxy t
forall {t :: Symbol}. Proxy t
Proxy @tag)
numericErrorDocTextualTag :: ErrorRequirements (CustomError tag) => Text
numericErrorDocTextualTag = forall (tag :: Symbol). KnownSymbol tag => Text
errorTagToText @tag
instance ErrorHasDoc (VoidResult res) =>
ErrorHasNumericDoc (VoidResult res) where
numericErrorDocHaskellRep :: ErrorRequirements (VoidResult res) => Text -> Markdown
numericErrorDocHaskellRep Text
numTag =
case forall e. ErrorHasDoc e => Dict (ErrorRequirements e)
errorDocRequirements @(VoidResult res) of
Dict (ErrorRequirements (VoidResult res))
Dict -> Markdown -> Markdown
mdTicked (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$ Markdown
"(" Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Text -> Markdown
forall p. Buildable p => p -> Markdown
build Text
numTag Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
", " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
"<return value>" Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
")"
numericErrorDocTextualTag :: ErrorRequirements (VoidResult res) => Text
numericErrorDocTextualTag = MText -> Text
forall a. ToText a => a -> Text
toText MText
voidResultTag