-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

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

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

  , HaveCommonTypeCtor
  , IsHomomorphic
  , genericTypeDocDependencies
  , customTypeDocMdReference
  , homomorphicTypeDocMdReference
  , poly1TypeDocMdReference
  , poly2TypeDocMdReference
  , homomorphicTypeDocHaskellRep
  , concreteTypeDocHaskellRep
  , concreteTypeDocHaskellRepUnsafe
  , haskellAddNewtypeField
  , haskellRepNoFields
  , haskellRepStripFieldPrefix
  , homomorphicTypeDocMichelsonRep
  , concreteTypeDocMichelsonRep
  , concreteTypeDocMichelsonRepUnsafe

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

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

import Michelson.Doc
import Michelson.Text
import Michelson.Typed.Aliases
import Michelson.Typed.Entrypoints
import Michelson.Typed.Haskell.ValidateDescription
import Michelson.Typed.Haskell.Value
import Michelson.Typed.T
import Tezos.Address
import Tezos.Core
import Tezos.Crypto
import Util.Generic
import Util.Lens
import Util.Markdown
import Util.Named
import 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 = NonEmpty (ConstructorRep a)

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

-- | Representation of a field with an optional description.
data FieldRep a = FieldRep
  { FieldRep a -> Maybe Text
frName :: Maybe Text
  , FieldRep a -> Maybe Text
frDescription :: Maybe Text
  , 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 :: (WithinParens -> a -> Markdown) -> ADTRep a -> Markdown
buildADTRep buildField :: WithinParens -> a -> Markdown
buildField = \case
  ctor :: ConstructorRep a
ctor@ConstructorRep{..} :| [] -> WithinParens -> ConstructorRep a -> [FieldRep a] -> Markdown
renderProduct (Bool -> WithinParens
WithinParens Bool
False) ConstructorRep a
ctor [FieldRep a]
crFields
  ps :: ADTRep a
ps -> (Markdown -> Markdown -> Markdown
forall a. Monoid a => a -> a -> a
mappend (Markdown -> Markdown
mdItalic "one of" Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> " \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)) (ADTRep a -> [Element (ADTRep a)]
forall t. Container t => t -> [Element t]
toList ADTRep a
ps)
  where
    toListItem :: a -> a
toListItem item :: a
item = "+ " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
item a -> a -> a
forall a. Semigroup a => a -> a -> a
<> "\n"

    renderNamedProduct :: WithinParens -> ConstructorRep a -> Markdown
    renderNamedProduct :: WithinParens -> ConstructorRep a -> Markdown
renderNamedProduct wp :: WithinParens
wp ctor :: ConstructorRep a
ctor@ConstructorRep{..} =
      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 "" (\d :: Text
d -> ": " 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
<> " ") 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 "" (\d :: Text
d -> ": " 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 wp :: WithinParens
wp ctor :: ConstructorRep a
ctor = \case
      [] -> "()"
      [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
      ts :: [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 (("\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 wp :: WithinParens
wp FieldRep{..} = [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 "" 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
forall a. Monoid a => a -> a -> a
mappend "    " (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 "\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 :: (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 name :: 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
|+ " :"

-- | 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 wp :: Bool
wp) txt :: Markdown
txt
  | Bool
wp = "(" Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> Markdown
txt Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> ")"
  | Bool
otherwise = Markdown
txt

-- | 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 _ = String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy (GTypeName (Rep a)) -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy (GTypeName (Rep a))
forall k (t :: k). 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 a = '[]

  -- | 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
    :: (SingI (ToT a), IsHomomorphic a)
    => TypeDocMichelsonRep a
  typeDocMichelsonRep = TypeDocMichelsonRep a
forall a. SingI (ToT 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 Show DType where
  show :: DType -> String
show (DType a :: Proxy a
a) = TypeRep -> String
forall b a. (Show a, IsString b) => a -> b
show (TypeRep -> String) -> TypeRep -> String
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 a1 :: Proxy a
a1 == :: DType -> DType -> Bool
== DType a2 :: 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 a1 :: Proxy a
a1 compare :: DType -> DType -> Ordering
`compare` DType a2 :: 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 = 5000

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

  docItemRef :: DType
-> DocItemRef (DocItemPlacement DType) (DocItemReferenced DType)
docItemRef (DType a :: Proxy a
a) = DocItemId -> DocItemRef 'DocItemInDefinitions 'True
DocItemId
-> DocItemRef (DocItemPlacement DType) (DocItemReferenced DType)
DocItemRef (DocItemId
 -> DocItemRef (DocItemPlacement DType) (DocItemReferenced DType))
-> DocItemId
-> DocItemRef (DocItemPlacement DType) (DocItemReferenced DType)
forall a b. (a -> b) -> a -> b
$
    Text -> DocItemId
DocItemId ("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 lvl :: 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
$ TypeHasDoc a => Markdown
forall a. TypeHasDoc a => Markdown
typeDocMdDescription @a Markdown -> Markdown -> Markdown
forall a b. (Buildable a, FromBuilder b) => a -> Markdown -> b
|+ "\n\n"
    , TypeDocHaskellRep a
forall a. TypeHasDoc a => TypeDocHaskellRep a
typeDocHaskellRep Proxy a
ap' ((SingKind (KindOf (TypeDocFieldDescriptions a)),
 SingI (TypeDocFieldDescriptions a)) =>
Demote (KindOf (TypeDocFieldDescriptions a))
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
<&> \(mlhs :: Maybe DocTypeRepLHS
mlhs, rep :: ADTRep SomeTypeWithDoc
rep) ->
        let
          -- Without this signature type inference trips.
          buildField :: WithinParens -> SomeTypeWithDoc -> Markdown
          buildField :: WithinParens -> SomeTypeWithDoc -> Markdown
buildField wp :: WithinParens
wp (SomeTypeWithDoc di :: 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
            Nothing ->
              Markdown -> Markdown -> Markdown
mdSubsection "Structure" Markdown
renderedRep
            Just lhs :: DocTypeRepLHS
lhs ->
              Markdown -> Markdown -> Markdown
mdSubsection "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
forall a. Semigroup a => a -> a -> a
<> Markdown
renderedRep
        in Markdown
rendered Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> "\n\n"
    , Markdown -> Maybe Markdown
forall a. a -> Maybe a
Just (Markdown -> Maybe Markdown) -> Markdown -> Maybe Markdown
forall a b. (a -> b) -> a -> b
$
        let (mlhs :: Maybe DocTypeRepLHS
mlhs, rep :: 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)
            rendered :: Markdown
rendered = case Maybe DocTypeRepLHS
mlhs of
              Nothing -> Markdown -> Markdown -> Markdown
mdSubsection "Final Michelson representation"
                         Markdown
renderedRep
              Just lhs :: DocTypeRepLHS
lhs -> Markdown -> Markdown -> Markdown
mdSubsection "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
forall a. Semigroup a => a -> a -> a
<> Markdown
renderedRep
        in Markdown
rendered Markdown -> Markdown -> Markdown
forall a. Semigroup a => a -> a -> a
<> "\n\n"
    ]

  docItemToToc :: HeaderLevel -> DType -> Markdown
docItemToToc lvl :: HeaderLevel
lvl d :: DType
d@(DType ap' :: 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

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

-- | Proxy version of 'dTypeDep'.
dTypeDepP
  :: forall (t :: Kind.Type).
      TypeHasDoc t
  => Proxy t -> SomeDocDefinitionItem
dTypeDepP :: Proxy t -> SomeDocDefinitionItem
dTypeDepP _ = TypeHasDoc t => SomeDocDefinitionItem
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
$cp1Ord :: Eq DStorageType
Ord)

-- | Shortcut for 'DStorageType'.
dStorage :: forall store. TypeHasDoc store => DStorageType
dStorage :: DStorageType
dStorage = DType -> DStorageType
DStorageType (DType -> DStorageType) -> DType -> DStorageType
forall a b. (a -> b) -> a -> b
$ Proxy store -> DType
forall a. TypeHasDoc a => Proxy a -> DType
DType (Proxy store
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 a :: Proxy a
a)) = DocItemId -> DocItemRef 'DocItemInlined 'True
DocItemId
-> DocItemRef
     (DocItemPlacement DStorageType) (DocItemReferenced DStorageType)
DocItemRefInlined (DocItemId
 -> DocItemRef
      (DocItemPlacement DStorageType) (DocItemReferenced DStorageType))
-> DocItemId
-> DocItemRef
     (DocItemPlacement DStorageType) (DocItemReferenced DStorageType)
forall a b. (a -> b) -> a -> b
$
    Text -> DocItemId
DocItemId ("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 = 835
  docItemSectionName :: Maybe Text
docItemSectionName = Text -> Maybe Text
forall a. a -> Maybe a
Just "Storage"
  docItemToMarkdown :: HeaderLevel -> DStorageType -> Markdown
docItemToMarkdown lvl :: HeaderLevel
lvl (DStorageType t :: DType
t) = HeaderLevel -> DType -> Markdown
forall d. DocItem d => HeaderLevel -> d -> Markdown
docItemToMarkdown HeaderLevel
lvl DType
t
  docItemToToc :: HeaderLevel -> DStorageType -> Markdown
docItemToToc lvl :: HeaderLevel
lvl d :: DStorageType
d@(DStorageType (DType a :: 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 t :: 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 (typeCtorName :: Text
typeCtorName, tyDoc :: DType
tyDoc) typeArgsDoc :: [DType]
typeArgsDoc wp :: WithinParens
wp =
  let DocItemRef 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
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]
: ([DType]
typeArgsDoc [DType] -> (DType -> Markdown) -> [Markdown]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(DType di :: Proxy a
di) -> Proxy a -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference Proxy a
di (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 wp' :: Bool
wp' = WithinParens
wp
        in Bool -> WithinParens
WithinParens (Bool
wp' Bool -> Bool -> Bool
&& Bool -> Bool
not ([DType] -> Bool
forall t. Container t => t -> Bool
null [DType]
typeArgsDoc))

-- | Derive 'typeDocMdReference', for homomorphic types only.
homomorphicTypeDocMdReference
  :: forall (t :: Kind.Type).
     (Typeable t, TypeHasDoc t, IsHomomorphic t)
  => Proxy t -> WithinParens -> Markdown
homomorphicTypeDocMdReference :: Proxy t -> WithinParens -> Markdown
homomorphicTypeDocMdReference tp :: Proxy t
tp _ =
  (Text, DType) -> [DType] -> WithinParens -> Markdown
customTypeDocMdReference
    (Proxy t -> Text
forall a. TypeHasDoc a => Proxy a -> Text
typeDocName Proxy t
tp, Proxy t -> DType
forall a. TypeHasDoc a => Proxy a -> 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 :: Kind.Type) (a :: Kind.Type).
      (r ~ t a, Typeable t, Each '[TypeHasDoc] [r, a], IsHomomorphic t)
  => Proxy r -> WithinParens -> Markdown
poly1TypeDocMdReference :: Proxy r -> WithinParens -> Markdown
poly1TypeDocMdReference tp :: 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 (Proxy t
forall k (t :: k). Proxy t
Proxy @t), Proxy r -> DType
forall a. TypeHasDoc a => Proxy a -> DType
DType Proxy r
tp)
    [Proxy a -> DType
forall a. TypeHasDoc a => Proxy a -> DType
DType (Proxy a
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 :: Kind.Type) (a :: Kind.Type) (b :: Kind.Type).
      (r ~ t a b, Typeable t, Each '[TypeHasDoc] [r, a, b], IsHomomorphic t)
  => Proxy r -> WithinParens -> Markdown
poly2TypeDocMdReference :: Proxy r -> WithinParens -> Markdown
poly2TypeDocMdReference tp :: 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 (Proxy t
forall k (t :: k). Proxy t
Proxy @t), Proxy r -> DType
forall a. TypeHasDoc a => Proxy a -> DType
DType Proxy r
tp)
    [ Proxy a -> DType
forall a. TypeHasDoc a => Proxy a -> DType
DType (Proxy a
forall k (t :: k). Proxy t
Proxy @a)
    , Proxy b -> DType
forall a. TypeHasDoc a => Proxy a -> DType
DType (Proxy b
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 :: Proxy a -> [SomeDocDefinitionItem]
genericTypeDocDependencies _ = do
  ConstructorRep{..} <- ADTRep SomeTypeWithDoc -> [ConstructorRep SomeTypeWithDoc]
forall t. Container t => t -> [Element t]
toList (ADTRep SomeTypeWithDoc -> [ConstructorRep SomeTypeWithDoc])
-> ADTRep SomeTypeWithDoc -> [ConstructorRep SomeTypeWithDoc]
forall a b. (a -> b) -> a -> b
$ Demote (KindOf (TypeDocFieldDescriptions a))
-> ADTRep SomeTypeWithDoc
forall (x :: * -> *).
GTypeHasDoc x =>
Demote (KindOf (TypeDocFieldDescriptions a))
-> ADTRep SomeTypeWithDoc
gTypeDocHaskellRep @(G.Rep a) []
  FieldRep{..} <- [FieldRep SomeTypeWithDoc]
crFields
  SomeTypeWithDoc ty :: 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 :: TypeDocHaskellRep a
homomorphicTypeDocHaskellRep _ descr :: Demote (KindOf (TypeDocFieldDescriptions a))
descr = (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
-> Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. a -> Maybe a
Just
  ( Maybe DocTypeRepLHS
forall a. Maybe a
Nothing
  , Demote (KindOf (TypeDocFieldDescriptions a))
-> ADTRep SomeTypeWithDoc
forall (x :: * -> *).
GTypeHasDoc x =>
Demote (KindOf (TypeDocFieldDescriptions a))
-> ADTRep SomeTypeWithDoc
gTypeDocHaskellRep @(G.Rep a) Demote (KindOf (TypeDocFieldDescriptions a))
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 :: TypeDocHaskellRep b
concreteTypeDocHaskellRep = forall b.
(Typeable a, GenericIsoValue a, GTypeHasDoc (Rep a)) =>
TypeDocHaskellRep b
forall a b.
(Typeable a, GenericIsoValue a, GTypeHasDoc (Rep a)) =>
TypeDocHaskellRep b
concreteTypeDocHaskellRepUnsafe @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.
concreteTypeDocHaskellRepUnsafe
  :: forall a b.
     ( Typeable a, GenericIsoValue a, GTypeHasDoc (G.Rep a)
     )
  => TypeDocHaskellRep b
concreteTypeDocHaskellRepUnsafe :: TypeDocHaskellRep b
concreteTypeDocHaskellRepUnsafe _ descr :: Demote (KindOf (TypeDocFieldDescriptions a))
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
$ Proxy a
forall k (t :: k). Proxy t
Proxy @a)
  , Demote (KindOf (TypeDocFieldDescriptions a))
-> ADTRep SomeTypeWithDoc
forall (x :: * -> *).
GTypeHasDoc x =>
Demote (KindOf (TypeDocFieldDescriptions a))
-> ADTRep SomeTypeWithDoc
gTypeDocHaskellRep @(G.Rep a) Demote (KindOf (TypeDocFieldDescriptions a))
descr
  )

-- | Erase fields from Haskell datatype representation.
--
-- Use this when rendering fields names is undesired.
haskellRepNoFields :: TypeDocHaskellRep a -> TypeDocHaskellRep a
haskellRepNoFields :: TypeDocHaskellRep a -> TypeDocHaskellRep a
haskellRepNoFields mkRep :: TypeDocHaskellRep a
mkRep =
  \p :: Proxy a
p descr :: Demote (KindOf (TypeDocFieldDescriptions a))
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 (KindOf (TypeDocFieldDescriptions a))
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 :: Text -> TypeDocHaskellRep a -> TypeDocHaskellRep a
haskellAddNewtypeField fieldName :: Text
fieldName mkRep :: TypeDocHaskellRep a
mkRep =
  \p :: Proxy a
p descr :: Demote (KindOf (TypeDocFieldDescriptions a))
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 (KindOf (TypeDocFieldDescriptions a))
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 :: TypeDocHaskellRep a -> TypeDocHaskellRep a
haskellRepStripFieldPrefix mkRep :: TypeDocHaskellRep a
mkRep =
  \p :: Proxy a
p descr :: Demote (KindOf (TypeDocFieldDescriptions a))
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 (KindOf (TypeDocFieldDescriptions a))
descr
  where
    stripPrefix :: Text -> Text
stripPrefix fieldName :: 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
        Nothing -> Text -> Text
forall a. HasCallStack => Text -> a
error (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ "Field '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fieldName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' has no prefix"
        Just (c :: Char
c, cs :: 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 (c2 :: Char
c2, _)
                  | Char -> Bool
isUpper Char
c2 -> Bool
True
                  | Bool
otherwise -> Bool
False
                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.
     SingI (ToT a)
  => TypeDocMichelsonRep a
homomorphicTypeDocMichelsonRep :: TypeDocMichelsonRep a
homomorphicTypeDocMichelsonRep _ =
  ( Maybe DocTypeRepLHS
forall a. Maybe a
Nothing
  , (SingKind T, SingI (ToT a)) => Demote T
forall k (a :: k). (SingKind k, SingI a) => Demote k
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, SingI (ToT a), HaveCommonTypeCtor b a)
  => TypeDocMichelsonRep b
concreteTypeDocMichelsonRep :: TypeDocMichelsonRep b
concreteTypeDocMichelsonRep _ =
  ( 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
$ Proxy a
forall k (t :: k). Proxy t
Proxy @a)
  , (SingKind T, SingI (ToT a)) => Demote T
forall k (a :: k). (SingKind k, SingI a) => Demote k
demote @(ToT a)
  )

-- | Version of 'concreteTypeDocHaskellRepUnsafe' 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.
concreteTypeDocMichelsonRepUnsafe
  :: forall a b.
     (Typeable a, SingI (ToT a))
  => TypeDocMichelsonRep b
concreteTypeDocMichelsonRepUnsafe :: TypeDocMichelsonRep b
concreteTypeDocMichelsonRepUnsafe _ =
  ( 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
$ Proxy a
forall k (t :: k). Proxy t
Proxy @a)
  , (SingKind T, SingI (ToT a)) => Demote T
forall k (a :: k). (SingKind k, SingI a) => Demote k
demote @(ToT a)
  )

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

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

instance GTypeHasDoc x => GTypeHasDoc (G.D1 ('G.MetaData _a _b _c 'True) x) where
  gTypeDocHaskellRep :: Demote (KindOf (TypeDocFieldDescriptions a))
-> ADTRep SomeTypeWithDoc
gTypeDocHaskellRep descr :: Demote (KindOf (TypeDocFieldDescriptions a))
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
$ Demote (KindOf (TypeDocFieldDescriptions a))
-> ADTRep SomeTypeWithDoc
forall (x :: * -> *).
GTypeHasDoc x =>
Demote (KindOf (TypeDocFieldDescriptions a))
-> ADTRep SomeTypeWithDoc
gTypeDocHaskellRep @x Demote (KindOf (TypeDocFieldDescriptions a))
descr

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

instance (GProductHasDoc x, KnownSymbol ctor) =>
         GTypeHasDoc (G.C1 ('G.MetaCons ctor _1 _2) x) where
  gTypeDocHaskellRep :: Demote (KindOf (TypeDocFieldDescriptions a))
-> ADTRep SomeTypeWithDoc
gTypeDocHaskellRep descr :: Demote (KindOf (TypeDocFieldDescriptions a))
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
$ $WConstructorRep :: 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 (KindOf (TypeDocFieldDescriptions a))
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 = GProductHasDoc x => [(Text, Text)] -> [FieldRep SomeTypeWithDoc]
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 (KindOf (TypeDocFieldDescriptions a))
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 (Proxy ctor
forall k (t :: k). Proxy t
Proxy @ctor)

instance TypeError ('Text "Cannot derive documentation for void-like type") =>
    GTypeHasDoc G.V1 where
  gTypeDocHaskellRep :: Demote (KindOf (TypeDocFieldDescriptions a))
-> ADTRep SomeTypeWithDoc
gTypeDocHaskellRep = Text
-> [(Text, (Maybe Text, [(Text, Text)]))] -> ADTRep SomeTypeWithDoc
forall a. HasCallStack => Text -> a
error "impossible"

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

instance (GProductHasDoc x, GProductHasDoc y) => GProductHasDoc (x :*: y) where
  gProductDocHaskellRep :: [(Text, Text)] -> [FieldRep SomeTypeWithDoc]
gProductDocHaskellRep descr :: [(Text, Text)]
descr = [(Text, Text)] -> [FieldRep SomeTypeWithDoc]
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
<> [(Text, Text)] -> [FieldRep SomeTypeWithDoc]
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 _ = 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
$ $WFieldRep :: 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 (Proxy a
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 descr :: [(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
$ $WFieldRep :: 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 (Proxy a
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
$ Proxy field
forall k (t :: k). 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 _ = "Integer"
  typeDocMdDescription :: Markdown
typeDocMdDescription = "Signed number."
  typeDocDependencies :: Proxy Integer -> [SomeDocDefinitionItem]
typeDocDependencies _ = []
  typeDocHaskellRep :: TypeDocHaskellRep Integer
typeDocHaskellRep _ _ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing

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

instance TypeHasDoc MText where
  typeDocName :: Proxy MText -> Text
typeDocName _ = "Text"
  typeDocMdReference :: Proxy MText -> WithinParens -> Markdown
typeDocMdReference p :: Proxy MText
p = (Text, DType) -> [DType] -> WithinParens -> Markdown
customTypeDocMdReference ("Text", Proxy MText -> DType
forall a. TypeHasDoc a => Proxy a -> DType
DType Proxy MText
p) []
  typeDocMdDescription :: Markdown
typeDocMdDescription =
    "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 _ = []
  typeDocHaskellRep :: TypeDocHaskellRep MText
typeDocHaskellRep _ _ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing

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

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

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

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

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

instance TypeHasDoc Address where
  typeDocName :: Proxy Address -> Text
typeDocName _ = "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 _ = []
  typeDocHaskellRep :: TypeDocHaskellRep Address
typeDocHaskellRep _ _ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing

instance TypeHasDoc EpAddress where
  typeDocName :: Proxy EpAddress -> Text
typeDocName _ = "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 _ = []
  typeDocHaskellRep :: TypeDocHaskellRep EpAddress
typeDocHaskellRep _ _ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing

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

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

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

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

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

instance PolyTypeHasDocC '[a] => TypeHasDoc (Maybe a) where
  typeDocMdDescription :: Markdown
typeDocMdDescription = "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 _ _ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (Maybe a)
typeDocMichelsonRep = forall b.
(Typeable (Maybe Integer), SingI (ToT (Maybe Integer)),
 HaveCommonTypeCtor b (Maybe Integer)) =>
TypeDocMichelsonRep b
forall k a (b :: k).
(Typeable a, SingI (ToT a), HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @(Maybe Integer)

instance PolyTypeHasDocC [l, r] => TypeHasDoc (Either l r) where
  typeDocMdDescription :: Markdown
typeDocMdDescription = "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 _ _ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (Either l r)
typeDocMichelsonRep = forall b.
(Typeable (Either Integer Natural),
 SingI (ToT (Either Integer Natural)),
 HaveCommonTypeCtor b (Either Integer Natural)) =>
TypeDocMichelsonRep b
forall k a (b :: k).
(Typeable a, SingI (ToT a), HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @(Either Integer Natural)

instance PolyTypeHasDocC [a, b] => TypeHasDoc (a, b) where
  typeDocName :: Proxy (a, b) -> Text
typeDocName _ = "(a, b)"
  typeDocMdReference :: Proxy (a, b) -> WithinParens -> Markdown
typeDocMdReference _ = [Markdown] -> WithinParens -> Markdown
tupleTypeDocReference
    [ Proxy a -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (Proxy a
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 (Proxy b
forall k (t :: k). Proxy t
Proxy @b) (Bool -> WithinParens
WithinParens Bool
False)
    ]
  typeDocMdDescription :: Markdown
typeDocMdDescription = "Pair primitive."
  typeDocHaskellRep :: TypeDocHaskellRep (a, b)
typeDocHaskellRep _ _ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (a, b)
typeDocMichelsonRep = forall b.
(Typeable (Integer, Natural), SingI (ToT (Integer, Natural)),
 HaveCommonTypeCtor b (Integer, Natural)) =>
TypeDocMichelsonRep b
forall k a (b :: k).
(Typeable a, SingI (ToT a), HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @(Integer, Natural)

instance PolyCTypeHasDocC '[a] => TypeHasDoc (Set a) where
  typeDocName :: Proxy (Set a) -> Text
typeDocName _ = "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 = "Set primitive."
  typeDocDependencies :: Proxy (Set a) -> [SomeDocDefinitionItem]
typeDocDependencies _ = [TypeHasDoc a => SomeDocDefinitionItem
forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @a]
  typeDocHaskellRep :: TypeDocHaskellRep (Set a)
typeDocHaskellRep _ _ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (Set a)
typeDocMichelsonRep = forall b.
(Typeable (Set Integer), SingI (ToT (Set Integer)),
 HaveCommonTypeCtor b (Set Integer)) =>
TypeDocMichelsonRep b
forall k a (b :: k).
(Typeable a, SingI (ToT a), HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @(Set Integer)

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

instance PolyTypeHasDocC '[cp] => TypeHasDoc (ContractRef cp) where
  typeDocName :: Proxy (ContractRef cp) -> Text
typeDocName _ = "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 = "Contract primitive with given type of parameter."
  typeDocDependencies :: Proxy (ContractRef cp) -> [SomeDocDefinitionItem]
typeDocDependencies _ = [TypeHasDoc cp => SomeDocDefinitionItem
forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @cp]
  typeDocHaskellRep :: TypeDocHaskellRep (ContractRef cp)
typeDocHaskellRep _ _ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (ContractRef cp)
typeDocMichelsonRep = forall b.
(Typeable (ContractRef Integer), SingI (ToT (ContractRef Integer)),
 HaveCommonTypeCtor b (ContractRef Integer)) =>
TypeDocMichelsonRep b
forall k a (b :: k).
(Typeable a, SingI (ToT a), HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @(ContractRef Integer)

instance (PolyCTypeHasDocC '[k], PolyTypeHasDocC '[v], Ord k) =>
         TypeHasDoc (Map k v) where
  typeDocName :: Proxy (Map k v) -> Text
typeDocName _ = "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 = "Map primitive."
  typeDocDependencies :: Proxy (Map k v) -> [SomeDocDefinitionItem]
typeDocDependencies _ =
    [TypeHasDoc k => SomeDocDefinitionItem
forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @k, TypeHasDoc v => SomeDocDefinitionItem
forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @v]
  typeDocHaskellRep :: TypeDocHaskellRep (Map k v)
typeDocHaskellRep _ _ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (Map k v)
typeDocMichelsonRep = forall b.
(Typeable (Map Integer Natural), SingI (ToT (Map Integer Natural)),
 HaveCommonTypeCtor b (Map Integer Natural)) =>
TypeDocMichelsonRep b
forall k a (b :: k).
(Typeable a, SingI (ToT 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 _ = "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 = "BigMap primitive."
  typeDocDependencies :: Proxy (BigMap k v) -> [SomeDocDefinitionItem]
typeDocDependencies _ =
    [TypeHasDoc k => SomeDocDefinitionItem
forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @k, TypeHasDoc v => SomeDocDefinitionItem
forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @v]
  typeDocHaskellRep :: TypeDocHaskellRep (BigMap k v)
typeDocHaskellRep _ _ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (BigMap k v)
typeDocMichelsonRep = forall b.
(Typeable (BigMap Integer Natural),
 SingI (ToT (BigMap Integer Natural)),
 HaveCommonTypeCtor b (BigMap Integer Natural)) =>
TypeDocMichelsonRep b
forall k a (b :: k).
(Typeable a, SingI (ToT a), HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @(BigMap Integer Natural)


tupleTypeDocReference :: [Markdown] -> WithinParens -> Markdown
tupleTypeDocReference :: [Markdown] -> WithinParens -> Markdown
tupleTypeDocReference vs :: [Markdown]
vs _ = "(" 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]
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
|+ ")"

instance PolyTypeHasDocC [a, b, c] => TypeHasDoc (a, b, c) where
  typeDocName :: Proxy (a, b, c) -> Text
typeDocName _ = "(a, b, c)"
  typeDocMdReference :: Proxy (a, b, c) -> WithinParens -> Markdown
typeDocMdReference _ = [Markdown] -> WithinParens -> Markdown
tupleTypeDocReference
    [ Proxy a -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (Proxy a
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 (Proxy b
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 (Proxy c
forall k (t :: k). Proxy t
Proxy @c) (Bool -> WithinParens
WithinParens Bool
False)
    ]
  typeDocMdDescription :: Markdown
typeDocMdDescription = "Tuple of size 3."
  typeDocHaskellRep :: TypeDocHaskellRep (a, b, c)
typeDocHaskellRep _ _ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (a, b, c)
typeDocMichelsonRep = forall b.
(Typeable (Integer, Natural, MText),
 SingI (ToT (Integer, Natural, MText)),
 HaveCommonTypeCtor b (Integer, Natural, MText)) =>
TypeDocMichelsonRep b
forall k a (b :: k).
(Typeable a, SingI (ToT 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 _ = "(a, b, c, d)"
  typeDocMdReference :: Proxy (a, b, c, d) -> WithinParens -> Markdown
typeDocMdReference _ = [Markdown] -> WithinParens -> Markdown
tupleTypeDocReference
    [ Proxy a -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (Proxy a
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 (Proxy b
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 (Proxy c
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 (Proxy d
forall k (t :: k). Proxy t
Proxy @d) (Bool -> WithinParens
WithinParens Bool
False)
    ]
  typeDocMdDescription :: Markdown
typeDocMdDescription = "Tuple of size 4."
  typeDocHaskellRep :: TypeDocHaskellRep (a, b, c, d)
typeDocHaskellRep _ _ = 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 b.
(Typeable ((), (), (), ()), SingI (ToT ((), (), (), ())),
 HaveCommonTypeCtor b ((), (), (), ())) =>
TypeDocMichelsonRep b
forall k a (b :: k).
(Typeable a, SingI (ToT 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 _ = "(a, b, c, d, e)"
  typeDocMdDescription :: Markdown
typeDocMdDescription = "Tuple of size 5."
  typeDocMdReference :: Proxy (a, b, c, d, e) -> WithinParens -> Markdown
typeDocMdReference _ = [Markdown] -> WithinParens -> Markdown
tupleTypeDocReference
    [ Proxy a -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (Proxy a
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 (Proxy b
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 (Proxy c
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 (Proxy d
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 (Proxy e
forall k (t :: k). Proxy t
Proxy @e) (Bool -> WithinParens
WithinParens Bool
False)
    ]
  typeDocHaskellRep :: TypeDocHaskellRep (a, b, c, d, e)
typeDocHaskellRep _ _ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (a, b, c, d, e)
typeDocMichelsonRep =
    forall b.
(Typeable ((), (), (), (), ()), SingI (ToT ((), (), (), (), ())),
 HaveCommonTypeCtor b ((), (), (), (), ())) =>
TypeDocMichelsonRep b
forall k a (b :: k).
(Typeable a, SingI (ToT 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 _ = "(a, b, c, d, e, f)"
  typeDocMdReference :: Proxy (a, b, c, d, e, f) -> WithinParens -> Markdown
typeDocMdReference _ = [Markdown] -> WithinParens -> Markdown
tupleTypeDocReference
    [ Proxy a -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (Proxy a
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 (Proxy b
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 (Proxy c
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 (Proxy d
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 (Proxy e
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 (Proxy f
forall k (t :: k). Proxy t
Proxy @f) (Bool -> WithinParens
WithinParens Bool
False)
    ]
  typeDocMdDescription :: Markdown
typeDocMdDescription = "Tuple of size 6."
  typeDocHaskellRep :: TypeDocHaskellRep (a, b, c, d, e, f)
typeDocHaskellRep _ _ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (a, b, c, d, e, f)
typeDocMichelsonRep =
    forall b.
(Typeable ((), (), (), (), (), ()),
 SingI (ToT ((), (), (), (), (), ())),
 HaveCommonTypeCtor b ((), (), (), (), (), ())) =>
TypeDocMichelsonRep b
forall k a (b :: k).
(Typeable a, SingI (ToT 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 _ = "(a, b, c, d, e, f, g)"
  typeDocMdReference :: Proxy (a, b, c, d, e, f, g) -> WithinParens -> Markdown
typeDocMdReference _ = [Markdown] -> WithinParens -> Markdown
tupleTypeDocReference
    [ Proxy a -> WithinParens -> Markdown
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Markdown
typeDocMdReference (Proxy a
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 (Proxy b
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 (Proxy c
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 (Proxy d
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 (Proxy e
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 (Proxy f
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 (Proxy g
forall k (t :: k). Proxy t
Proxy @g) (Bool -> WithinParens
WithinParens Bool
False)
    ]
  typeDocMdDescription :: Markdown
typeDocMdDescription = "Tuple of size 7."
  typeDocHaskellRep :: TypeDocHaskellRep (a, b, c, d, e, f, g)
typeDocHaskellRep _ _ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (a, b, c, d, e, f, g)
typeDocMichelsonRep =
    forall b.
(Typeable ((), (), (), (), (), (), ()),
 SingI (ToT ((), (), (), (), (), (), ())),
 HaveCommonTypeCtor b ((), (), (), (), (), (), ())) =>
TypeDocMichelsonRep b
forall k a (b :: k).
(Typeable a, SingI (ToT a), HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @((), (), (), (), (), (), ())


instance ( TypeHasDoc (ApplyNamedFunctor f a)
         , KnownSymbol n
         , SingI (ToT (ApplyNamedFunctor f Integer))
         , Typeable f, Typeable a
         ) =>
         TypeHasDoc (NamedF f a n) where
  typeDocName :: Proxy (NamedF f a n) -> Text
typeDocName _ = "Named entry"
  typeDocMdReference :: Proxy (NamedF f a n) -> WithinParens -> Markdown
typeDocMdReference _ wp :: 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
$ Proxy n
forall k (t :: k). Proxy t
Proxy @n)) Markdown -> Markdown -> Markdown
forall b. FromBuilder b => Markdown -> Markdown -> b
+| " " 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 (Proxy (ApplyNamedFunctor f a)
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
|+ ""
  typeDocDependencies :: Proxy (NamedF f a n) -> [SomeDocDefinitionItem]
typeDocDependencies _ =
    [ TypeHasDoc (ApplyNamedFunctor f a) => SomeDocDefinitionItem
forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @(ApplyNamedFunctor f a)
    , TypeHasDoc Integer => SomeDocDefinitionItem
forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @Integer
    ]
  typeDocHaskellRep :: TypeDocHaskellRep (NamedF f a n)
typeDocHaskellRep _ _ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (NamedF f a n)
typeDocMichelsonRep _ = (DocTypeRepLHS -> Maybe DocTypeRepLHS
forall a. a -> Maybe a
Just "number: Integer", (SingKind T, SingI (ToT (ApplyNamedFunctor f Integer))) => Demote T
forall k (a :: k). (SingKind k, SingI a) => Demote k
demote @(ToT (ApplyNamedFunctor f Integer)))
  typeDocMdDescription :: Markdown
typeDocMdDescription =
    "Some entries have names for clarity.\n\n\
    \In resulting Michelson names may be mapped to annotations."