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

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

-- | Function that retrieves documentation.
documentation :: LuaError e => DocumentedFunction e
documentation :: DocumentedFunction e
documentation =
  DocumentedFunction :: forall e.
LuaE e NumResults -> Name -> FunctionDoc -> DocumentedFunction e
DocumentedFunction
  { callFunction :: LuaE e NumResults
callFunction = LuaE e NumResults
forall e. LuaError e => LuaE e NumResults
documentationHaskellFunction
  , functionName :: Name
functionName = Name
"documentation"
  , functionDoc :: FunctionDoc
functionDoc = FunctionDoc :: Text
-> [ParameterDoc] -> ResultsDoc -> Maybe Version -> FunctionDoc
FunctionDoc
    { functionDescription :: Text
functionDescription =
      Text
"Retrieves the documentation of the given object."
    , parameterDocs :: [ParameterDoc]
parameterDocs =
      [ ParameterDoc :: Text -> Text -> Text -> Bool -> ParameterDoc
ParameterDoc
        { parameterName :: Text
parameterName = Text
"value"
        , parameterType :: Text
parameterType = Text
"any"
        , parameterDescription :: Text
parameterDescription = Text
"documented object"
        , parameterIsOptional :: Bool
parameterIsOptional = Bool
False
        }
      ]
    , functionResultsDocs :: ResultsDoc
functionResultsDocs =  [ResultValueDoc] -> ResultsDoc
ResultsDocList
      [ Text -> Text -> ResultValueDoc
ResultValueDoc Text
"string|nil" Text
"docstring" ]
    , functionSince :: Maybe Version
functionSince = Maybe Version
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 :: LuaE e NumResults
documentationHaskellFunction = StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
isnoneornil (CInt -> StackIndex
nthBottom CInt
1) LuaE e Bool -> (Bool -> LuaE e NumResults) -> LuaE e NumResults
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Bool
True -> String -> LuaE e NumResults
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 NumResults -> LuaE e Type -> LuaE e NumResults
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StackIndex -> LuaE e Type
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 :: StackIndex -> LuaE e Type
getdocumentation StackIndex
idx = do
  StackIndex
idx' <- StackIndex -> LuaE e StackIndex
forall e. StackIndex -> LuaE e StackIndex
absindex StackIndex
idx
  LuaE e ()
forall e. LuaError e => LuaE e ()
pushDocumentationTable
  StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
pushvalue StackIndex
idx'
  StackIndex -> LuaE e Type
forall e. LuaError e => StackIndex -> LuaE e Type
rawget (CInt -> StackIndex
nth CInt
2) LuaE e Type -> LuaE e () -> LuaE e Type
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StackIndex -> LuaE e ()
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 :: StackIndex -> LuaE e ()
registerDocumentation StackIndex
idx = do
  Int -> String -> LuaE e ()
forall e. LuaError e => Int -> String -> LuaE e ()
checkstack' Int
10 String
"registerDocumentation"  -- keep some buffer
  StackIndex
idx' <- StackIndex -> LuaE e StackIndex
forall e. StackIndex -> LuaE e StackIndex
absindex StackIndex
idx
  LuaE e ()
forall e. LuaError e => LuaE e ()
pushDocumentationTable
  StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
pushvalue StackIndex
idx'    -- the documented object
  StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
pushvalue (CInt -> StackIndex
nth CInt
3) -- documentation object
  StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset (CInt -> StackIndex
nth CInt
3)    -- add to docs table
  Int -> LuaE e ()
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 :: LuaE e ()
pushDocumentationTable = StackIndex -> Name -> LuaE e Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
Lua.getfield StackIndex
registryindex Name
docsField LuaE e Type -> (Type -> LuaE e ()) -> LuaE e ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Type
Lua.TypeTable -> () -> LuaE e ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- documentation table already initialized
  Type
_ -> do
    Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1            -- pop non-table value
    LuaE e ()
forall e. LuaE e ()
newtable         -- create documentation table
    ByteString -> LuaE e ()
forall e. ByteString -> LuaE e ()
pushstring ByteString
"k"   -- Make it an "ephemeron table" and..
    StackIndex -> Name -> LuaE e ()
forall e. LuaError e => StackIndex -> Name -> LuaE e ()
setfield (CInt -> StackIndex
nth CInt
2) Name
"__mode"  -- collect docs if documented object is GCed
    StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
pushvalue StackIndex
top    -- add copy of table to registry
    StackIndex -> Name -> LuaE e ()
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 :: Pusher e (Module e)
pushModuleDoc = [(Name, Pusher e (Module e))] -> Pusher e (Module e)
forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable
  [ (Name
"name", Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName (Name -> LuaE e ()) -> (Module e -> Name) -> Pusher e (Module e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module e -> Name
forall e. Module e -> Name
moduleName)
  , (Name
"description", Pusher e Text
forall e. Pusher e Text
pushText Pusher e Text -> (Module e -> Text) -> Pusher e (Module e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module e -> Text
forall e. Module e -> Text
moduleDescription)
  , (Name
"fields", Pusher e (Field e) -> [Field e] -> LuaE e ()
forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList Pusher e (Field e)
forall e. LuaError e => Pusher e (Field e)
pushFieldDoc ([Field e] -> LuaE e ())
-> (Module e -> [Field e]) -> Pusher e (Module e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module e -> [Field e]
forall e. Module e -> [Field e]
moduleFields)
  , (Name
"functions", Pusher e (DocumentedFunction e)
-> [DocumentedFunction e] -> LuaE e ()
forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList Pusher e (DocumentedFunction e)
forall e. LuaError e => Pusher e (DocumentedFunction e)
pushFunctionDoc ([DocumentedFunction e] -> LuaE e ())
-> (Module e -> [DocumentedFunction e]) -> Pusher e (Module e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module e -> [DocumentedFunction e]
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 :: Pusher e (Field e)
pushFieldDoc = [(Name, Pusher e (Field e))] -> Pusher e (Field e)
forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable
  [ (Name
"name", Pusher e Text
forall e. Pusher e Text
pushText Pusher e Text -> (Field e -> Text) -> Pusher e (Field e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field e -> Text
forall e. Field e -> Text
fieldName)
  , (Name
"description", Pusher e Text
forall e. Pusher e Text
pushText Pusher e Text -> (Field e -> Text) -> Pusher e (Field e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field e -> Text
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 :: Pusher e (DocumentedFunction e)
pushFunctionDoc DocumentedFunction e
fun = [(Name, FunctionDoc -> LuaE e ())] -> FunctionDoc -> LuaE e ()
forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable
  [ (Name
"name", Name -> LuaE e ()
forall e. Name -> LuaE e ()
pushName (Name -> LuaE e ())
-> (FunctionDoc -> Name) -> FunctionDoc -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> FunctionDoc -> Name
forall a b. a -> b -> a
const (DocumentedFunction e -> Name
forall e. DocumentedFunction e -> Name
functionName DocumentedFunction e
fun))
  , (Name
"description", Pusher e Text
forall e. Pusher e Text
pushText Pusher e Text -> (FunctionDoc -> Text) -> FunctionDoc -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionDoc -> Text
functionDescription)
  , (Name
"parameters", Pusher e ParameterDoc -> [ParameterDoc] -> LuaE e ()
forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList Pusher e ParameterDoc
forall e. LuaError e => Pusher e ParameterDoc
pushParameterDoc ([ParameterDoc] -> LuaE e ())
-> (FunctionDoc -> [ParameterDoc]) -> FunctionDoc -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionDoc -> [ParameterDoc]
parameterDocs)
  , (Name
"results", Pusher e ResultsDoc
forall e. LuaError e => Pusher e ResultsDoc
pushResultsDoc Pusher e ResultsDoc
-> (FunctionDoc -> ResultsDoc) -> FunctionDoc -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionDoc -> ResultsDoc
functionResultsDocs)
  , (Name
"since", LuaE e () -> (Version -> LuaE e ()) -> Maybe Version -> LuaE e ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LuaE e ()
forall e. LuaE e ()
pushnil (String -> LuaE e ()
forall e. String -> LuaE e ()
pushString (String -> LuaE e ())
-> (Version -> String) -> Version -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
showVersion) (Maybe Version -> LuaE e ())
-> (FunctionDoc -> Maybe Version) -> FunctionDoc -> LuaE e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionDoc -> Maybe Version
functionSince)
  ] (DocumentedFunction e -> FunctionDoc
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 :: Pusher e ParameterDoc
pushParameterDoc = [(Name, Pusher e ParameterDoc)] -> Pusher e ParameterDoc
forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable
  [ (Name
"name", Pusher e Text
forall e. Pusher e Text
pushText Pusher e Text -> (ParameterDoc -> Text) -> Pusher e ParameterDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParameterDoc -> Text
parameterName)
  , (Name
"type", Pusher e Text
forall e. Pusher e Text
pushText Pusher e Text -> (ParameterDoc -> Text) -> Pusher e ParameterDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParameterDoc -> Text
parameterType)
  , (Name
"description", Pusher e Text
forall e. Pusher e Text
pushText Pusher e Text -> (ParameterDoc -> Text) -> Pusher e ParameterDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParameterDoc -> Text
parameterDescription)
  , (Name
"optional", Pusher e Bool
forall e. Pusher e Bool
pushBool Pusher e Bool -> (ParameterDoc -> Bool) -> Pusher e ParameterDoc
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 :: Pusher e ResultsDoc
pushResultsDoc = \case
  ResultsDocMult Text
desc -> Pusher e Text
forall e. Pusher e Text
pushText Text
desc
  ResultsDocList [ResultValueDoc]
resultDocs -> Pusher e ResultValueDoc -> [ResultValueDoc] -> LuaE e ()
forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList Pusher e ResultValueDoc
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 :: Pusher e ResultValueDoc
pushResultValueDoc = [(Name, Pusher e ResultValueDoc)] -> Pusher e ResultValueDoc
forall e a.
LuaError e =>
[(Name, a -> LuaE e ())] -> a -> LuaE e ()
pushAsTable
  [ (Name
"type", Pusher e Text
forall e. Pusher e Text
pushText Pusher e Text
-> (ResultValueDoc -> Text) -> Pusher e ResultValueDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultValueDoc -> Text
resultValueType)
  , (Name
"description", Pusher e Text
forall e. Pusher e Text
pushText Pusher e Text
-> (ResultValueDoc -> Text) -> Pusher e ResultValueDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultValueDoc -> Text
resultValueDescription)
  ]