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

-- Dunno why it triggers
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Documentation of types appearing in contracts.
module Morley.Michelson.Typed.Haskell.Doc
  ( ADTRep
  , ConstructorRep (..)
  , crNameL, crDescriptionL, crFieldsL
  , FieldRep (..)
  , frNameL, frDescriptionL, frTypeRepL
  , WithinParens (..)
  , TypeHasDoc (..)
  , TypeDocHaskellRep
  , TypeDocMichelsonRep
  , FieldDescriptions
  , PolyTypeHasDocC
  , SomeTypeWithDoc (..)
  , typeDocBuiltMichelsonRep

  , HaveCommonTypeCtor
  , IsHomomorphic
  , genericTypeDocDependencies
  , customTypeDocMdReference
  , customTypeDocMdReference'
  , homomorphicTypeDocMdReference
  , poly1TypeDocMdReference
  , poly2TypeDocMdReference
  , homomorphicTypeDocHaskellRep
  , concreteTypeDocHaskellRep
  , unsafeConcreteTypeDocHaskellRep
  , haskellAddNewtypeField
  , haskellRepNoFields
  , haskellRepStripFieldPrefix
  , homomorphicTypeDocMichelsonRep
  , concreteTypeDocMichelsonRep
  , unsafeConcreteTypeDocMichelsonRep

  , DType (..)
  , DStorageType (..)
  , dStorage
  , GTypeHasDoc
  , GProductHasDoc
  , dTypeDep
  , dTypeDepP
  , buildADTRep
  , applyWithinParens
  , buildTypeWithinParens
  ) where

import Control.Lens (_Just, each, to)
import Data.Char (isLower, isUpper, toLower)
import Data.List (lookup)
import Data.Singletons (SingI, demote)
import Data.Text qualified as T
import Data.Typeable (typeRep, typeRepArgs)
import Fmt (Buildable, Builder, build, (+|), (|+))
import GHC.Generics ((:*:)(..), (:+:)(..))
import GHC.Generics qualified as G
import GHC.TypeLits (ErrorMessage(..), KnownSymbol, TypeError, symbolVal)
import Type.Showtype (Showtype(..))

import Morley.Michelson.Doc
import Morley.Michelson.Text
import Morley.Michelson.Typed.Aliases
import Morley.Michelson.Typed.Entrypoints
import Morley.Michelson.Typed.Haskell.ValidateDescription
import Morley.Michelson.Typed.Haskell.Value
import Morley.Michelson.Typed.T
import Morley.Tezos.Address
import Morley.Tezos.Core
import Morley.Tezos.Crypto
import Morley.Util.Generic
import Morley.Util.Lens
import Morley.Util.Markdown
import Morley.Util.Named
import Morley.Util.Typeable

-- | Stands for representation of some Haskell ADT corresponding to
-- Michelson value. Type parameter @a@ is what you put in place of
-- each field of the datatype, e.g. information about field type.
--
-- This representation also includes descriptions of constructors and fields.
type ADTRep a = [ConstructorRep a]

-- | Representation of a constructor with an optional description.
data ConstructorRep a = ConstructorRep
  { forall a. ConstructorRep a -> Text
crName :: Text
  , forall a. ConstructorRep a -> Maybe Text
crDescription :: Maybe Text
  , forall a. ConstructorRep a -> [FieldRep a]
crFields :: [FieldRep a]
  }

-- | Representation of a field with an optional description.
data FieldRep a = FieldRep
  { forall a. FieldRep a -> Maybe Text
frName :: Maybe Text
  , forall a. FieldRep a -> Maybe Text
frDescription :: Maybe Text
  , forall a. FieldRep a -> a
frTypeRep :: a
  }

makeLensesWith postfixLFields ''ConstructorRep
makeLensesWith postfixLFields ''FieldRep

-- | Show given 'ADTRep' in a neat way.
buildADTRep :: forall a. (WithinParens -> a -> Markdown) -> ADTRep a -> Markdown
buildADTRep :: forall a. (WithinParens -> a -> Markdown) -> ADTRep a -> Markdown
buildADTRep WithinParens -> a -> Markdown
buildField = \case
  [] -> Markdown -> Markdown
mdItalic Markdown
"no values"
  [ctor :: ConstructorRep a
ctor@ConstructorRep{[FieldRep a]
Maybe Text
Text
crFields :: [FieldRep a]
crDescription :: Maybe Text
crName :: Text
crFields :: forall a. ConstructorRep a -> [FieldRep a]
crDescription :: forall a. ConstructorRep a -> Maybe Text
crName :: forall a. ConstructorRep a -> Text
..}] -> WithinParens -> ConstructorRep a -> [FieldRep a] -> Markdown
renderProduct (Bool -> WithinParens
WithinParens Bool
False) ConstructorRep a
ctor [FieldRep a]
crFields
  [ConstructorRep a]
ps -> (Markdown -> Markdown -> Markdown
forall a. Monoid a => a -> a -> a
mappend (Markdown -> Markdown
mdItalic Markdown
"one of" Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
" \n")) (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$
        (Element [ConstructorRep a] -> Markdown)
-> [ConstructorRep a] -> Markdown
forall t m. (Container t, Monoid m) => (Element t -> m) -> t -> m
foldMap
        (Markdown -> Markdown
forall {a}. (Semigroup a, IsString a) => a -> a
toListItem (Markdown -> Markdown)
-> (ConstructorRep a -> Markdown) -> ConstructorRep a -> Markdown
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithinParens -> ConstructorRep a -> Markdown
renderNamedProduct (Bool -> WithinParens
WithinParens Bool
True)) ([ConstructorRep a] -> [Element [ConstructorRep a]]
forall t. Container t => t -> [Element t]
toList [ConstructorRep a]
ps)
  where
    toListItem :: a -> a
toListItem a
item = a
"+ " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
item a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"\n"

    renderNamedProduct :: WithinParens -> ConstructorRep a -> Markdown
    renderNamedProduct :: WithinParens -> ConstructorRep a -> Markdown
renderNamedProduct WithinParens
wp ctor :: ConstructorRep a
ctor@ConstructorRep{[FieldRep a]
Maybe Text
Text
crFields :: [FieldRep a]
crDescription :: Maybe Text
crName :: Text
crFields :: forall a. ConstructorRep a -> [FieldRep a]
crDescription :: forall a. ConstructorRep a -> Maybe Text
crName :: forall a. ConstructorRep a -> Text
..} =
      Markdown -> Markdown
mdBold (Text -> Markdown
forall p. Buildable p => p -> Markdown
build Text
crName) Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<>
      if Bool
hasFieldNames
         then Markdown -> (Text -> Markdown) -> Maybe Text -> Markdown
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Markdown
"" (\Text
d -> Markdown
": " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Text -> Markdown
forall p. Buildable p => p -> Markdown
build Text
d Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
" ") Maybe Text
crDescription Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<>
              WithinParens -> ConstructorRep a -> [FieldRep a] -> Markdown
renderProduct WithinParens
wp ConstructorRep a
ctor [FieldRep a]
crFields
         else WithinParens -> ConstructorRep a -> [FieldRep a] -> Markdown
renderProduct WithinParens
wp ConstructorRep a
ctor [FieldRep a]
crFields Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<>
              Markdown -> (Text -> Markdown) -> Maybe Text -> Markdown
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Markdown
"" (\Text
d -> Markdown
": " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Text -> Markdown
forall p. Buildable p => p -> Markdown
build Text
d) Maybe Text
crDescription
      where
        hasFieldNames :: Bool
hasFieldNames = (Element [FieldRep a] -> Bool) -> [FieldRep a] -> Bool
forall t. Container t => (Element t -> Bool) -> t -> Bool
any (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Text -> Bool)
-> (FieldRep a -> Maybe Text) -> FieldRep a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldRep a -> Maybe Text
forall a. FieldRep a -> Maybe Text
frName) [FieldRep a]
crFields

    renderProduct :: WithinParens -> ConstructorRep a -> [FieldRep a] -> Markdown
    renderProduct :: WithinParens -> ConstructorRep a -> [FieldRep a] -> Markdown
renderProduct WithinParens
wp ConstructorRep a
ctor = \case
      [] -> Markdown
"()"
      [t :: FieldRep a
t@FieldRep{ frDescription :: forall a. FieldRep a -> Maybe Text
frDescription = Maybe Text
Nothing }]
        | Maybe Text
Nothing <- ConstructorRep a -> Maybe Text
forall a. ConstructorRep a -> Maybe Text
crDescription ConstructorRep a
ctor -> WithinParens -> FieldRep a -> Markdown
renderNamedField WithinParens
wp FieldRep a
t
      [FieldRep a]
ts -> [Markdown] -> Markdown
forall a. Monoid a => [a] -> a
mconcat ([Markdown] -> Markdown) -> [Markdown] -> Markdown
forall a b. (a -> b) -> a -> b
$ (FieldRep a -> Markdown) -> [FieldRep a] -> [Markdown]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((Markdown
"\n  * " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<>) (Markdown -> Markdown)
-> (FieldRep a -> Markdown) -> FieldRep a -> Markdown
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithinParens -> FieldRep a -> Markdown
renderNamedField WithinParens
wp) [FieldRep a]
ts

    renderNamedField :: WithinParens -> FieldRep a -> Markdown
    renderNamedField :: WithinParens -> FieldRep a -> Markdown
renderNamedField WithinParens
wp FieldRep{a
Maybe Text
frTypeRep :: a
frDescription :: Maybe Text
frName :: Maybe Text
frTypeRep :: forall a. FieldRep a -> a
frDescription :: forall a. FieldRep a -> Maybe Text
frName :: forall a. FieldRep a -> Maybe Text
..} = [Markdown] -> Markdown
forall a. Monoid a => [a] -> a
mconcat
      [ Markdown -> (Text -> Markdown) -> Maybe Text -> Markdown
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Markdown
"" Text -> Markdown
buildFieldName Maybe Text
frName
      , WithinParens -> a -> Markdown
buildField WithinParens
wp a
frTypeRep
      , Markdown -> (Text -> Markdown) -> Maybe Text -> Markdown
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Markdown
"" (Markdown -> Markdown -> Markdown
forall a. Monoid a => a -> a -> a
mappend Markdown
"    " (Markdown -> Markdown) -> (Text -> Markdown) -> Text -> Markdown
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Markdown -> Markdown -> Markdown
forall a. Monoid a => a -> a -> a
mappend Markdown
"\n" (Markdown -> Markdown) -> (Text -> Markdown) -> Text -> Markdown
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Markdown
forall p. Buildable p => p -> Markdown
build) Maybe Text
frDescription
      ]

-- | Map field names in a 'ADTRep', with the possibility to remove some names by
-- mapping them to 'Nothing'.
mapADTRepFields :: (Maybe Text -> Maybe Text) -> ADTRep a -> ADTRep a
mapADTRepFields :: forall a. (Maybe Text -> Maybe Text) -> ADTRep a -> ADTRep a
mapADTRepFields = ASetter (ADTRep a) (ADTRep a) (Maybe Text) (Maybe Text)
-> (Maybe Text -> Maybe Text) -> ADTRep a -> ADTRep a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (ASetter (ADTRep a) (ADTRep a) (Maybe Text) (Maybe Text)
 -> (Maybe Text -> Maybe Text) -> ADTRep a -> ADTRep a)
-> ASetter (ADTRep a) (ADTRep a) (Maybe Text) (Maybe Text)
-> (Maybe Text -> Maybe Text)
-> ADTRep a
-> ADTRep a
forall a b. (a -> b) -> a -> b
$ (ConstructorRep a -> Identity (ConstructorRep a))
-> ADTRep a -> Identity (ADTRep a)
forall s t a b. Each s t a b => Traversal s t a b
each ((ConstructorRep a -> Identity (ConstructorRep a))
 -> ADTRep a -> Identity (ADTRep a))
-> ((Maybe Text -> Identity (Maybe Text))
    -> ConstructorRep a -> Identity (ConstructorRep a))
-> ASetter (ADTRep a) (ADTRep a) (Maybe Text) (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FieldRep a] -> Identity [FieldRep a])
-> ConstructorRep a -> Identity (ConstructorRep a)
forall a a.
Lens
  (ConstructorRep a) (ConstructorRep a) [FieldRep a] [FieldRep a]
crFieldsL (([FieldRep a] -> Identity [FieldRep a])
 -> ConstructorRep a -> Identity (ConstructorRep a))
-> ((Maybe Text -> Identity (Maybe Text))
    -> [FieldRep a] -> Identity [FieldRep a])
-> (Maybe Text -> Identity (Maybe Text))
-> ConstructorRep a
-> Identity (ConstructorRep a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldRep a -> Identity (FieldRep a))
-> [FieldRep a] -> Identity [FieldRep a]
forall s t a b. Each s t a b => Traversal s t a b
each ((FieldRep a -> Identity (FieldRep a))
 -> [FieldRep a] -> Identity [FieldRep a])
-> ((Maybe Text -> Identity (Maybe Text))
    -> FieldRep a -> Identity (FieldRep a))
-> (Maybe Text -> Identity (Maybe Text))
-> [FieldRep a]
-> Identity [FieldRep a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text))
-> FieldRep a -> Identity (FieldRep a)
forall a. Lens' (FieldRep a) (Maybe Text)
frNameL

-- | How field names should be displayed.
--
-- Result of this function call should appear right before rendered type
-- of that field.
buildFieldName :: Text -> Markdown
buildFieldName :: Text -> Markdown
buildFieldName Text
name = Markdown -> Markdown
mdItalic (Markdown -> Markdown
mdBold (Text -> Markdown
forall p. Buildable p => p -> Markdown
build Text
name)) Markdown -> Markdown -> Markdown
forall a b. (Buildable a, FromBuilder b) => a -> Markdown -> b
|+ Markdown
" :"

-- | Whether given text should be rendered grouped in parentheses
-- (if they make sense).
newtype WithinParens = WithinParens Bool

applyWithinParens :: WithinParens -> Markdown -> Markdown
applyWithinParens :: WithinParens -> Markdown -> Markdown
applyWithinParens (WithinParens Bool
wp) Markdown
txt
  | Bool
wp = Markdown
"(" Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
txt Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
")"
  | Bool
otherwise = Markdown
txt

-- | Show type, wrapping into parentheses if necessary.
buildTypeWithinParens :: forall a. Typeable a => WithinParens -> Markdown
buildTypeWithinParens :: forall {k} (a :: k). Typeable a => WithinParens -> Markdown
buildTypeWithinParens WithinParens
wp =
  let rep :: TypeRep
rep = Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {t :: k}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
      wrap :: Markdown -> Markdown
wrap = if [TypeRep] -> Bool
forall t. Container t => t -> Bool
null (TypeRep -> [TypeRep]
typeRepArgs TypeRep
rep) then Markdown -> Markdown
forall a. a -> a
id else WithinParens -> Markdown -> Markdown
applyWithinParens WithinParens
wp
  in Markdown -> Markdown
wrap (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$ forall p. Buildable p => p -> Markdown
build @Text (Text -> Markdown) -> Text -> Markdown
forall a b. (a -> b) -> a -> b
$ TypeRep -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show TypeRep
rep

-- | Description for a Haskell type appearing in documentation.
class ( Typeable a
      , SingI (TypeDocFieldDescriptions a)
      , FieldDescriptionsValid (TypeDocFieldDescriptions a) a
      ) => TypeHasDoc a where
  -- | Name of type as it appears in definitions section.
  --
  -- Each type must have its own unique name because it will be used
  -- in identifier for references.
  --
  -- Default definition derives name from Generics.
  -- If it does not fit, consider defining this function manually.
  -- (We tried using "Data.Data" for this, but it produces names including
  -- module names which is not do we want).
  typeDocName :: Proxy a -> Text
  default typeDocName
    :: (Generic a, KnownSymbol (GenericTypeName a))
    => Proxy a -> Text
  typeDocName Proxy a
_ = String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy (GenericTypeName a) -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall {t :: Symbol}. Proxy t
Proxy @(GenericTypeName a))

  -- | Explanation of a type. Markdown formatting is allowed.
  typeDocMdDescription :: Markdown

  -- | How reference to this type is rendered, in Markdown.
  --
  -- Examples:
  --
  -- * @\[Integer](\#type-integer)@,
  -- * @\[Maybe](\#type-Maybe) \[()](\#type-unit)@.
  --
  -- Consider using one of the following functions as default implementation;
  -- which one to use depends on number of type arguments in your type:
  --
  -- * 'homomorphicTypeDocMdReference'
  -- * 'poly1TypeDocMdReference'
  -- * 'poly2TypeDocMdReference'
  --
  -- If none of them fits your purposes precisely, consider using
  -- 'customTypeDocMdReference'.
  typeDocMdReference :: Proxy a -> WithinParens -> Markdown
  default typeDocMdReference
    :: (Typeable a, IsHomomorphic a)
    => Proxy a -> WithinParens -> Markdown
  typeDocMdReference = Proxy a -> WithinParens -> Markdown
forall t.
(Typeable t, TypeHasDoc t, IsHomomorphic t) =>
Proxy t -> WithinParens -> Markdown
homomorphicTypeDocMdReference

  -- | All types which this type directly contains.
  --
  -- Used in automatic types discovery.
  typeDocDependencies :: Proxy a -> [SomeDocDefinitionItem]
  default typeDocDependencies
    :: (Generic a, GTypeHasDoc (G.Rep a))
    => Proxy a -> [SomeDocDefinitionItem]
  typeDocDependencies = Proxy a -> [SomeDocDefinitionItem]
forall a.
(Generic a, GTypeHasDoc (Rep a)) =>
Proxy a -> [SomeDocDefinitionItem]
genericTypeDocDependencies

  -- | For complex types - their immediate Haskell representation.
  --
  -- For primitive types set this to 'Nothing'.
  --
  -- For homomorphic types use 'homomorphicTypeDocHaskellRep' implementation.
  --
  -- For polymorhpic types consider using 'concreteTypeDocHaskellRep' as implementation.
  --
  -- Modifier 'haskellRepNoFields' can be used to hide names of fields,
  -- beneficial for newtypes.
  --
  -- Another modifier called 'haskellRepStripFieldPrefix' can be used for datatypes
  -- to leave only meaningful part of name in every field.
  typeDocHaskellRep :: TypeDocHaskellRep a
  default typeDocHaskellRep
    :: (Generic a, GTypeHasDoc (G.Rep a), IsHomomorphic a)
    => TypeDocHaskellRep a
  typeDocHaskellRep = TypeDocHaskellRep a -> TypeDocHaskellRep a
forall a.
HasCallStack =>
TypeDocHaskellRep a -> TypeDocHaskellRep a
haskellRepStripFieldPrefix TypeDocHaskellRep a
forall a. (Generic a, GTypeHasDoc (Rep a)) => TypeDocHaskellRep a
homomorphicTypeDocHaskellRep

  -- | Description of constructors and fields of @a@.
  --
  -- See 'FieldDescriptions' documentation for an example of usage.
  --
  -- Descriptions will be checked at compile time to make sure that only existing constructors
  -- and fields are referenced.
  --
  -- For that check to work @instance Generic a@ is required whenever @TypeDocFieldDescriptions@
  -- is not empty.
  --
  -- For implementation of the check see 'FieldDescriptionsValid' type family.
  type TypeDocFieldDescriptions a :: FieldDescriptions
  type TypeDocFieldDescriptions _ = '[]

  -- | Final michelson representation of a type.
  --
  -- For homomorphic types use 'homomorphicTypeDocMichelsonRep' implementation.
  --
  -- For polymorhpic types consider using 'concreteTypeDocMichelsonRep' as implementation.
  typeDocMichelsonRep :: TypeDocMichelsonRep a
  default typeDocMichelsonRep
    :: (KnownIsoT a, IsHomomorphic a)
    => TypeDocMichelsonRep a
  typeDocMichelsonRep = TypeDocMichelsonRep a
forall a. KnownIsoT a => TypeDocMichelsonRep a
homomorphicTypeDocMichelsonRep

-- | Signature of 'typeDocHaskellRep' function.
--
-- A value of 'FieldDescriptionsV' is provided by the library to make sure that
-- instances won't replace it with an unchecked value.
--
-- When value is 'Just', it contains types which this type is built from.
--
-- First element of provided pair may contain name a concrete type which has
-- the same type constructor as @a@ (or just @a@ for homomorphic types), and
-- the second element of the pair - its unfolding in Haskell.
--
-- For example, for some @newtype MyNewtype = MyNewtype (Integer, Natural)@
-- we would not specify the first element in the pair because @MyNewtype@ is
-- already a concrete type, and second element would contain @(Integer, Natural)@.
-- For polymorhpic types like @newtype MyPolyNewtype a = MyPolyNewtype (Text, a)@,
-- we want to describe its representation on some example of @a@, because
-- working with type variables is too non-trivial; so the first element of
-- the pair may be e.g. @"MyPolyNewType Integer"@, and the second one shows
-- that it unfolds to @(Text, Integer)@.
--
-- When rendered, values of this type look like:
--
-- * @(Integer, Natural)@ - for homomorphic type.
-- * @MyError Integer = (Text, Integer)@ - concrete sample for polymorhpic type.
type TypeDocHaskellRep a =
  Proxy a -> FieldDescriptionsV -> Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)

-- | Signature of 'typeDocMichelsonRep' function.
--
-- As in 'TypeDocHaskellRep', set the first element of the pair to 'Nothing'
-- for primitive types, otherwise it stands as some instantiation of a type,
-- and its Michelson representation is given in the second element of the pair.
--
-- Examples of rendered representation:
--
-- * @pair int nat@ - for homomorphic type.
-- * @MyError Integer = pair string int@ - concrete sample for polymorhpic type.
type TypeDocMichelsonRep a =
  Proxy a -> (Maybe DocTypeRepLHS, T)

-- | Data hides some type implementing 'TypeHasDoc'.
data SomeTypeWithDoc where
  SomeTypeWithDoc :: TypeHasDoc td => Proxy td -> SomeTypeWithDoc

-- | When rendering type's inner representation, this stands for name of
--
-- Having this makes sense for polymorhpic types, when you want to render
-- representation of some concrete instantiation of that type.
newtype DocTypeRepLHS = DocTypeRepLHS Text
  deriving newtype (String -> DocTypeRepLHS
(String -> DocTypeRepLHS) -> IsString DocTypeRepLHS
forall a. (String -> a) -> IsString a
fromString :: String -> DocTypeRepLHS
$cfromString :: String -> DocTypeRepLHS
IsString, DocTypeRepLHS -> Markdown
(DocTypeRepLHS -> Markdown) -> Buildable DocTypeRepLHS
forall p. (p -> Markdown) -> Buildable p
build :: DocTypeRepLHS -> Markdown
$cbuild :: DocTypeRepLHS -> Markdown
Buildable)

-- | Doc element with description of a type.
data DType where
  DType :: TypeHasDoc a => Proxy a -> DType

instance Buildable DType where
  build :: DType -> Markdown
build (DType Proxy a
a) = TypeRep -> Markdown
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show (TypeRep -> Markdown) -> TypeRep -> Markdown
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
a

instance Eq DType where
  DType Proxy a
a1 == :: DType -> DType -> Bool
== DType Proxy a
a2 = Proxy a
a1 Proxy a -> Proxy a -> Bool
forall a1 a2. (Typeable a1, Typeable a2, Eq a1) => a1 -> a2 -> Bool
`eqExt` Proxy a
a2
instance Ord DType where
  DType Proxy a
a1 compare :: DType -> DType -> Ordering
`compare` DType Proxy a
a2 = Proxy a
a1 Proxy a -> Proxy a -> Ordering
forall a1 a2.
(Typeable a1, Typeable a2, Ord a1) =>
a1 -> a2 -> Ordering
`compareExt` Proxy a
a2

instance DocItem DType where
  type DocItemPlacement DType = 'DocItemInDefinitions
  type DocItemReferenced DType = 'True
  docItemPos :: Natural
docItemPos = Natural
5000

  docItemSectionName :: Maybe Text
docItemSectionName = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Types"

  docItemRef :: DType
-> DocItemRef (DocItemPlacement DType) (DocItemReferenced DType)
docItemRef (DType Proxy a
a) = DocItemId -> DocItemRef 'DocItemInDefinitions 'True
DocItemRef (DocItemId -> DocItemRef 'DocItemInDefinitions 'True)
-> DocItemId -> DocItemRef 'DocItemInDefinitions 'True
forall a b. (a -> b) -> a -> b
$
    Text -> DocItemId
DocItemId (Text
"types-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Proxy a -> Text
forall a. TypeHasDoc a => Proxy a -> Text
typeDocName Proxy a
a)

  docItemDependencies :: DType -> [SomeDocDefinitionItem]
docItemDependencies (DType (Proxy a
ap' :: Proxy a)) =
    Proxy a -> [SomeDocDefinitionItem]
forall a. TypeHasDoc a => Proxy a -> [SomeDocDefinitionItem]
typeDocDependencies Proxy a
ap'

  docItemToMarkdown :: HeaderLevel -> DType -> Markdown
docItemToMarkdown HeaderLevel
lvl (DType (Proxy a
ap' :: Proxy a)) =
    [Markdown] -> Markdown
forall a. Monoid a => [a] -> a
mconcat ([Markdown] -> Markdown)
-> ([Maybe Markdown] -> [Markdown]) -> [Maybe Markdown] -> Markdown
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Markdown] -> [Markdown]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Markdown] -> Markdown) -> [Maybe Markdown] -> Markdown
forall a b. (a -> b) -> a -> b
$
    [ Markdown -> Maybe Markdown
forall a. a -> Maybe a
Just Markdown
mdSeparator
    , Markdown -> Maybe Markdown
forall a. a -> Maybe a
Just (Markdown -> Maybe Markdown) -> Markdown -> Maybe Markdown
forall a b. (a -> b) -> a -> b
$ HeaderLevel -> Markdown -> Markdown
mdHeader HeaderLevel
lvl (Markdown -> Markdown
mdTicked (Markdown -> Markdown) -> (Text -> Markdown) -> Text -> Markdown
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Markdown
forall p. Buildable p => p -> Markdown
build (Text -> Markdown) -> Text -> Markdown
forall a b. (a -> b) -> a -> b
$ Proxy a -> Text
forall a. TypeHasDoc a => Proxy a -> Text
typeDocName Proxy a
ap')
    , Markdown -> Maybe Markdown
forall a. a -> Maybe a
Just (Markdown -> Maybe Markdown) -> Markdown -> Maybe Markdown
forall a b. (a -> b) -> a -> b
$ forall a. TypeHasDoc a => Markdown
typeDocMdDescription @a Markdown -> Markdown -> Markdown
forall a b. (Buildable a, FromBuilder b) => a -> Markdown -> b
|+ Markdown
"\n\n"
    , TypeDocHaskellRep a
forall a. TypeHasDoc a => TypeDocHaskellRep a
typeDocHaskellRep Proxy a
ap' (forall (a :: FieldDescriptions).
(SingKind FieldDescriptions, SingI a) =>
Demote FieldDescriptions
forall {k} (a :: k). (SingKind k, SingI a) => Demote k
demote @(TypeDocFieldDescriptions a)) Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
-> ((Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc) -> Markdown)
-> Maybe Markdown
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Maybe DocTypeRepLHS
mlhs, ADTRep SomeTypeWithDoc
rep) ->
        let
          -- Without this signature type inference trips.
          buildField :: WithinParens -> SomeTypeWithDoc -> Markdown
          buildField :: WithinParens -> SomeTypeWithDoc -> Markdown
buildField WithinParens
wp (SomeTypeWithDoc Proxy td
di) =
            Proxy td -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference Proxy td
di WithinParens
wp
          renderedRep :: Markdown
renderedRep =
             (WithinParens -> SomeTypeWithDoc -> Markdown)
-> ADTRep SomeTypeWithDoc -> Markdown
forall a. (WithinParens -> a -> Markdown) -> ADTRep a -> Markdown
buildADTRep WithinParens -> SomeTypeWithDoc -> Markdown
buildField ADTRep SomeTypeWithDoc
rep
          rendered :: Markdown
rendered = case Maybe DocTypeRepLHS
mlhs of
            Maybe DocTypeRepLHS
Nothing ->
              Markdown -> Markdown -> Markdown
mdSubsection Markdown
"Structure" Markdown
renderedRep
            Just DocTypeRepLHS
lhs ->
              Markdown -> Markdown -> Markdown
mdSubsection Markdown
"Structure (example)" (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$
                Markdown -> Markdown
mdTicked (DocTypeRepLHS -> Markdown
forall p. Buildable p => p -> Markdown
build DocTypeRepLHS
lhs) Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
" = " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
renderedRep
        in Markdown
rendered Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
"\n\n"
    , Markdown -> Maybe Markdown
forall a. a -> Maybe a
Just (Markdown -> Maybe Markdown) -> Markdown -> Maybe Markdown
forall a b. (a -> b) -> a -> b
$
        Proxy a -> Markdown
forall a. TypeHasDoc a => Proxy a -> Markdown
typeDocBuiltMichelsonRep (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
"\n\n"
    ]

  docItemToToc :: HeaderLevel -> DType -> Markdown
docItemToToc HeaderLevel
lvl d :: DType
d@(DType Proxy a
ap') =
    HeaderLevel -> Markdown -> DType -> Markdown
forall d.
(DocItem d, DocItemReferenced d ~ 'True) =>
HeaderLevel -> Markdown -> d -> Markdown
mdTocFromRef HeaderLevel
lvl (Text -> Markdown
forall p. Buildable p => p -> Markdown
build (Text -> Markdown) -> Text -> Markdown
forall a b. (a -> b) -> a -> b
$ Proxy a -> Text
forall a. TypeHasDoc a => Proxy a -> Text
typeDocName Proxy a
ap') DType
d

-- | Fully render Michelson representation of a type.
typeDocBuiltMichelsonRep :: TypeHasDoc a => Proxy a -> Builder
typeDocBuiltMichelsonRep :: forall a. TypeHasDoc a => Proxy a -> Markdown
typeDocBuiltMichelsonRep Proxy a
ap' =
  let (Maybe DocTypeRepLHS
mlhs, T
rep) = TypeDocMichelsonRep a
forall a. TypeHasDoc a => TypeDocMichelsonRep a
typeDocMichelsonRep Proxy a
ap'
      renderedRep :: Markdown
renderedRep = Markdown -> Markdown
mdTicked (T -> Markdown
forall p. Buildable p => p -> Markdown
build T
rep)
  in case Maybe DocTypeRepLHS
mlhs of
        Maybe DocTypeRepLHS
Nothing ->
          Markdown -> Markdown -> Markdown
mdSubsection Markdown
"Final Michelson representation"
          Markdown
renderedRep
        Just DocTypeRepLHS
lhs ->
          Markdown -> Markdown -> Markdown
mdSubsection Markdown
"Final Michelson representation (example)" (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$
          Markdown -> Markdown
mdTicked (DocTypeRepLHS -> Markdown
forall p. Buildable p => p -> Markdown
build DocTypeRepLHS
lhs) Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
" = " Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
renderedRep

-- | Create a 'DType' in form suitable for putting to 'typeDocDependencies'.
dTypeDep :: forall (t :: Type). TypeHasDoc t => SomeDocDefinitionItem
dTypeDep :: forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep = DType -> SomeDocDefinitionItem
forall d.
(DocItem d, DocItemPlacement d ~ 'DocItemInDefinitions) =>
d -> SomeDocDefinitionItem
SomeDocDefinitionItem (Proxy t -> DType
forall td. TypeHasDoc td => Proxy td -> DType
DType (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @t))

-- | Proxy version of 'dTypeDep'.
dTypeDepP
  :: forall (t :: Type).
      TypeHasDoc t
  => Proxy t -> SomeDocDefinitionItem
dTypeDepP :: forall t. TypeHasDoc t => Proxy t -> SomeDocDefinitionItem
dTypeDepP Proxy t
_ = forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @t

-- | Doc element with description of contract storage type.
newtype DStorageType = DStorageType DType
  deriving stock ((forall x. DStorageType -> Rep DStorageType x)
-> (forall x. Rep DStorageType x -> DStorageType)
-> Generic DStorageType
forall x. Rep DStorageType x -> DStorageType
forall x. DStorageType -> Rep DStorageType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DStorageType x -> DStorageType
$cfrom :: forall x. DStorageType -> Rep DStorageType x
Generic, DStorageType -> DStorageType -> Bool
(DStorageType -> DStorageType -> Bool)
-> (DStorageType -> DStorageType -> Bool) -> Eq DStorageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DStorageType -> DStorageType -> Bool
$c/= :: DStorageType -> DStorageType -> Bool
== :: DStorageType -> DStorageType -> Bool
$c== :: DStorageType -> DStorageType -> Bool
Eq, Eq DStorageType
Eq DStorageType
-> (DStorageType -> DStorageType -> Ordering)
-> (DStorageType -> DStorageType -> Bool)
-> (DStorageType -> DStorageType -> Bool)
-> (DStorageType -> DStorageType -> Bool)
-> (DStorageType -> DStorageType -> Bool)
-> (DStorageType -> DStorageType -> DStorageType)
-> (DStorageType -> DStorageType -> DStorageType)
-> Ord DStorageType
DStorageType -> DStorageType -> Bool
DStorageType -> DStorageType -> Ordering
DStorageType -> DStorageType -> DStorageType
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 :: DStorageType -> DStorageType -> DStorageType
$cmin :: DStorageType -> DStorageType -> DStorageType
max :: DStorageType -> DStorageType -> DStorageType
$cmax :: DStorageType -> DStorageType -> DStorageType
>= :: DStorageType -> DStorageType -> Bool
$c>= :: DStorageType -> DStorageType -> Bool
> :: DStorageType -> DStorageType -> Bool
$c> :: DStorageType -> DStorageType -> Bool
<= :: DStorageType -> DStorageType -> Bool
$c<= :: DStorageType -> DStorageType -> Bool
< :: DStorageType -> DStorageType -> Bool
$c< :: DStorageType -> DStorageType -> Bool
compare :: DStorageType -> DStorageType -> Ordering
$ccompare :: DStorageType -> DStorageType -> Ordering
Ord)

-- | Shortcut for 'DStorageType'.
dStorage :: forall store. TypeHasDoc store => DStorageType
dStorage :: forall store. TypeHasDoc store => DStorageType
dStorage = DType -> DStorageType
DStorageType (DType -> DStorageType) -> DType -> DStorageType
forall a b. (a -> b) -> a -> b
$ Proxy store -> DType
forall td. TypeHasDoc td => Proxy td -> DType
DType (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @store)

instance DocItem DStorageType where
  type DocItemPlacement DStorageType = 'DocItemInlined
  type DocItemReferenced DStorageType = 'True

  docItemRef :: DStorageType
-> DocItemRef
     (DocItemPlacement DStorageType) (DocItemReferenced DStorageType)
docItemRef (DStorageType (DType Proxy a
a)) = DocItemId -> DocItemRef 'DocItemInlined 'True
DocItemRefInlined (DocItemId -> DocItemRef 'DocItemInlined 'True)
-> DocItemId -> DocItemRef 'DocItemInlined 'True
forall a b. (a -> b) -> a -> b
$
    Text -> DocItemId
DocItemId (Text
"storage-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Proxy a -> Text
forall a. TypeHasDoc a => Proxy a -> Text
typeDocName Proxy a
a)
  docItemPos :: Natural
docItemPos = Natural
835
  docItemSectionName :: Maybe Text
docItemSectionName = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Storage"
  docItemToMarkdown :: HeaderLevel -> DStorageType -> Markdown
docItemToMarkdown HeaderLevel
lvl (DStorageType DType
t) = HeaderLevel -> DType -> Markdown
forall d. DocItem d => HeaderLevel -> d -> Markdown
docItemToMarkdown HeaderLevel
lvl DType
t
  docItemToToc :: HeaderLevel -> DStorageType -> Markdown
docItemToToc HeaderLevel
lvl d :: DStorageType
d@(DStorageType (DType Proxy a
a)) =
    HeaderLevel -> Markdown -> DStorageType -> Markdown
forall d.
(DocItem d, DocItemReferenced d ~ 'True) =>
HeaderLevel -> Markdown -> d -> Markdown
mdTocFromRef HeaderLevel
lvl (Text -> Markdown
forall p. Buildable p => p -> Markdown
build (Text -> Markdown) -> Text -> Markdown
forall a b. (a -> b) -> a -> b
$ Proxy a -> Text
forall a. TypeHasDoc a => Proxy a -> Text
typeDocName Proxy a
a) DStorageType
d
  docItemDependencies :: DStorageType -> [SomeDocDefinitionItem]
docItemDependencies (DStorageType DType
t) = DType -> [SomeDocDefinitionItem]
forall d. DocItem d => d -> [SomeDocDefinitionItem]
docItemDependencies DType
t

-- Default implementations
----------------------------------------------------------------------------

-- | Require two types to be built from the same type constructor.
--
-- E.g. @HaveCommonTypeCtor (Maybe Integer) (Maybe Natural)@ is defined,
-- while @HaveCmmonTypeCtor (Maybe Integer) [Integer]@ is not.
class HaveCommonTypeCtor a b
instance HaveCommonTypeCtor ac bc => HaveCommonTypeCtor (ac a) (bc b)
instance HaveCommonTypeCtor a a

-- | Require this type to be homomorphic.
class IsHomomorphic a where
instance TypeError ('Text "Type is not homomorphic: " ':<>: 'ShowType (a b)) =>
         IsHomomorphic (a b)
instance {-# OVERLAPPABLE #-} IsHomomorphic a

-- | Render a reference to a type which consists of type constructor
-- (you have to provide name of this type constructor and documentation
-- for the whole type) and zero or more type arguments.
customTypeDocMdReference :: (Text, DType) -> [DType] -> WithinParens -> Markdown
customTypeDocMdReference :: (Text, DType) -> [DType] -> WithinParens -> Markdown
customTypeDocMdReference (Text, DType)
tyInfo [DType]
typeArgsDoc =
  (Text, DType)
-> [WithinParens -> Markdown] -> WithinParens -> Markdown
customTypeDocMdReference'
    (Text, DType)
tyInfo
    ([DType]
typeArgsDoc [DType]
-> (DType -> WithinParens -> Markdown)
-> [WithinParens -> Markdown]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(DType Proxy a
di) -> Proxy a -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference Proxy a
di)

-- | More generic version of 'customTypeDocMdReference', it accepts
-- arguments not as types with doc, but printers for them.
customTypeDocMdReference'
  :: (Text, DType)
  -> [WithinParens -> Markdown]
  -> WithinParens
  -> Markdown
customTypeDocMdReference' :: (Text, DType)
-> [WithinParens -> Markdown] -> WithinParens -> Markdown
customTypeDocMdReference' (Text
typeCtorName, DType
tyDoc) [WithinParens -> Markdown]
typeArgsPrinters WithinParens
wp =
  let DocItemRef DocItemId
ctorDocItemId = DType
-> DocItemRef (DocItemPlacement DType) (DocItemReferenced DType)
forall d.
DocItem d =>
d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d)
docItemRef DType
tyDoc
  in WithinParens -> Markdown -> Markdown
applyWithinParens WithinParens
wpSmart (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$
     [Markdown] -> Markdown
forall a. Monoid a => [a] -> a
mconcat ([Markdown] -> Markdown)
-> ([Markdown] -> [Markdown]) -> [Markdown] -> Markdown
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Markdown -> [Markdown] -> [Markdown]
forall a. a -> [a] -> [a]
intersperse Markdown
" " ([Markdown] -> Markdown) -> [Markdown] -> Markdown
forall a b. (a -> b) -> a -> b
$
      ( Markdown -> DocItemId -> Markdown
forall anchor. ToAnchor anchor => Markdown -> anchor -> Markdown
mdLocalRef (Markdown -> Markdown
mdTicked (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$ Text -> Markdown
forall p. Buildable p => p -> Markdown
build Text
typeCtorName) DocItemId
ctorDocItemId
      Markdown -> [Markdown] -> [Markdown]
forall a. a -> [a] -> [a]
: ([WithinParens -> Markdown]
typeArgsPrinters [WithinParens -> Markdown]
-> ((WithinParens -> Markdown) -> Markdown) -> [Markdown]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \WithinParens -> Markdown
printer -> WithinParens -> Markdown
printer (Bool -> WithinParens
WithinParens Bool
True))
      )
    where
      -- If we are rendering an atomic thing, there is no need in parentheses
      -- around it
      wpSmart :: WithinParens
wpSmart =
        let WithinParens Bool
wp' = WithinParens
wp
        in Bool -> WithinParens
WithinParens (Bool
wp' Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Bool -> Bool
not ([WithinParens -> Markdown] -> Bool
forall t. Container t => t -> Bool
null [WithinParens -> Markdown]
typeArgsPrinters))

-- | Derive 'typeDocMdReference', for homomorphic types only.
homomorphicTypeDocMdReference
  :: forall (t :: Type).
     (Typeable t, TypeHasDoc t, IsHomomorphic t)
  => Proxy t -> WithinParens -> Markdown
homomorphicTypeDocMdReference :: forall t.
(Typeable t, TypeHasDoc t, IsHomomorphic t) =>
Proxy t -> WithinParens -> Markdown
homomorphicTypeDocMdReference Proxy t
tp WithinParens
_ =
  (Text, DType) -> [DType] -> WithinParens -> Markdown
customTypeDocMdReference
    (Proxy t -> Text
forall a. TypeHasDoc a => Proxy a -> Text
typeDocName Proxy t
tp, Proxy t -> DType
forall td. TypeHasDoc td => Proxy td -> DType
DType Proxy t
tp)
    []
    (Bool -> WithinParens
WithinParens Bool
False)

-- | Derive 'typeDocMdReference', for polymorphic type with one
-- type argument, like @Maybe Integer@.
poly1TypeDocMdReference
  :: forall t (r :: Type) (a :: Type).
      (r ~ t a, Typeable t, Each '[TypeHasDoc] [r, a], IsHomomorphic t)
  => Proxy r -> WithinParens -> Markdown
poly1TypeDocMdReference :: forall (t :: * -> *) r a.
(r ~ t a, Typeable t, Each '[TypeHasDoc] '[r, a],
 IsHomomorphic t) =>
Proxy r -> WithinParens -> Markdown
poly1TypeDocMdReference Proxy r
tp =
  (Text, DType) -> [DType] -> WithinParens -> Markdown
customTypeDocMdReference
    (String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy t -> String
forall k (a :: k) (proxy :: k -> *).
Showtype a =>
proxy a -> String
showtype (forall {k} (t :: k). Proxy t
forall {t :: * -> *}. Proxy t
Proxy @t), Proxy r -> DType
forall td. TypeHasDoc td => Proxy td -> DType
DType Proxy r
tp)
    [Proxy a -> DType
forall td. TypeHasDoc td => Proxy td -> DType
DType (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)]

-- | Derive 'typeDocMdReference', for polymorphic type with two
-- type arguments, like @Lambda Integer Natural@.
poly2TypeDocMdReference
  :: forall t (r :: Type) (a :: Type) (b :: Type).
      (r ~ t a b, Typeable t, Each '[TypeHasDoc] [r, a, b], IsHomomorphic t)
  => Proxy r -> WithinParens -> Markdown
poly2TypeDocMdReference :: forall (t :: * -> * -> *) r a b.
(r ~ t a b, Typeable t, Each '[TypeHasDoc] '[r, a, b],
 IsHomomorphic t) =>
Proxy r -> WithinParens -> Markdown
poly2TypeDocMdReference Proxy r
tp =
  (Text, DType) -> [DType] -> WithinParens -> Markdown
customTypeDocMdReference
    (String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy t -> String
forall k (a :: k) (proxy :: k -> *).
Showtype a =>
proxy a -> String
showtype (forall {k} (t :: k). Proxy t
forall {t :: * -> * -> *}. Proxy t
Proxy @t), Proxy r -> DType
forall td. TypeHasDoc td => Proxy td -> DType
DType Proxy r
tp)
    [ Proxy a -> DType
forall td. TypeHasDoc td => Proxy td -> DType
DType (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
    , Proxy b -> DType
forall td. TypeHasDoc td => Proxy td -> DType
DType (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
    ]

-- | Implement 'typeDocDependencies' via getting all immediate fields
-- of a datatype.
--
-- Note: this will not include phantom types, I'm not sure yet how this
-- scenario should be handled (@martoon).
genericTypeDocDependencies
  :: forall a.
      (Generic a, GTypeHasDoc (G.Rep a))
  => Proxy a -> [SomeDocDefinitionItem]
genericTypeDocDependencies :: forall a.
(Generic a, GTypeHasDoc (Rep a)) =>
Proxy a -> [SomeDocDefinitionItem]
genericTypeDocDependencies Proxy a
_ = do
  ConstructorRep{[FieldRep SomeTypeWithDoc]
Maybe Text
Text
crFields :: [FieldRep SomeTypeWithDoc]
crDescription :: Maybe Text
crName :: Text
crFields :: forall a. ConstructorRep a -> [FieldRep a]
crDescription :: forall a. ConstructorRep a -> Maybe Text
crName :: forall a. ConstructorRep a -> Text
..} <- ADTRep SomeTypeWithDoc -> [Element (ADTRep SomeTypeWithDoc)]
forall t. Container t => t -> [Element t]
toList (ADTRep SomeTypeWithDoc -> [Element (ADTRep SomeTypeWithDoc)])
-> ADTRep SomeTypeWithDoc -> [Element (ADTRep SomeTypeWithDoc)]
forall a b. (a -> b) -> a -> b
$ forall (x :: * -> *).
GTypeHasDoc x =>
Demote FieldDescriptions -> ADTRep SomeTypeWithDoc
gTypeDocHaskellRep @(G.Rep a) []
  FieldRep{Maybe Text
SomeTypeWithDoc
frTypeRep :: SomeTypeWithDoc
frDescription :: Maybe Text
frName :: Maybe Text
frTypeRep :: forall a. FieldRep a -> a
frDescription :: forall a. FieldRep a -> Maybe Text
frName :: forall a. FieldRep a -> Maybe Text
..} <- [FieldRep SomeTypeWithDoc]
crFields
  SomeTypeWithDoc Proxy td
ty <- SomeTypeWithDoc -> [SomeTypeWithDoc]
forall (f :: * -> *) a. Applicative f => a -> f a
pure SomeTypeWithDoc
frTypeRep
  SomeDocDefinitionItem -> [SomeDocDefinitionItem]
forall (m :: * -> *) a. Monad m => a -> m a
return (Proxy td -> SomeDocDefinitionItem
forall t. TypeHasDoc t => Proxy t -> SomeDocDefinitionItem
dTypeDepP Proxy td
ty)

-- | Implement 'typeDocHaskellRep' for a homomorphic type.
--
-- Note that it does not require your type to be of 'IsHomomorphic' instance,
-- which can be useful for some polymorhpic types which, for documentation
-- purposes, we want to consider homomorphic.
--
-- Example: 'Operation' is in fact polymorhpic, but we don't want this fact to
-- be reflected in the documentation.
homomorphicTypeDocHaskellRep
  :: forall a.
     (Generic a, GTypeHasDoc (G.Rep a))
  => TypeDocHaskellRep a
homomorphicTypeDocHaskellRep :: forall a. (Generic a, GTypeHasDoc (Rep a)) => TypeDocHaskellRep a
homomorphicTypeDocHaskellRep Proxy a
_ Demote FieldDescriptions
descr = (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
-> Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. a -> Maybe a
Just
  ( Maybe DocTypeRepLHS
forall a. Maybe a
Nothing
  , forall (x :: * -> *).
GTypeHasDoc x =>
Demote FieldDescriptions -> ADTRep SomeTypeWithDoc
gTypeDocHaskellRep @(G.Rep a) Demote FieldDescriptions
descr
  )

-- | Implement 'typeDocHaskellRep' on example of given concrete type.
--
-- This is a best effort attempt to implement 'typeDocHaskellRep' for polymorhpic
-- types, as soon as there is no simple way to preserve type variables when
-- automatically deriving Haskell representation of a type.
concreteTypeDocHaskellRep
  :: forall a b.
     ( Typeable a, GenericIsoValue a, GTypeHasDoc (G.Rep a)
     , HaveCommonTypeCtor b a
     )
  => TypeDocHaskellRep b
concreteTypeDocHaskellRep :: forall a b.
(Typeable a, GenericIsoValue a, GTypeHasDoc (Rep a),
 HaveCommonTypeCtor b a) =>
TypeDocHaskellRep b
concreteTypeDocHaskellRep = forall a b.
(Typeable a, GenericIsoValue a, GTypeHasDoc (Rep a)) =>
TypeDocHaskellRep b
unsafeConcreteTypeDocHaskellRep @a

-- | Version of 'concreteTypeDocHaskellRep' which does not ensure
-- whether the type for which representation is built is any similar to
-- the original type which you implement a 'TypeHasDoc' instance for.
unsafeConcreteTypeDocHaskellRep
  :: forall a b.
     ( Typeable a, GenericIsoValue a, GTypeHasDoc (G.Rep a)
     )
  => TypeDocHaskellRep b
unsafeConcreteTypeDocHaskellRep :: forall a b.
(Typeable a, GenericIsoValue a, GTypeHasDoc (Rep a)) =>
TypeDocHaskellRep b
unsafeConcreteTypeDocHaskellRep Proxy b
_ Demote FieldDescriptions
descr = (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
-> Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. a -> Maybe a
Just
  ( DocTypeRepLHS -> Maybe DocTypeRepLHS
forall a. a -> Maybe a
Just (Text -> DocTypeRepLHS
DocTypeRepLHS (Text -> DocTypeRepLHS)
-> (Proxy a -> Text) -> Proxy a -> DocTypeRepLHS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> (Proxy a -> String) -> Proxy a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> String
forall k (a :: k) (proxy :: k -> *).
Showtype a =>
proxy a -> String
showtype (Proxy a -> DocTypeRepLHS) -> Proxy a -> DocTypeRepLHS
forall a b. (a -> b) -> a -> b
$ forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
    -- ↑ this also shows kinds when poly-kinded type arguments are present,
    -- but there seems to be no simple way to deal with this.
  , forall (x :: * -> *).
GTypeHasDoc x =>
Demote FieldDescriptions -> ADTRep SomeTypeWithDoc
gTypeDocHaskellRep @(G.Rep a) Demote FieldDescriptions
descr
  )

-- | Erase fields from Haskell datatype representation.
--
-- Use this when rendering fields names is undesired.
haskellRepNoFields :: TypeDocHaskellRep a -> TypeDocHaskellRep a
haskellRepNoFields :: forall a. TypeDocHaskellRep a -> TypeDocHaskellRep a
haskellRepNoFields TypeDocHaskellRep a
mkRep =
  \Proxy a
p Demote FieldDescriptions
descr -> (ADTRep SomeTypeWithDoc -> ADTRep SomeTypeWithDoc)
-> (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
-> (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Maybe Text -> Maybe Text)
-> ADTRep SomeTypeWithDoc -> ADTRep SomeTypeWithDoc
forall a. (Maybe Text -> Maybe Text) -> ADTRep a -> ADTRep a
mapADTRepFields (Maybe Text -> Maybe Text -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing)) ((Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
 -> (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc))
-> Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
-> Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeDocHaskellRep a
mkRep Proxy a
p Demote FieldDescriptions
descr

-- | Add field name for @newtype@.
--
-- Since @newtype@ field is automatically erased. Use this function
-- to add the desired field name.
haskellAddNewtypeField :: Text -> TypeDocHaskellRep a -> TypeDocHaskellRep a
haskellAddNewtypeField :: forall a. Text -> TypeDocHaskellRep a -> TypeDocHaskellRep a
haskellAddNewtypeField Text
fieldName TypeDocHaskellRep a
mkRep =
  \Proxy a
p Demote FieldDescriptions
descr -> (ADTRep SomeTypeWithDoc -> ADTRep SomeTypeWithDoc)
-> (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
-> (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Maybe Text -> Maybe Text)
-> ADTRep SomeTypeWithDoc -> ADTRep SomeTypeWithDoc
forall a. (Maybe Text -> Maybe Text) -> ADTRep a -> ADTRep a
mapADTRepFields (Maybe Text -> Maybe Text -> Maybe Text
forall a b. a -> b -> a
const (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
fieldName))) ((Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
 -> (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc))
-> Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
-> Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeDocHaskellRep a
mkRep Proxy a
p Demote FieldDescriptions
descr

-- | Cut fields prefixes which we use according to the style guide.
--
-- E.g. @cmMyField@ field will be transformed to @myField@.
haskellRepStripFieldPrefix
  :: HasCallStack
  => TypeDocHaskellRep a -> TypeDocHaskellRep a
haskellRepStripFieldPrefix :: forall a.
HasCallStack =>
TypeDocHaskellRep a -> TypeDocHaskellRep a
haskellRepStripFieldPrefix TypeDocHaskellRep a
mkRep =
  \Proxy a
p Demote FieldDescriptions
descr -> (ADTRep SomeTypeWithDoc -> ADTRep SomeTypeWithDoc)
-> (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
-> (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Maybe Text -> Maybe Text)
-> ADTRep SomeTypeWithDoc -> ADTRep SomeTypeWithDoc
forall a. (Maybe Text -> Maybe Text) -> ADTRep a -> ADTRep a
mapADTRepFields ((Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
stripPrefix)) ((Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
 -> (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc))
-> Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
-> Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeDocHaskellRep a
mkRep Proxy a
p Demote FieldDescriptions
descr
  where
    stripPrefix :: Text -> Text
stripPrefix Text
fieldName =
      case Text -> Maybe (Char, Text)
T.uncons (Text -> Maybe (Char, Text)) -> Text -> Maybe (Char, Text)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isLower Text
fieldName of
        Maybe (Char, Text)
Nothing -> Text -> Text
forall a. HasCallStack => Text -> a
error (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"Field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fieldName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' has no prefix"
        Just (Char
c, Text
cs) ->
          -- For fields like @ciUSPosition@ we should not lead the first letter
          -- to lower case like @uSPosition@.
          let isAbbreviation :: Bool
isAbbreviation = case Text -> Maybe (Char, Text)
T.uncons Text
cs of
                Just (Char
c2, Text
_)
                  | Char -> Bool
isUpper Char
c2 -> Bool
True
                  | Bool
otherwise -> Bool
False
                Maybe (Char, Text)
Nothing -> Bool
False
          in Char -> Text -> Text
T.cons (if Bool
isAbbreviation then Char
c else Char -> Char
toLower Char
c) Text
cs

-- | Implement 'typeDocMichelsonRep' for homomorphic type.
homomorphicTypeDocMichelsonRep
  :: forall a.
     KnownIsoT a
  => TypeDocMichelsonRep a
homomorphicTypeDocMichelsonRep :: forall a. KnownIsoT a => TypeDocMichelsonRep a
homomorphicTypeDocMichelsonRep Proxy a
_ =
  ( Maybe DocTypeRepLHS
forall a. Maybe a
Nothing
  , forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: T). (SingKind T, SingI a) => Demote T
demote @(ToT a)
  )

-- | Implement 'typeDocMichelsonRep' on example of given concrete type.
--
-- This function exists for the same reason as 'concreteTypeDocHaskellRep'.
concreteTypeDocMichelsonRep
  :: forall a b.
     (Typeable a, KnownIsoT a, HaveCommonTypeCtor b a)
  => TypeDocMichelsonRep b
concreteTypeDocMichelsonRep :: forall {k} a (b :: k).
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep Proxy b
_ =
  ( DocTypeRepLHS -> Maybe DocTypeRepLHS
forall a. a -> Maybe a
Just (Text -> DocTypeRepLHS
DocTypeRepLHS (Text -> DocTypeRepLHS)
-> (Proxy a -> Text) -> Proxy a -> DocTypeRepLHS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> (Proxy a -> String) -> Proxy a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> String
forall k (a :: k) (proxy :: k -> *).
Showtype a =>
proxy a -> String
showtype (Proxy a -> DocTypeRepLHS) -> Proxy a -> DocTypeRepLHS
forall a b. (a -> b) -> a -> b
$ forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
  , forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: T). (SingKind T, SingI a) => Demote T
demote @(ToT a)
  )

-- | Version of 'unsafeConcreteTypeDocHaskellRep' which does not ensure
-- whether the type for which representation is built is any similar to
-- the original type which you implement a 'TypeHasDoc' instance for.
unsafeConcreteTypeDocMichelsonRep
  :: forall a b.
     (Typeable a, KnownIsoT a)
  => TypeDocMichelsonRep b
unsafeConcreteTypeDocMichelsonRep :: forall {k} a (b :: k).
(Typeable a, KnownIsoT a) =>
TypeDocMichelsonRep b
unsafeConcreteTypeDocMichelsonRep Proxy b
_ =
  ( DocTypeRepLHS -> Maybe DocTypeRepLHS
forall a. a -> Maybe a
Just (Text -> DocTypeRepLHS
DocTypeRepLHS (Text -> DocTypeRepLHS)
-> (Proxy a -> Text) -> Proxy a -> DocTypeRepLHS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> (Proxy a -> String) -> Proxy a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> String
forall k (a :: k) (proxy :: k -> *).
Showtype a =>
proxy a -> String
showtype (Proxy a -> DocTypeRepLHS) -> Proxy a -> DocTypeRepLHS
forall a b. (a -> b) -> a -> b
$ forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
  , forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: T). (SingKind T, SingI a) => Demote T
demote @(ToT a)
  )

-- | Generic traversal for automatic deriving of some methods in 'TypeHasDoc'.
class GTypeHasDoc (x :: Type -> Type) where
  gTypeDocHaskellRep :: FieldDescriptionsV -> ADTRep SomeTypeWithDoc

instance GTypeHasDoc x => GTypeHasDoc (G.D1 ('G.MetaData _a _b _c 'False) x) where
  gTypeDocHaskellRep :: Demote FieldDescriptions -> ADTRep SomeTypeWithDoc
gTypeDocHaskellRep = forall (x :: * -> *).
GTypeHasDoc x =>
Demote FieldDescriptions -> ADTRep SomeTypeWithDoc
gTypeDocHaskellRep @x

instance GTypeHasDoc x => GTypeHasDoc (G.D1 ('G.MetaData _a _b _c 'True) x) where
  gTypeDocHaskellRep :: Demote FieldDescriptions -> ADTRep SomeTypeWithDoc
gTypeDocHaskellRep Demote FieldDescriptions
descr =
    (Maybe Text -> Maybe Text)
-> ADTRep SomeTypeWithDoc -> ADTRep SomeTypeWithDoc
forall a. (Maybe Text -> Maybe Text) -> ADTRep a -> ADTRep a
mapADTRepFields (Maybe Text -> Maybe Text -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing) (ADTRep SomeTypeWithDoc -> ADTRep SomeTypeWithDoc)
-> ADTRep SomeTypeWithDoc -> ADTRep SomeTypeWithDoc
forall a b. (a -> b) -> a -> b
$ forall (x :: * -> *).
GTypeHasDoc x =>
Demote FieldDescriptions -> ADTRep SomeTypeWithDoc
gTypeDocHaskellRep @x Demote FieldDescriptions
descr

instance (GTypeHasDoc x, GTypeHasDoc y) => GTypeHasDoc (x :+: y) where
  gTypeDocHaskellRep :: Demote FieldDescriptions -> ADTRep SomeTypeWithDoc
gTypeDocHaskellRep Demote FieldDescriptions
descr = forall (x :: * -> *).
GTypeHasDoc x =>
Demote FieldDescriptions -> ADTRep SomeTypeWithDoc
gTypeDocHaskellRep @x Demote FieldDescriptions
descr ADTRep SomeTypeWithDoc
-> ADTRep SomeTypeWithDoc -> ADTRep SomeTypeWithDoc
forall a. Semigroup a => a -> a -> a
<> forall (x :: * -> *).
GTypeHasDoc x =>
Demote FieldDescriptions -> ADTRep SomeTypeWithDoc
gTypeDocHaskellRep @y Demote FieldDescriptions
descr

instance (GProductHasDoc x, KnownSymbol ctor) =>
         GTypeHasDoc (G.C1 ('G.MetaCons ctor _1 _2) x) where
  gTypeDocHaskellRep :: Demote FieldDescriptions -> ADTRep SomeTypeWithDoc
gTypeDocHaskellRep Demote FieldDescriptions
descr = OneItem (ADTRep SomeTypeWithDoc) -> ADTRep SomeTypeWithDoc
forall x. One x => OneItem x -> x
one (OneItem (ADTRep SomeTypeWithDoc) -> ADTRep SomeTypeWithDoc)
-> OneItem (ADTRep SomeTypeWithDoc) -> ADTRep SomeTypeWithDoc
forall a b. (a -> b) -> a -> b
$ ConstructorRep :: forall a. Text -> Maybe Text -> [FieldRep a] -> ConstructorRep a
ConstructorRep
    { crName :: Text
crName = Text
conName
    , crDescription :: Maybe Text
crDescription = [(Text, (Maybe Text, [(Text, Text)]))]
Demote FieldDescriptions
descr [(Text, (Maybe Text, [(Text, Text)]))]
-> Getting (First Text) [(Text, (Maybe Text, [(Text, Text)]))] Text
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? ([(Text, (Maybe Text, [(Text, Text)]))]
 -> Maybe (Maybe Text, [(Text, Text)]))
-> Optic'
     (->)
     (Const (First Text))
     [(Text, (Maybe Text, [(Text, Text)]))]
     (Maybe (Maybe Text, [(Text, Text)]))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Text
-> [(Text, (Maybe Text, [(Text, Text)]))]
-> Maybe (Maybe Text, [(Text, Text)])
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
conName) Optic'
  (->)
  (Const (First Text))
  [(Text, (Maybe Text, [(Text, Text)]))]
  (Maybe (Maybe Text, [(Text, Text)]))
-> ((Text -> Const (First Text) Text)
    -> Maybe (Maybe Text, [(Text, Text)])
    -> Const (First Text) (Maybe (Maybe Text, [(Text, Text)])))
-> Getting (First Text) [(Text, (Maybe Text, [(Text, Text)]))] Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe Text, [(Text, Text)])
 -> Const (First Text) (Maybe Text, [(Text, Text)]))
-> Maybe (Maybe Text, [(Text, Text)])
-> Const (First Text) (Maybe (Maybe Text, [(Text, Text)]))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just (((Maybe Text, [(Text, Text)])
  -> Const (First Text) (Maybe Text, [(Text, Text)]))
 -> Maybe (Maybe Text, [(Text, Text)])
 -> Const (First Text) (Maybe (Maybe Text, [(Text, Text)])))
-> ((Text -> Const (First Text) Text)
    -> (Maybe Text, [(Text, Text)])
    -> Const (First Text) (Maybe Text, [(Text, Text)]))
-> (Text -> Const (First Text) Text)
-> Maybe (Maybe Text, [(Text, Text)])
-> Const (First Text) (Maybe (Maybe Text, [(Text, Text)]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Const (First Text) (Maybe Text))
-> (Maybe Text, [(Text, Text)])
-> Const (First Text) (Maybe Text, [(Text, Text)])
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((Maybe Text -> Const (First Text) (Maybe Text))
 -> (Maybe Text, [(Text, Text)])
 -> Const (First Text) (Maybe Text, [(Text, Text)]))
-> ((Text -> Const (First Text) Text)
    -> Maybe Text -> Const (First Text) (Maybe Text))
-> (Text -> Const (First Text) Text)
-> (Maybe Text, [(Text, Text)])
-> Const (First Text) (Maybe Text, [(Text, Text)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Maybe Text -> Const (First Text) (Maybe Text)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just
    , crFields :: [FieldRep SomeTypeWithDoc]
crFields = forall (x :: * -> *).
GProductHasDoc x =>
[(Text, Text)] -> [FieldRep SomeTypeWithDoc]
gProductDocHaskellRep @x ([(Text, Text)] -> [FieldRep SomeTypeWithDoc])
-> [(Text, Text)] -> [FieldRep SomeTypeWithDoc]
forall a b. (a -> b) -> a -> b
$ [(Text, (Maybe Text, [(Text, Text)]))]
Demote FieldDescriptions
descr [(Text, (Maybe Text, [(Text, Text)]))]
-> Getting
     [(Text, Text)]
     [(Text, (Maybe Text, [(Text, Text)]))]
     [(Text, Text)]
-> [(Text, Text)]
forall s a. s -> Getting a s a -> a
^. ([(Text, (Maybe Text, [(Text, Text)]))]
 -> Maybe (Maybe Text, [(Text, Text)]))
-> Optic'
     (->)
     (Const [(Text, Text)])
     [(Text, (Maybe Text, [(Text, Text)]))]
     (Maybe (Maybe Text, [(Text, Text)]))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Text
-> [(Text, (Maybe Text, [(Text, Text)]))]
-> Maybe (Maybe Text, [(Text, Text)])
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
conName) Optic'
  (->)
  (Const [(Text, Text)])
  [(Text, (Maybe Text, [(Text, Text)]))]
  (Maybe (Maybe Text, [(Text, Text)]))
-> (([(Text, Text)] -> Const [(Text, Text)] [(Text, Text)])
    -> Maybe (Maybe Text, [(Text, Text)])
    -> Const [(Text, Text)] (Maybe (Maybe Text, [(Text, Text)])))
-> Getting
     [(Text, Text)]
     [(Text, (Maybe Text, [(Text, Text)]))]
     [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe Text, [(Text, Text)])
 -> Const [(Text, Text)] (Maybe Text, [(Text, Text)]))
-> Maybe (Maybe Text, [(Text, Text)])
-> Const [(Text, Text)] (Maybe (Maybe Text, [(Text, Text)]))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just (((Maybe Text, [(Text, Text)])
  -> Const [(Text, Text)] (Maybe Text, [(Text, Text)]))
 -> Maybe (Maybe Text, [(Text, Text)])
 -> Const [(Text, Text)] (Maybe (Maybe Text, [(Text, Text)])))
-> (([(Text, Text)] -> Const [(Text, Text)] [(Text, Text)])
    -> (Maybe Text, [(Text, Text)])
    -> Const [(Text, Text)] (Maybe Text, [(Text, Text)]))
-> ([(Text, Text)] -> Const [(Text, Text)] [(Text, Text)])
-> Maybe (Maybe Text, [(Text, Text)])
-> Const [(Text, Text)] (Maybe (Maybe Text, [(Text, Text)]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Text, Text)] -> Const [(Text, Text)] [(Text, Text)])
-> (Maybe Text, [(Text, Text)])
-> Const [(Text, Text)] (Maybe Text, [(Text, Text)])
forall s t a b. Field2 s t a b => Lens s t a b
_2
    }
    where
      conName :: Text
conName = String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy ctor -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall {t :: Symbol}. Proxy t
Proxy @ctor)

instance GTypeHasDoc G.V1 where
  gTypeDocHaskellRep :: Demote FieldDescriptions -> ADTRep SomeTypeWithDoc
gTypeDocHaskellRep Demote FieldDescriptions
_ = []

-- | Product type traversal for 'TypeHasDoc'.
class GProductHasDoc (x :: Type -> Type) where
  gProductDocHaskellRep :: [(Text, Text)] -> [FieldRep SomeTypeWithDoc]

instance (GProductHasDoc x, GProductHasDoc y) => GProductHasDoc (x :*: y) where
  gProductDocHaskellRep :: [(Text, Text)] -> [FieldRep SomeTypeWithDoc]
gProductDocHaskellRep [(Text, Text)]
descr = forall (x :: * -> *).
GProductHasDoc x =>
[(Text, Text)] -> [FieldRep SomeTypeWithDoc]
gProductDocHaskellRep @x [(Text, Text)]
descr [FieldRep SomeTypeWithDoc]
-> [FieldRep SomeTypeWithDoc] -> [FieldRep SomeTypeWithDoc]
forall a. Semigroup a => a -> a -> a
<> forall (x :: * -> *).
GProductHasDoc x =>
[(Text, Text)] -> [FieldRep SomeTypeWithDoc]
gProductDocHaskellRep @y [(Text, Text)]
descr

instance TypeHasDoc a =>
         GProductHasDoc (G.S1 ('G.MetaSel 'Nothing _1 _2 _3) (G.Rec0 a)) where
  gProductDocHaskellRep :: [(Text, Text)] -> [FieldRep SomeTypeWithDoc]
gProductDocHaskellRep [(Text, Text)]
_ = OneItem [FieldRep SomeTypeWithDoc] -> [FieldRep SomeTypeWithDoc]
forall x. One x => OneItem x -> x
one (OneItem [FieldRep SomeTypeWithDoc] -> [FieldRep SomeTypeWithDoc])
-> OneItem [FieldRep SomeTypeWithDoc] -> [FieldRep SomeTypeWithDoc]
forall a b. (a -> b) -> a -> b
$ FieldRep :: forall a. Maybe Text -> Maybe Text -> a -> FieldRep a
FieldRep
    { frName :: Maybe Text
frName = Maybe Text
forall a. Maybe a
Nothing
    , frDescription :: Maybe Text
frDescription = Maybe Text
forall a. Maybe a
Nothing
    , frTypeRep :: SomeTypeWithDoc
frTypeRep = Proxy a -> SomeTypeWithDoc
forall td. TypeHasDoc td => Proxy td -> SomeTypeWithDoc
SomeTypeWithDoc (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
    }

instance (TypeHasDoc a, KnownSymbol field) =>
         GProductHasDoc (G.S1 ('G.MetaSel ('Just field) _1 _2 _3) (G.Rec0 a)) where
  gProductDocHaskellRep :: [(Text, Text)] -> [FieldRep SomeTypeWithDoc]
gProductDocHaskellRep [(Text, Text)]
descr = OneItem [FieldRep SomeTypeWithDoc] -> [FieldRep SomeTypeWithDoc]
forall x. One x => OneItem x -> x
one (OneItem [FieldRep SomeTypeWithDoc] -> [FieldRep SomeTypeWithDoc])
-> OneItem [FieldRep SomeTypeWithDoc] -> [FieldRep SomeTypeWithDoc]
forall a b. (a -> b) -> a -> b
$ FieldRep :: forall a. Maybe Text -> Maybe Text -> a -> FieldRep a
FieldRep
    { frName :: Maybe Text
frName = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
fieldName
    , frDescription :: Maybe Text
frDescription = [(Text, Text)]
descr [(Text, Text)]
-> Getting (First Text) [(Text, Text)] Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? ([(Text, Text)] -> Maybe Text)
-> Optic' (->) (Const (First Text)) [(Text, Text)] (Maybe Text)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
fieldName) Optic' (->) (Const (First Text)) [(Text, Text)] (Maybe Text)
-> ((Text -> Const (First Text) Text)
    -> Maybe Text -> Const (First Text) (Maybe Text))
-> Getting (First Text) [(Text, Text)] Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Maybe Text -> Const (First Text) (Maybe Text)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just
    , frTypeRep :: SomeTypeWithDoc
frTypeRep = Proxy a -> SomeTypeWithDoc
forall td. TypeHasDoc td => Proxy td -> SomeTypeWithDoc
SomeTypeWithDoc (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
    }
    where
      fieldName :: Text
fieldName = String -> Text
forall a. ToText a => a -> Text
toText (Proxy field -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy field -> String) -> Proxy field -> String
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall {t :: Symbol}. Proxy t
Proxy @field)

instance GProductHasDoc G.U1 where
  gProductDocHaskellRep :: [(Text, Text)] -> [FieldRep SomeTypeWithDoc]
gProductDocHaskellRep = [(Text, Text)] -> [FieldRep SomeTypeWithDoc]
forall a. Monoid a => a
mempty

-- Instances
----------------------------------------------------------------------------

-- | Constraint, required when deriving 'TypeHasDoc' for polymorphic type
-- with the least possible number of methods defined manually.
type PolyTypeHasDocC ts = Each '[TypeHasDoc] ts

-- | Version of 'PolyTypeHasDocC' for comparable types.
type PolyCTypeHasDocC ts = Each '[TypeHasDoc] ts

instance TypeHasDoc Integer where
  typeDocName :: Proxy Integer -> Text
typeDocName Proxy Integer
_ = Text
"Integer"
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"Signed number."
  typeDocDependencies :: Proxy Integer -> [SomeDocDefinitionItem]
typeDocDependencies Proxy Integer
_ = []
  typeDocHaskellRep :: TypeDocHaskellRep Integer
typeDocHaskellRep Proxy Integer
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing

instance TypeHasDoc Natural where
  typeDocName :: Proxy Natural -> Text
typeDocName Proxy Natural
_ = Text
"Natural"
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"Unsigned number."
  typeDocDependencies :: Proxy Natural -> [SomeDocDefinitionItem]
typeDocDependencies Proxy Natural
_ = []
  typeDocHaskellRep :: TypeDocHaskellRep Natural
typeDocHaskellRep Proxy Natural
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing

instance TypeHasDoc MText where
  typeDocName :: Proxy MText -> Text
typeDocName Proxy MText
_ = Text
"Text"
  typeDocMdReference :: Proxy MText -> WithinParens -> Markdown
typeDocMdReference Proxy MText
p = (Text, DType) -> [DType] -> WithinParens -> Markdown
customTypeDocMdReference (Text
"Text", Proxy MText -> DType
forall td. TypeHasDoc td => Proxy td -> DType
DType Proxy MText
p) []
  typeDocMdDescription :: Markdown
typeDocMdDescription =
    Markdown
"Michelson string.\n\n\
    \This has to contain only ASCII characters with codes from [32; 126] range; \
    \additionally, newline feed character is allowed."
  typeDocDependencies :: Proxy MText -> [SomeDocDefinitionItem]
typeDocDependencies Proxy MText
_ = []
  typeDocHaskellRep :: TypeDocHaskellRep MText
typeDocHaskellRep Proxy MText
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing

instance TypeHasDoc Bool where
  typeDocName :: Proxy Bool -> Text
typeDocName Proxy Bool
_ = Text
"Bool"
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"Bool primitive."
  typeDocDependencies :: Proxy Bool -> [SomeDocDefinitionItem]
typeDocDependencies Proxy Bool
_ = []
  typeDocHaskellRep :: TypeDocHaskellRep Bool
typeDocHaskellRep Proxy Bool
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing

instance TypeHasDoc ByteString where
  typeDocName :: Proxy ByteString -> Text
typeDocName Proxy ByteString
_ = Text
"ByteString"
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"Bytes primitive."
  typeDocDependencies :: Proxy ByteString -> [SomeDocDefinitionItem]
typeDocDependencies Proxy ByteString
_ = []
  typeDocHaskellRep :: TypeDocHaskellRep ByteString
typeDocHaskellRep Proxy ByteString
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing

instance TypeHasDoc Mutez where
  typeDocName :: Proxy Mutez -> Text
typeDocName Proxy Mutez
_ = Text
"Mutez"
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"Mutez primitive."
  typeDocDependencies :: Proxy Mutez -> [SomeDocDefinitionItem]
typeDocDependencies Proxy Mutez
_ = []
  typeDocHaskellRep :: TypeDocHaskellRep Mutez
typeDocHaskellRep Proxy Mutez
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing

instance TypeHasDoc KeyHash where
  typeDocName :: Proxy KeyHash -> Text
typeDocName Proxy KeyHash
_ = Text
"KeyHash"
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"KeyHash primitive."
  typeDocDependencies :: Proxy KeyHash -> [SomeDocDefinitionItem]
typeDocDependencies Proxy KeyHash
_ = []
  typeDocHaskellRep :: TypeDocHaskellRep KeyHash
typeDocHaskellRep Proxy KeyHash
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep KeyHash
typeDocMichelsonRep Proxy KeyHash
_ = (Maybe DocTypeRepLHS
forall a. Maybe a
Nothing, T
TKeyHash)
  typeDocMdReference :: Proxy KeyHash -> WithinParens -> Markdown
typeDocMdReference Proxy KeyHash
tp WithinParens
_ =
    (Text, DType) -> [DType] -> WithinParens -> Markdown
customTypeDocMdReference
      (Proxy KeyHash -> Text
forall a. TypeHasDoc a => Proxy a -> Text
typeDocName Proxy KeyHash
tp, Proxy KeyHash -> DType
forall td. TypeHasDoc td => Proxy td -> DType
DType Proxy KeyHash
tp)
      []
      (Bool -> WithinParens
WithinParens Bool
False)

instance TypeHasDoc Timestamp where
  typeDocName :: Proxy Timestamp -> Text
typeDocName Proxy Timestamp
_ = Text
"Timestamp"
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"Timestamp primitive."
  typeDocDependencies :: Proxy Timestamp -> [SomeDocDefinitionItem]
typeDocDependencies Proxy Timestamp
_ = []
  typeDocHaskellRep :: TypeDocHaskellRep Timestamp
typeDocHaskellRep Proxy Timestamp
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing

instance TypeHasDoc Address where
  typeDocName :: Proxy Address -> Text
typeDocName Proxy Address
_ = Text
"Address"
  typeDocMdDescription :: Markdown
typeDocMdDescription = [md|
    Address primitive.

    Unlike Michelson's `address`, it is assumed not to contain an entrypoint name,
    even if it refers to a contract; this won't be checked, so passing an entrypoint
    name may result in unexpected errors.
    |]
  typeDocDependencies :: Proxy Address -> [SomeDocDefinitionItem]
typeDocDependencies Proxy Address
_ = []
  typeDocHaskellRep :: TypeDocHaskellRep Address
typeDocHaskellRep Proxy Address
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep Address
typeDocMichelsonRep Proxy Address
_ = (Maybe DocTypeRepLHS
forall a. Maybe a
Nothing, T
TKeyHash)
  typeDocMdReference :: Proxy Address -> WithinParens -> Markdown
typeDocMdReference Proxy Address
tp WithinParens
_ =
    (Text, DType) -> [DType] -> WithinParens -> Markdown
customTypeDocMdReference
      (Proxy Address -> Text
forall a. TypeHasDoc a => Proxy a -> Text
typeDocName Proxy Address
tp, Proxy Address -> DType
forall td. TypeHasDoc td => Proxy td -> DType
DType Proxy Address
tp)
      []
      (Bool -> WithinParens
WithinParens Bool
False)

instance TypeHasDoc EpAddress where
  typeDocName :: Proxy EpAddress -> Text
typeDocName Proxy EpAddress
_ = Text
"EntrypointAddress"
  typeDocMdDescription :: Markdown
typeDocMdDescription = [md|
    Address primitive.

    This exactly matches the Michelson's `address`, and can refer to a specific entrypoint.
    |]
  typeDocDependencies :: Proxy EpAddress -> [SomeDocDefinitionItem]
typeDocDependencies Proxy EpAddress
_ = []
  typeDocHaskellRep :: TypeDocHaskellRep EpAddress
typeDocHaskellRep Proxy EpAddress
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing

instance TypeHasDoc PublicKey where
  typeDocName :: Proxy PublicKey -> Text
typeDocName Proxy PublicKey
_ = Text
"PublicKey"
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"PublicKey primitive."
  typeDocDependencies :: Proxy PublicKey -> [SomeDocDefinitionItem]
typeDocDependencies Proxy PublicKey
_ = []
  typeDocHaskellRep :: TypeDocHaskellRep PublicKey
typeDocHaskellRep Proxy PublicKey
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing

instance TypeHasDoc Signature where
  typeDocName :: Proxy Signature -> Text
typeDocName Proxy Signature
_ = Text
"Signature"
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"Signature primitive."
  typeDocDependencies :: Proxy Signature -> [SomeDocDefinitionItem]
typeDocDependencies Proxy Signature
_ = []
  typeDocHaskellRep :: TypeDocHaskellRep Signature
typeDocHaskellRep Proxy Signature
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing

instance TypeHasDoc ChainId where
  typeDocName :: Proxy ChainId -> Text
typeDocName Proxy ChainId
_ = Text
"ChainId"
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"Identifier of the current chain."
  typeDocDependencies :: Proxy ChainId -> [SomeDocDefinitionItem]
typeDocDependencies Proxy ChainId
_ = []
  typeDocHaskellRep :: TypeDocHaskellRep ChainId
typeDocHaskellRep Proxy ChainId
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing

instance TypeHasDoc () where
  typeDocName :: Proxy () -> Text
typeDocName Proxy ()
_ = Text
"()"
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"Unit primitive."
  typeDocDependencies :: Proxy () -> [SomeDocDefinitionItem]
typeDocDependencies Proxy ()
_ = []

instance TypeHasDoc Chest where
  typeDocName :: Proxy Chest -> Text
typeDocName Proxy Chest
_ = Text
"Chest"
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"Timelock puzzle chest."
  typeDocDependencies :: Proxy Chest -> [SomeDocDefinitionItem]
typeDocDependencies Proxy Chest
_ = []
  typeDocHaskellRep :: TypeDocHaskellRep Chest
typeDocHaskellRep Proxy Chest
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing

instance TypeHasDoc ChestKey where
  typeDocName :: Proxy ChestKey -> Text
typeDocName Proxy ChestKey
_ = Text
"ChestKey"
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"Timelock puzzle chest key."
  typeDocDependencies :: Proxy ChestKey -> [SomeDocDefinitionItem]
typeDocDependencies Proxy ChestKey
_ = []
  typeDocHaskellRep :: TypeDocHaskellRep ChestKey
typeDocHaskellRep Proxy ChestKey
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing

instance PolyTypeHasDocC '[a] => TypeHasDoc [a] where
  typeDocName :: Proxy [a] -> Text
typeDocName Proxy [a]
_ = Text
"List"
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"List primitive."
  typeDocMdReference :: Proxy [a] -> WithinParens -> Markdown
typeDocMdReference Proxy [a]
_ =
    -- poly1TypeDocMdReference would produce text like @[] Integer@, we want
    -- to replace this @[]@ with @List@.
    (Text, DType) -> [DType] -> WithinParens -> Markdown
customTypeDocMdReference (Text
"List", Proxy [a] -> DType
forall td. TypeHasDoc td => Proxy td -> DType
DType (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @[a])) [Proxy a -> DType
forall td. TypeHasDoc td => Proxy td -> DType
DType (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)]
  typeDocHaskellRep :: TypeDocHaskellRep [a]
typeDocHaskellRep Proxy [a]
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep [a]
typeDocMichelsonRep = forall a b.
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
forall {k} a (b :: k).
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @[Integer]

instance PolyTypeHasDocC '[a] => TypeHasDoc (Maybe a) where
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"Option primitive."
  typeDocMdReference :: Proxy (Maybe a) -> WithinParens -> Markdown
typeDocMdReference = Proxy (Maybe a) -> WithinParens -> Markdown
forall (t :: * -> *) r a.
(r ~ t a, Typeable t, Each '[TypeHasDoc] '[r, a],
 IsHomomorphic t) =>
Proxy r -> WithinParens -> Markdown
poly1TypeDocMdReference
  typeDocHaskellRep :: TypeDocHaskellRep (Maybe a)
typeDocHaskellRep Proxy (Maybe a)
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (Maybe a)
typeDocMichelsonRep = forall a b.
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
forall {k} a (b :: k).
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @(Maybe Integer)

instance PolyTypeHasDocC [l, r] => TypeHasDoc (Either l r) where
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"Or primitive."
  typeDocMdReference :: Proxy (Either l r) -> WithinParens -> Markdown
typeDocMdReference = Proxy (Either l r) -> WithinParens -> Markdown
forall (t :: * -> * -> *) r a b.
(r ~ t a b, Typeable t, Each '[TypeHasDoc] '[r, a, b],
 IsHomomorphic t) =>
Proxy r -> WithinParens -> Markdown
poly2TypeDocMdReference
  typeDocHaskellRep :: TypeDocHaskellRep (Either l r)
typeDocHaskellRep Proxy (Either l r)
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (Either l r)
typeDocMichelsonRep = forall a b.
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
forall {k} a (b :: k).
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @(Either Integer Natural)

instance PolyTypeHasDocC [a, b] => TypeHasDoc (a, b) where
  typeDocName :: Proxy (a, b) -> Text
typeDocName Proxy (a, b)
_ = Text
"(a, b)"
  typeDocMdReference :: Proxy (a, b) -> WithinParens -> Markdown
typeDocMdReference Proxy (a, b)
_ = [Markdown] -> WithinParens -> Markdown
tupleTypeDocReference
    [ Proxy a -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) (Bool -> WithinParens
WithinParens Bool
False)
    , Proxy b -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b) (Bool -> WithinParens
WithinParens Bool
False)
    ]
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"Pair primitive."
  typeDocHaskellRep :: TypeDocHaskellRep (a, b)
typeDocHaskellRep Proxy (a, b)
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (a, b)
typeDocMichelsonRep = forall a b.
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
forall {k} a (b :: k).
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @(Integer, Natural)

instance PolyCTypeHasDocC '[a] => TypeHasDoc (Set a) where
  typeDocName :: Proxy (Set a) -> Text
typeDocName Proxy (Set a)
_ = Text
"Set"
  typeDocMdReference :: Proxy (Set a) -> WithinParens -> Markdown
typeDocMdReference = Proxy (Set a) -> WithinParens -> Markdown
forall (t :: * -> *) r a.
(r ~ t a, Typeable t, Each '[TypeHasDoc] '[r, a],
 IsHomomorphic t) =>
Proxy r -> WithinParens -> Markdown
poly1TypeDocMdReference
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"Set primitive."
  typeDocDependencies :: Proxy (Set a) -> [SomeDocDefinitionItem]
typeDocDependencies Proxy (Set a)
_ = [forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @a]
  typeDocHaskellRep :: TypeDocHaskellRep (Set a)
typeDocHaskellRep Proxy (Set a)
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (Set a)
typeDocMichelsonRep = forall a b.
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
forall {k} a (b :: k).
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @(Set Integer)

instance TypeHasDoc Operation where
  typeDocName :: Proxy Operation -> Text
typeDocName Proxy Operation
_ = Text
"Operation"
  typeDocMdReference :: Proxy Operation -> WithinParens -> Markdown
typeDocMdReference Proxy Operation
tp = (Text, DType) -> [DType] -> WithinParens -> Markdown
customTypeDocMdReference (Text
"Operation", Proxy Operation -> DType
forall td. TypeHasDoc td => Proxy td -> DType
DType Proxy Operation
tp) []
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"Operation primitive."
  typeDocDependencies :: Proxy Operation -> [SomeDocDefinitionItem]
typeDocDependencies Proxy Operation
_ = []
  typeDocHaskellRep :: TypeDocHaskellRep Operation
typeDocHaskellRep Proxy Operation
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep Operation
typeDocMichelsonRep = TypeDocMichelsonRep Operation
forall a. KnownIsoT a => TypeDocMichelsonRep a
homomorphicTypeDocMichelsonRep

instance PolyTypeHasDocC '[cp] => TypeHasDoc (ContractRef cp) where
  typeDocName :: Proxy (ContractRef cp) -> Text
typeDocName Proxy (ContractRef cp)
_ = Text
"Contract"
  typeDocMdReference :: Proxy (ContractRef cp) -> WithinParens -> Markdown
typeDocMdReference = Proxy (ContractRef cp) -> WithinParens -> Markdown
forall (t :: * -> *) r a.
(r ~ t a, Typeable t, Each '[TypeHasDoc] '[r, a],
 IsHomomorphic t) =>
Proxy r -> WithinParens -> Markdown
poly1TypeDocMdReference
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"Contract primitive with given type of parameter."
  typeDocDependencies :: Proxy (ContractRef cp) -> [SomeDocDefinitionItem]
typeDocDependencies Proxy (ContractRef cp)
_ = [forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @cp, forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @Integer]
  typeDocHaskellRep :: TypeDocHaskellRep (ContractRef cp)
typeDocHaskellRep Proxy (ContractRef cp)
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (ContractRef cp)
typeDocMichelsonRep = forall a b.
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
forall {k} a (b :: k).
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @(ContractRef Integer)

instance PolyTypeHasDocC '[a] => TypeHasDoc (Ticket a) where
  typeDocName :: Proxy (Ticket a) -> Text
typeDocName Proxy (Ticket a)
_ = Text
"Ticket"
  typeDocMdReference :: Proxy (Ticket a) -> WithinParens -> Markdown
typeDocMdReference = Proxy (Ticket a) -> WithinParens -> Markdown
forall (t :: * -> *) r a.
(r ~ t a, Typeable t, Each '[TypeHasDoc] '[r, a],
 IsHomomorphic t) =>
Proxy r -> WithinParens -> Markdown
poly1TypeDocMdReference
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"Ticket primitive."
  typeDocDependencies :: Proxy (Ticket a) -> [SomeDocDefinitionItem]
typeDocDependencies Proxy (Ticket a)
_ = [forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @a, forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @MText]
  typeDocHaskellRep :: TypeDocHaskellRep (Ticket a)
typeDocHaskellRep Proxy (Ticket a)
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (Ticket a)
typeDocMichelsonRep = forall a b.
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
forall {k} a (b :: k).
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @(Ticket MText)

instance (PolyCTypeHasDocC '[k], PolyTypeHasDocC '[v], Ord k) =>
         TypeHasDoc (Map k v) where
  typeDocName :: Proxy (Map k v) -> Text
typeDocName Proxy (Map k v)
_ = Text
"Map"
  typeDocMdReference :: Proxy (Map k v) -> WithinParens -> Markdown
typeDocMdReference = Proxy (Map k v) -> WithinParens -> Markdown
forall (t :: * -> * -> *) r a b.
(r ~ t a b, Typeable t, Each '[TypeHasDoc] '[r, a, b],
 IsHomomorphic t) =>
Proxy r -> WithinParens -> Markdown
poly2TypeDocMdReference
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"Map primitive."
  typeDocDependencies :: Proxy (Map k v) -> [SomeDocDefinitionItem]
typeDocDependencies Proxy (Map k v)
_ =
    [forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @k, forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @v]
  typeDocHaskellRep :: TypeDocHaskellRep (Map k v)
typeDocHaskellRep Proxy (Map k v)
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (Map k v)
typeDocMichelsonRep = forall a b.
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
forall {k} a (b :: k).
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @(Map Integer Natural)

instance (PolyCTypeHasDocC '[k], PolyTypeHasDocC '[v], Ord k) =>
         TypeHasDoc (BigMap k v) where
  typeDocName :: Proxy (BigMap k v) -> Text
typeDocName Proxy (BigMap k v)
_ = Text
"BigMap"
  typeDocMdReference :: Proxy (BigMap k v) -> WithinParens -> Markdown
typeDocMdReference = Proxy (BigMap k v) -> WithinParens -> Markdown
forall (t :: * -> * -> *) r a b.
(r ~ t a b, Typeable t, Each '[TypeHasDoc] '[r, a, b],
 IsHomomorphic t) =>
Proxy r -> WithinParens -> Markdown
poly2TypeDocMdReference
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"BigMap primitive."
  typeDocDependencies :: Proxy (BigMap k v) -> [SomeDocDefinitionItem]
typeDocDependencies Proxy (BigMap k v)
_ =
    [forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @k, forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @v]
  typeDocHaskellRep :: TypeDocHaskellRep (BigMap k v)
typeDocHaskellRep Proxy (BigMap k v)
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (BigMap k v)
typeDocMichelsonRep = forall a b.
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
forall {k} a (b :: k).
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @(BigMap Integer Natural)


tupleTypeDocReference :: [Markdown] -> WithinParens -> Markdown
tupleTypeDocReference :: [Markdown] -> WithinParens -> Markdown
tupleTypeDocReference [Markdown]
vs WithinParens
_ = Markdown
"(" Markdown -> Markdown -> Markdown
forall b. FromBuilder b => Markdown -> Markdown -> b
+| [Markdown] -> Markdown
forall a. Monoid a => [a] -> a
mconcat (Markdown -> [Markdown] -> [Markdown]
forall a. a -> [a] -> [a]
intersperse Markdown
", " ([Markdown] -> [Markdown]) -> [Markdown] -> [Markdown]
forall a b. (a -> b) -> a -> b
$ (Markdown -> Markdown) -> [Markdown] -> [Markdown]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Markdown -> Markdown
forall p. Buildable p => p -> Markdown
build [Markdown]
vs) Markdown -> Markdown -> Markdown
forall a b. (Buildable a, FromBuilder b) => a -> Markdown -> b
|+ Markdown
")"

instance PolyTypeHasDocC [a, b, c] => TypeHasDoc (a, b, c) where
  typeDocName :: Proxy (a, b, c) -> Text
typeDocName Proxy (a, b, c)
_ = Text
"(a, b, c)"
  typeDocMdReference :: Proxy (a, b, c) -> WithinParens -> Markdown
typeDocMdReference Proxy (a, b, c)
_ = [Markdown] -> WithinParens -> Markdown
tupleTypeDocReference
    [ Proxy a -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) (Bool -> WithinParens
WithinParens Bool
False)
    , Proxy b -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b) (Bool -> WithinParens
WithinParens Bool
False)
    , Proxy c -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c) (Bool -> WithinParens
WithinParens Bool
False)
    ]
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"Tuple of size 3."
  typeDocHaskellRep :: TypeDocHaskellRep (a, b, c)
typeDocHaskellRep Proxy (a, b, c)
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (a, b, c)
typeDocMichelsonRep = forall a b.
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
forall {k} a (b :: k).
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @(Integer, Natural, MText)

instance PolyTypeHasDocC [a, b, c, d] => TypeHasDoc (a, b, c, d) where
  typeDocName :: Proxy (a, b, c, d) -> Text
typeDocName Proxy (a, b, c, d)
_ = Text
"(a, b, c, d)"
  typeDocMdReference :: Proxy (a, b, c, d) -> WithinParens -> Markdown
typeDocMdReference Proxy (a, b, c, d)
_ = [Markdown] -> WithinParens -> Markdown
tupleTypeDocReference
    [ Proxy a -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) (Bool -> WithinParens
WithinParens Bool
False)
    , Proxy b -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b) (Bool -> WithinParens
WithinParens Bool
False)
    , Proxy c -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c) (Bool -> WithinParens
WithinParens Bool
False)
    , Proxy d -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @d) (Bool -> WithinParens
WithinParens Bool
False)
    ]
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"Tuple of size 4."
  typeDocHaskellRep :: TypeDocHaskellRep (a, b, c, d)
typeDocHaskellRep Proxy (a, b, c, d)
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (a, b, c, d)
typeDocMichelsonRep =
    -- Starting from tuple of size 4 the exact types should not matter to a reader,
    -- rather the resulting pairs tree.
    forall a b.
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
forall {k} a (b :: k).
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @((), (), (), ())

instance PolyTypeHasDocC [a, b, c, d, e] => TypeHasDoc (a, b, c, d, e) where
  typeDocName :: Proxy (a, b, c, d, e) -> Text
typeDocName Proxy (a, b, c, d, e)
_ = Text
"(a, b, c, d, e)"
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"Tuple of size 5."
  typeDocMdReference :: Proxy (a, b, c, d, e) -> WithinParens -> Markdown
typeDocMdReference Proxy (a, b, c, d, e)
_ = [Markdown] -> WithinParens -> Markdown
tupleTypeDocReference
    [ Proxy a -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) (Bool -> WithinParens
WithinParens Bool
False)
    , Proxy b -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b) (Bool -> WithinParens
WithinParens Bool
False)
    , Proxy c -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c) (Bool -> WithinParens
WithinParens Bool
False)
    , Proxy d -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @d) (Bool -> WithinParens
WithinParens Bool
False)
    , Proxy e -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @e) (Bool -> WithinParens
WithinParens Bool
False)
    ]
  typeDocHaskellRep :: TypeDocHaskellRep (a, b, c, d, e)
typeDocHaskellRep Proxy (a, b, c, d, e)
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (a, b, c, d, e)
typeDocMichelsonRep =
    forall a b.
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
forall {k} a (b :: k).
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @((), (), (), (), ())

instance PolyTypeHasDocC [a, b, c, d, e, f] => TypeHasDoc (a, b, c, d, e, f) where
  typeDocName :: Proxy (a, b, c, d, e, f) -> Text
typeDocName Proxy (a, b, c, d, e, f)
_ = Text
"(a, b, c, d, e, f)"
  typeDocMdReference :: Proxy (a, b, c, d, e, f) -> WithinParens -> Markdown
typeDocMdReference Proxy (a, b, c, d, e, f)
_ = [Markdown] -> WithinParens -> Markdown
tupleTypeDocReference
    [ Proxy a -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) (Bool -> WithinParens
WithinParens Bool
False)
    , Proxy b -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b) (Bool -> WithinParens
WithinParens Bool
False)
    , Proxy c -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c) (Bool -> WithinParens
WithinParens Bool
False)
    , Proxy d -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @d) (Bool -> WithinParens
WithinParens Bool
False)
    , Proxy e -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @e) (Bool -> WithinParens
WithinParens Bool
False)
    , Proxy f -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @f) (Bool -> WithinParens
WithinParens Bool
False)
    ]
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"Tuple of size 6."
  typeDocHaskellRep :: TypeDocHaskellRep (a, b, c, d, e, f)
typeDocHaskellRep Proxy (a, b, c, d, e, f)
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (a, b, c, d, e, f)
typeDocMichelsonRep =
    forall a b.
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
forall {k} a (b :: k).
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @((), (), (), (), (), ())

instance PolyTypeHasDocC [a, b, c, d, e, f, g] => TypeHasDoc (a, b, c, d, e, f, g) where
  typeDocName :: Proxy (a, b, c, d, e, f, g) -> Text
typeDocName Proxy (a, b, c, d, e, f, g)
_ = Text
"(a, b, c, d, e, f, g)"
  typeDocMdReference :: Proxy (a, b, c, d, e, f, g) -> WithinParens -> Markdown
typeDocMdReference Proxy (a, b, c, d, e, f, g)
_ = [Markdown] -> WithinParens -> Markdown
tupleTypeDocReference
    [ Proxy a -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) (Bool -> WithinParens
WithinParens Bool
False)
    , Proxy b -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b) (Bool -> WithinParens
WithinParens Bool
False)
    , Proxy c -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c) (Bool -> WithinParens
WithinParens Bool
False)
    , Proxy d -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @d) (Bool -> WithinParens
WithinParens Bool
False)
    , Proxy e -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @e) (Bool -> WithinParens
WithinParens Bool
False)
    , Proxy f -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @f) (Bool -> WithinParens
WithinParens Bool
False)
    , Proxy g -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @g) (Bool -> WithinParens
WithinParens Bool
False)
    ]
  typeDocMdDescription :: Markdown
typeDocMdDescription = Markdown
"Tuple of size 7."
  typeDocHaskellRep :: TypeDocHaskellRep (a, b, c, d, e, f, g)
typeDocHaskellRep Proxy (a, b, c, d, e, f, g)
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (a, b, c, d, e, f, g)
typeDocMichelsonRep =
    forall a b.
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
forall {k} a (b :: k).
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @((), (), (), (), (), (), ())


instance ( TypeHasDoc (ApplyNamedFunctor f a)
         , KnownSymbol n
         , KnownIsoT (ApplyNamedFunctor f Integer)
         , Typeable f, Typeable a
         ) =>
         TypeHasDoc (NamedF f a n) where
  typeDocName :: Proxy (NamedF f a n) -> Text
typeDocName Proxy (NamedF f a n)
_ = Text
"Named entry"
  typeDocMdReference :: Proxy (NamedF f a n) -> WithinParens -> Markdown
typeDocMdReference Proxy (NamedF f a n)
_ WithinParens
wp =
    WithinParens -> Markdown -> Markdown
applyWithinParens WithinParens
wp (Markdown -> Markdown) -> Markdown -> Markdown
forall a b. (a -> b) -> a -> b
$
    Text -> Markdown
buildFieldName (String -> Text
forall a. ToText a => a -> Text
toText (Proxy n -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy n -> String) -> Proxy n -> String
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall {t :: Symbol}. Proxy t
Proxy @n)) Markdown -> Markdown -> Markdown
forall b. FromBuilder b => Markdown -> Markdown -> b
+| Markdown
" " Markdown -> Markdown -> Markdown
forall b. FromBuilder b => Markdown -> Markdown -> b
+|
    Proxy (ApplyNamedFunctor f a) -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(ApplyNamedFunctor f a)) (Bool -> WithinParens
WithinParens Bool
False) Markdown -> Markdown -> Markdown
forall a b. (Buildable a, FromBuilder b) => a -> Markdown -> b
|+ Markdown
""
  typeDocDependencies :: Proxy (NamedF f a n) -> [SomeDocDefinitionItem]
typeDocDependencies Proxy (NamedF f a n)
_ =
    [ forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @(ApplyNamedFunctor f a)
    , forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @Integer
    ]
  typeDocHaskellRep :: TypeDocHaskellRep (NamedF f a n)
typeDocHaskellRep Proxy (NamedF f a n)
_ Demote FieldDescriptions
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (NamedF f a n)
typeDocMichelsonRep Proxy (NamedF f a n)
_ = (DocTypeRepLHS -> Maybe DocTypeRepLHS
forall a. a -> Maybe a
Just DocTypeRepLHS
"number: Integer", forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: T). (SingKind T, SingI a) => Demote T
demote @(ToT (ApplyNamedFunctor f Integer)))
  typeDocMdDescription :: Markdown
typeDocMdDescription =
    Markdown
"Some entries have names for clarity.\n\n\
    \In resulting Michelson names may be mapped to annotations."