-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Autodoc for numeric errors.
module Lorentz.Errors.Numeric.Doc
  ( DDescribeErrorTagMap (..)
  , applyErrorTagToErrorsDoc
  , applyErrorTagToErrorsDocWith
  , NumericErrorDocHandler
  , NumericErrorDocHandlerError
  , customErrorDocHandler
  , voidResultDocHandler
  , baseErrorDocHandlers

    -- * Internals
  , 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

-- | Adds a section which explains error tag mapping.
data DDescribeErrorTagMap = DDescribeErrorTagMap
  { DDescribeErrorTagMap -> Text
detmSrcLoc :: Text
    -- ^ Describes where the error tag map is defined in Haskell code.
  }
  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.
    |]
    -- TODO [TM-376]: update the comment above on how to work with our errors
    -- from Haskell

-- | Anchor which refers to the section describing error tag mapping.
dDescribeErrorTagMapAnchor :: Anchor
dDescribeErrorTagMapAnchor :: Anchor
dDescribeErrorTagMapAnchor = Text -> Anchor
Anchor Text
"about-error-tags-mapping"

-- | Errors for 'NumericErrorDocHandler'
data NumericErrorDocHandlerError
  = EheNotApplicable
    -- ^ Given handler is not suitable, probably another one will fit.
  | EheConversionUnnecessary
    -- ^ Given handler suits and tells that given error should remain unchanged.

data SomeErrorWithDoc = forall err. ErrorHasDoc err => SomeErrorWithDoc (Proxy err)

-- | Handler which changes documentation for one particular error type.
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
  }

-- | Modify documentation generated for given code so that all 'CustomError'
-- mention not their textual error tag rather respective numeric one from the
-- given map.
--
-- If some documented error is not present in the map, it remains unmodified.
-- This function may fail with 'error' if contract uses some uncommon errors,
-- see 'applyErrorTagToErrorsDocWith' for details.
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

-- | Extended version of 'applyErrorTagToErrorsDoc' which accepts error
-- handlers.
--
-- In most cases that function should be enough for your purposes, but it uses
-- a fixed set of base handlers which may be not enough in case when you define
-- your own errors. In this case define and pass all the necessary handlers to
-- this function.
--
-- It fails with 'error' if some of the errors used in the contract cannot be
-- handled with given handlers.
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)

-- | Handler for all 'CustomError's.
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

-- | Handler for 'VoidResult'.
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

-- | Handler for textual error messages.
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

-- | Handlers for most common errors defined in Lorentz.
baseErrorDocHandlers :: [NumericErrorDocHandler]
baseErrorDocHandlers :: [NumericErrorDocHandler]
baseErrorDocHandlers =
  [ NumericErrorDocHandler
customErrorDocHandler
  , NumericErrorDocHandler
voidResultDocHandler
  , NumericErrorDocHandler
textErrorDocHandler
  ]

-- | Pseudo error which stands for textual errors converted to numeric codes.
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
"."

-- | Some error with a numeric tag attached.
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)
        ]

-- | Helper typeclass which overloads representation for errors.
class ErrorHasNumericDoc err where
  -- | Error representation with respect to tags being changed to numeric ones.
  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