{-# OPTIONS_GHC -Wno-orphans #-}

module Lorentz.Doc
  ( doc
  , docGroup
  , buildLorentzDoc
  , renderLorentzDoc
  , contractName
  , cutLorentzNonDoc

    -- * Re-exports
  , Markdown
  , DocItem (..)
  , docItemPosition
  , DocItemId (..)
  , DocItemPlacementKind (..)
  , DocItemRef (..)
  , DocSectionNameStyle (..)
  , SomeDocItem (..)
  , SomeDocDefinitionItem (..)
  , SubDoc (..)
  , DocGrouping
  , ContractDoc (..)
  , DDescription (..)
  , DGitRevision (..)
  , GitRepoSettings (..)
  , mkDGitRevision
  , morleyRepoSettings
  , DComment (..)
  , DType (..)
  , docDefinitionRef
  , contractDocToMarkdown
  , subDocToMarkdown

  , TypeHasDoc (..)
  , SomeTypeWithDoc (..)

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

import Data.Singletons (demote)

import Lorentz.Base
import Lorentz.Value
import Lorentz.Zip ()
import Michelson.Doc
import Michelson.Optimizer
import Michelson.Typed
import Util.Markdown
import Util.Type

-- | Put a document item.
doc :: DocItem di => di -> s :-> s
doc = I . Ext . DOC_ITEM . SomeDocItem

-- | Group documentation built in the given piece of code
-- into block dedicated to one thing, e.g. to one entrypoint.
docGroup :: DocGrouping -> (inp :-> out) -> (inp :-> out)
docGroup gr = iMapAnyCode (DocGroup gr)

-- | Give a name to given contract. Apply it to the whole contract code.
contractName :: Text -> (inp :-> out) -> (inp :-> out)
contractName name = docGroup (SomeDocItem . DName name)

buildLorentzDoc :: inp :-> out -> ContractDoc
buildLorentzDoc (iAnyCode -> code) = buildInstrDoc code

renderLorentzDoc :: inp :-> out -> LText
renderLorentzDoc = contractDocToMarkdown . buildLorentzDoc

-- | Leave only instructions related to documentation.
--
-- This function is useful when your method executes a lambda coming from outside,
-- but you know its properties and want to propagate its documentation to your
-- contract code.
cutLorentzNonDoc :: (inp :-> out) -> (s :-> s)
cutLorentzNonDoc (iAnyCode -> code) = I $ cutInstrNonDoc optimize code

instance Each [Typeable, ReifyList TypeHasDoc] [i, o] =>
         TypeHasDoc (i :-> o) where
  typeDocName _ = "Code (extended lambda)"
  typeDocMdReference tp wp =
    let DocItemRef (DocItemId ctorDocItemId) = docItemRef (DType tp)
        refToThis = mdLocalRef (mdTicked "Code") ctorDocItemId
    in applyWithinParens wp $
      mconcat $ intersperse " " [refToThis, refToStack @i, refToStack @o]
    where
    refToStack :: forall s. ReifyList TypeHasDoc s => Markdown
    refToStack =
      let stack = reifyList @_ @TypeHasDoc @s (\p -> typeDocMdReference p (WithinParens False))
      in mconcat
          [ mdBold "["
          , case stack of
              [] -> " "
              st -> mconcat $ intersperse (mdBold "," <> " ") st
          , mdBold "]"
          ]

  typeDocMdDescription =
    "`Code i o` stands for a sequence of instructions which accepts stack \
    \of type `i` and returns stack of type `o`.\n\n\
    \When both `i` and `o` are of length 1, this primitive corresponds to \
    \the Michelson lambda. In more complex cases code is surrounded with `pair`\
    \and `unpair` instructions until fits into mentioned restriction.\
    \"
  typeDocDependencies _ = mconcat
    [ reifyList @_ @TypeHasDoc @i SomeTypeWithDoc
    , reifyList @_ @TypeHasDoc @o SomeTypeWithDoc
    , [ SomeTypeWithDoc (Proxy @Integer)
      , SomeTypeWithDoc (Proxy @Natural)
      , SomeTypeWithDoc (Proxy @MText)
      ]
    ]
  typeDocHaskellRep _ = Nothing
  typeDocMichelsonRep _ =
    ( Just "Code [Integer, Natural, MText, ()] [ByteString]"
    , demote @(ToT ([Integer, Natural, MText, ()] :-> '[ByteString]))
    )