{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : HsLua.Packaging.Documentation
Copyright   : © 2020-2023 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb@hslua.org>

Provides a function to print documentation if available.
-}
module HsLua.Packaging.Documentation
  ( documentation
  , getdocumentation
  , registerDocumentation
  , pushModuleDoc
  , pushFunctionDoc
  , pushFieldDoc
  , docsField
  ) where

import Data.Version (showVersion)
import HsLua.Core as Lua
import HsLua.Marshalling
import HsLua.Packaging.Types
import HsLua.Typing (pushTypeSpec)

-- | Function that retrieves documentation.
documentation :: LuaError e => DocumentedFunction e
documentation :: forall e. LuaError e => DocumentedFunction e
documentation =
  DocumentedFunction
  { callFunction :: LuaE e NumResults
callFunction = forall e. LuaError e => LuaE e NumResults
documentationHaskellFunction
  , functionName :: Name
functionName = Name
"documentation"
  , functionDoc :: FunctionDoc
functionDoc = FunctionDoc
    { functionDescription :: Text
functionDescription =
      Text
"Retrieves the documentation of the given object."
    , parameterDocs :: [ParameterDoc]
parameterDocs =
      [ ParameterDoc
        { parameterName :: Text
parameterName = Text
"value"
        , parameterType :: TypeSpec
parameterType = TypeSpec
"any"
        , parameterDescription :: Text
parameterDescription = Text
"documented object"
        , parameterIsOptional :: Bool
parameterIsOptional = Bool
False
        }
      ]
    , functionResultsDocs :: ResultsDoc
functionResultsDocs =  [ResultValueDoc] -> ResultsDoc
ResultsDocList
      [ TypeSpec -> Text -> ResultValueDoc
ResultValueDoc TypeSpec
"string|nil" Text
"docstring" ]
    , functionSince :: Maybe Version
functionSince = forall a. Maybe a
Nothing
    }
  }

-- | Function that returns the documentation of a given object, or @nil@
-- if no documentation is available.
documentationHaskellFunction :: LuaError e => LuaE e NumResults
documentationHaskellFunction :: forall e. LuaError e => LuaE e NumResults
documentationHaskellFunction = forall e. StackIndex -> LuaE e Bool
isnoneornil (CInt -> StackIndex
nthBottom CInt
1) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Bool
True -> forall e a. LuaError e => String -> LuaE e a
failLua String
"expected a non-nil value as argument 1"
  Bool
_ -> CInt -> NumResults
NumResults CInt
1 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e. LuaError e => StackIndex -> LuaE e Type
getdocumentation StackIndex
top

-- | Pushes the documentation for the element at the given stack index.
-- Returns the type of the documentation object.
getdocumentation :: LuaError e => StackIndex -> LuaE e Lua.Type
getdocumentation :: forall e. LuaError e => StackIndex -> LuaE e Type
getdocumentation StackIndex
idx = do
  StackIndex
idx' <- forall e. StackIndex -> LuaE e StackIndex
absindex StackIndex
idx
  forall e. LuaError e => LuaE e ()
pushDocumentationTable
  forall e. StackIndex -> LuaE e ()
pushvalue StackIndex
idx'
  forall e. LuaError e => StackIndex -> LuaE e Type
rawget (CInt -> StackIndex
nth CInt
2) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e. StackIndex -> LuaE e ()
Lua.remove (CInt -> StackIndex
nth CInt
2)  -- remove documentation table

-- | Registers the object at the top of the stack as documentation for
-- the object at index @idx@. Pops the documentation of the stack.
registerDocumentation :: LuaError e
                      => StackIndex  -- ^ @idx@
                      -> LuaE e ()
registerDocumentation :: forall e. LuaError e => StackIndex -> LuaE e ()
registerDocumentation StackIndex
idx = do
  forall e. LuaError e => Int -> String -> LuaE e ()
checkstack' Int
10 String
"registerDocumentation"  -- keep some buffer
  StackIndex
idx' <- forall e. StackIndex -> LuaE e StackIndex
absindex StackIndex
idx
  forall e. LuaError e => LuaE e ()
pushDocumentationTable
  forall e. StackIndex -> LuaE e ()
pushvalue StackIndex
idx'    -- the documented object
  forall e. StackIndex -> LuaE e ()
pushvalue (CInt -> StackIndex
nth CInt
3) -- documentation object
  forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)    -- add to docs table
  forall e. Int -> LuaE e ()
pop Int
2             -- docs table and documentation object

-- | Pushes the documentation table that's stored in the registry to the
-- top of the stack, creating it if necessary. The documentation table
-- is indexed by the documented objects, like module tables and
-- functions, and contains documentation strings as values.
--
-- The table is an ephemeron table, i.e., an entry gets garbage
-- collected if the key is no longer reachable.
pushDocumentationTable :: LuaError e => LuaE e ()
pushDocumentationTable :: forall e. LuaError e => LuaE e ()
pushDocumentationTable = forall e. LuaError e => StackIndex -> Name -> LuaE e Type
Lua.getfield StackIndex
registryindex Name
docsField forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
Lua.TypeTable -> forall (m :: * -> *) a. Monad m => a -> m a
return () -- documentation table already initialized
  Type
_ -> do
    forall e. Int -> LuaE e ()
pop Int
1            -- pop non-table value
    forall e. LuaE e ()
newtable         -- create documentation table
    forall e. ByteString -> LuaE e ()
pushstring ByteString
"k"   -- Make it an "ephemeron table" and..
    forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield (CInt -> StackIndex
nth CInt
2) Name
"__mode"  -- collect docs if documented object is GCed
    forall e. StackIndex -> LuaE e ()
pushvalue StackIndex
top    -- add copy of table to registry
    forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield StackIndex
registryindex Name
docsField

-- | Name of the registry field holding the documentation table. The
-- documentation table is indexed by the documented objects, like module
-- tables and functions, and contains documentation strings as values.
--
-- The table is an ephemeron table, i.e., an entry gets garbage
-- collected if the key is no longer reachable.
docsField :: Name
docsField :: Name
docsField = Name
"HsLua docs"

-- | Pushes the documentation of a module as a table with string fields
-- @name@ and @description@.
pushModuleDoc :: LuaError e => Pusher e (Module e)
pushModuleDoc :: forall e. LuaError e => Pusher e (Module e)
pushModuleDoc = forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable
  [ (Name
"name", forall e. Name -> LuaE e ()
pushName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Module e -> Name
moduleName)
  , (Name
"description", forall e. Pusher e Text
pushText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Module e -> Text
moduleDescription)
  , (Name
"fields", forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList forall e. LuaError e => Pusher e (Field e)
pushFieldDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Module e -> [Field e]
moduleFields)
  , (Name
"functions", forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList forall e. LuaError e => Pusher e (DocumentedFunction e)
pushFunctionDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Module e -> [DocumentedFunction e]
moduleFunctions)
  ]

-- | Pushes the documentation of a field as a table with string fields
-- @name@ and @description@.
pushFieldDoc :: LuaError e => Pusher e (Field e)
pushFieldDoc :: forall e. LuaError e => Pusher e (Field e)
pushFieldDoc = forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable
  [ (Name
"name", forall e. Pusher e Text
pushText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Field e -> Text
fieldName)
  , (Name
"type", forall e. LuaError e => TypeSpec -> LuaE e ()
pushTypeSpec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Field e -> TypeSpec
fieldType)
  , (Name
"description", forall e. Pusher e Text
pushText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Field e -> Text
fieldDescription)
  ]

-- | Pushes the documentation of a function as a table with string
-- fields, @name@, @description@, and @since@, sequence field
-- @parameters@, and sequence or string field @results@.
pushFunctionDoc :: LuaError e => Pusher e (DocumentedFunction e)
pushFunctionDoc :: forall e. LuaError e => Pusher e (DocumentedFunction e)
pushFunctionDoc DocumentedFunction e
fun = forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable
  [ (Name
"name", forall e. Name -> LuaE e ()
pushName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const (forall e. DocumentedFunction e -> Name
functionName DocumentedFunction e
fun))
  , (Name
"description", forall e. Pusher e Text
pushText forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionDoc -> Text
functionDescription)
  , (Name
"parameters", forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList forall e. LuaError e => Pusher e ParameterDoc
pushParameterDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionDoc -> [ParameterDoc]
parameterDocs)
  , (Name
"results", forall e. LuaError e => Pusher e ResultsDoc
pushResultsDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionDoc -> ResultsDoc
functionResultsDocs)
  , (Name
"since", forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall e. LuaE e ()
pushnil (forall e. String -> LuaE e ()
pushString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
showVersion) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionDoc -> Maybe Version
functionSince)
  ] (forall e. DocumentedFunction e -> FunctionDoc
functionDoc DocumentedFunction e
fun)

-- | Pushes the documentation of a parameter as a table with boolean
-- field @optional@ and string fields @name@, @type@, and @description@.
pushParameterDoc :: LuaError e => Pusher e ParameterDoc
pushParameterDoc :: forall e. LuaError e => Pusher e ParameterDoc
pushParameterDoc = forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable
  [ (Name
"name", forall e. Pusher e Text
pushText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParameterDoc -> Text
parameterName)
  , (Name
"type", forall e. LuaError e => TypeSpec -> LuaE e ()
pushTypeSpec forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParameterDoc -> TypeSpec
parameterType)
  , (Name
"description", forall e. Pusher e Text
pushText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParameterDoc -> Text
parameterDescription)
  , (Name
"optional", forall e. Pusher e Bool
pushBool forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParameterDoc -> Bool
parameterIsOptional)
  ]

-- | Pushes a the documentation for a function's return values as either
-- a simple string, or as a sequence of tables with @type@ and
-- @description@ fields.
pushResultsDoc :: LuaError e => Pusher e ResultsDoc
pushResultsDoc :: forall e. LuaError e => Pusher e ResultsDoc
pushResultsDoc = \case
  ResultsDocMult Text
desc -> forall e. Pusher e Text
pushText Text
desc
  ResultsDocList [ResultValueDoc]
resultDocs -> forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList forall e. LuaError e => Pusher e ResultValueDoc
pushResultValueDoc [ResultValueDoc]
resultDocs

-- | Pushes the documentation of a single result value as a table with
-- fields @type@ and @description@.
pushResultValueDoc :: LuaError e => Pusher e ResultValueDoc
pushResultValueDoc :: forall e. LuaError e => Pusher e ResultValueDoc
pushResultValueDoc = forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable
  [ (Name
"type", forall e. LuaError e => TypeSpec -> LuaE e ()
pushTypeSpec forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultValueDoc -> TypeSpec
resultValueType)
  , (Name
"description", forall e. Pusher e Text
pushText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultValueDoc -> Text
resultValueDescription)
  ]