{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Lua.Module.Types
   Copyright   : © 2019-2022 Albert Krewinkel
   License     : GNU GPL, version 2 or above

   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
   Stability   : alpha

Pandoc data type constructors.
-}
module Text.Pandoc.Lua.Module.Types
  ( documentedModule
  ) where

import HsLua ( Module (..), (###), (<#>), (=#>)
             , defun, functionResult, parameter)
import HsLua.Module.Version (peekVersionFuzzy, pushVersion)
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.ErrorConversion ()

-- | Push the pandoc.types module on the Lua stack.
documentedModule :: Module PandocError
documentedModule :: Module PandocError
documentedModule = Module
  { moduleName :: Name
moduleName = Name
"pandoc.types"
  , moduleDescription :: Text
moduleDescription =
      Text
"Constructors for types that are not part of the pandoc AST."
  , moduleFields :: [Field PandocError]
moduleFields = []
  , moduleFunctions :: [DocumentedFunction PandocError]
moduleFunctions =
      [ forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Version"
        ### return
        forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e Version
peekVersionFuzzy Text
"string|integer|{integer,...}|Version"
              Text
"version_specifier"
              (forall a. Monoid a => [a] -> a
mconcat [ Text
"either a version string like `'2.7.3'`, "
                       , Text
"a single integer like `2`, "
                       , Text
"list of integers like `{2,7,3}`, "
                       , Text
"or a Version object"
                       ])
        forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. LuaError e => Pusher e Version
pushVersion Text
"Version" Text
"A new Version object."
      ]
  , moduleOperations :: [(Operation, DocumentedFunction PandocError)]
moduleOperations = []
  }