{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Lua.Module.CLI
   Copyright   : © 2022-2023 Albert Krewinkel
   License     : GPL-2.0-or-later
   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>

Command line helpers
-}
module Text.Pandoc.Lua.Module.CLI
  ( documentedModule
  ) where

import Control.Applicative ((<|>))
import Data.Version (makeVersion)
import HsLua
import HsLua.REPL (defaultConfig, replWithEnv, setup)
import Text.Pandoc.App (defaultOpts, options, parseOptionsFromArgs)
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.PandocLua ()
import qualified Data.Text as T

-- | Push the pandoc.types module on the Lua stack.
documentedModule :: Module PandocError
documentedModule :: Module PandocError
documentedModule = Module :: forall e.
Name
-> Text
-> [Field e]
-> [DocumentedFunction e]
-> [(Operation, DocumentedFunction e)]
-> [LuaE e Name]
-> Module e
Module
  { moduleName :: Name
moduleName = Name
"pandoc.cli"
  , moduleDescription :: Text
moduleDescription =
      Text
"Command line options and argument parsing."
  , moduleFields :: [Field PandocError]
moduleFields =
      [ Field :: forall e. Text -> TypeSpec -> Text -> LuaE e () -> Field e
Field
        { fieldName :: Text
fieldName = Text
"default_options"
        , fieldType :: TypeSpec
fieldType = TypeSpec
"table"
        , fieldDescription :: Text
fieldDescription = Text
"Default CLI options, using a JSON-like " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
          Text
"representation."
        , fieldPushValue :: LuaE PandocError ()
fieldPushValue = Pusher PandocError Opt
forall a e. (ToJSON a, LuaError e) => Pusher e a
pushViaJSON Opt
defaultOpts
        }
      ]
  , moduleFunctions :: [DocumentedFunction PandocError]
moduleFunctions =
      [ Name
-> ((String, [String]) -> LuaE PandocError Opt)
-> HsFnPrecursor
     PandocError ((String, [String]) -> LuaE PandocError Opt)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"parse_options"
        ### parseOptions
        HsFnPrecursor
  PandocError ((String, [String]) -> LuaE PandocError Opt)
-> Parameter PandocError (String, [String])
-> HsFnPrecursor PandocError (LuaE PandocError Opt)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError (String, [String])
-> TypeSpec
-> Text
-> Text
-> Parameter PandocError (String, [String])
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker PandocError (String, [String])
forall e. LuaError e => StackIndex -> Peek e (String, [String])
peekArgs TypeSpec
"{string,...}" Text
"args"
              Text
"list of command line arguments"
        HsFnPrecursor PandocError (LuaE PandocError Opt)
-> FunctionResults PandocError Opt
-> DocumentedFunction PandocError
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher PandocError Opt
-> TypeSpec -> Text -> FunctionResults PandocError Opt
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher PandocError Opt
forall a e. (ToJSON a, LuaError e) => Pusher e a
pushViaJSON TypeSpec
"table"
              Text
"parsed options, using their JSON-like representation."
        #? T.unlines
           [ "Parses command line arguments into pandoc options."
           , "Typically this function will be used in stand-alone pandoc Lua"
           , "scripts, taking the list of arguments from the global `arg`."
           ]
        DocumentedFunction PandocError
-> Version -> DocumentedFunction PandocError
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int
3, Int
0]

      , DocumentedFunction PandocError
repl DocumentedFunction PandocError
-> Version -> DocumentedFunction PandocError
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int
3, Int
1, Int
2]
      ]
  , moduleOperations :: [(Operation, DocumentedFunction PandocError)]
moduleOperations = []
  , moduleTypeInitializers :: [LuaE PandocError Name]
moduleTypeInitializers = []
  }
 where
  peekArgs :: StackIndex -> Peek e (String, [String])
peekArgs StackIndex
idx =
    (,)
    (String -> [String] -> (String, [String]))
-> Peek e String -> Peek e ([String] -> (String, [String]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> Integer -> LuaE e Type
forall e. LuaError e => StackIndex -> Integer -> LuaE e Type
rawgeti StackIndex
idx Integer
0) Peek e Type -> Peek e String -> Peek e String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Peeker e String
forall e. Peeker e String
peekString StackIndex
top Peek e String -> Peek e String -> Peek e String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Peek e String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"") Peek e String -> LuaE e () -> Peek e String
forall e a b. Peek e a -> LuaE e b -> Peek e a
`lastly` Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1)
    Peek e ([String] -> (String, [String]))
-> Peek e [String] -> Peek e (String, [String])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Peeker e String -> Peeker e [String]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e String
forall e. Peeker e String
peekString StackIndex
idx

  parseOptions :: (String, [String]) -> LuaE e Opt
parseOptions (String
prg, [String]
args) =
    IO (Either OptInfo Opt) -> LuaE e (Either OptInfo Opt)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([OptDescr (Opt -> ExceptT OptInfo IO Opt)]
-> Opt -> String -> [String] -> IO (Either OptInfo Opt)
parseOptionsFromArgs [OptDescr (Opt -> ExceptT OptInfo IO Opt)]
options Opt
defaultOpts String
prg [String]
args) LuaE e (Either OptInfo Opt)
-> (Either OptInfo Opt -> LuaE e Opt) -> LuaE e Opt
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    \case
      Left OptInfo
e     -> String -> LuaE e Opt
forall e a. LuaError e => String -> LuaE e a
failLua (String -> LuaE e Opt) -> String -> LuaE e Opt
forall a b. (a -> b) -> a -> b
$ String
"Cannot process info option: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ OptInfo -> String
forall a. Show a => a -> String
show OptInfo
e
      Right Opt
opts -> Opt -> LuaE e Opt
forall (f :: * -> *) a. Applicative f => a -> f a
pure Opt
opts

-- | Starts a REPL.
repl :: DocumentedFunction PandocError
repl :: DocumentedFunction PandocError
repl = Name
-> (Maybe StackIndex -> LuaE PandocError NumResults)
-> HsFnPrecursor
     PandocError (Maybe StackIndex -> LuaE PandocError NumResults)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"repl"
  ### (\menvIdx -> do
          let repl' = case menvIdx of
                        Nothing -> replWithEnv Nothing
                        Just envIdx -> do
                          settop envIdx
                          fillWithGlobals envIdx
                          replWithEnv . Just =<< ref registryindex
          setup defaultConfig
          repl')
  HsFnPrecursor
  PandocError (Maybe StackIndex -> LuaE PandocError NumResults)
-> Parameter PandocError (Maybe StackIndex)
-> HsFnPrecursor PandocError (LuaE PandocError NumResults)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter PandocError StackIndex
-> Parameter PandocError (Maybe StackIndex)
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Peeker PandocError StackIndex
-> TypeSpec -> Text -> Text -> Parameter PandocError StackIndex
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (Name
-> (StackIndex -> LuaE PandocError Bool)
-> Peeker PandocError StackIndex
-> Peeker PandocError StackIndex
forall e a.
Name -> (StackIndex -> LuaE e Bool) -> Peeker e a -> Peeker e a
typeChecked Name
"table" StackIndex -> LuaE PandocError Bool
forall e. StackIndex -> LuaE e Bool
istable Peeker PandocError StackIndex
forall (f :: * -> *) a. Applicative f => a -> f a
pure) TypeSpec
"table" Text
"env"
           (Text
"Extra environment; the global environment is merged into this" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
           Text
" table."))
  HsFnPrecursor PandocError (LuaE PandocError NumResults)
-> Text -> DocumentedFunction PandocError
forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> [Text] -> Text
T.unlines
      [ Text
"The result(s) of the last evaluated input, or nothing if the last"
      , Text
"input resulted in an error."
      ]
  #? T.unlines
  [ "Starts a read-eval-print loop (REPL). The function returns all"
  , "values of the last evaluated input. Exit the REPL by pressing"
  , "`ctrl-d` or `ctrl-c`; press `F1` to get a list of all key"
  , "bindings."
  , ""
  , "The REPL is started in the global namespace, unless the `env`"
  , "parameter is specified. In that case, the global namespace is"
  , "merged into the given table and the result is used as `_ENV` value"
  , "for the repl."
  , ""
  , "Specifically, local variables *cannot* be accessed, unless they"
  , "are explicitly passed via the `env` parameter; e.g."
  , ""
  , "    function Pandoc (doc)"
  , "      -- start repl, allow to access the `doc` parameter"
  , "      -- in the repl"
  , "      return pandoc.cli.repl{ doc = doc }"
  , "    end"
  , ""
  , "**Note**: it seems that the function exits immediately on Windows,"
  , "without prompting for user input."
  ]
 where
  fillWithGlobals :: StackIndex -> LuaE e ()
fillWithGlobals StackIndex
idx = do
    -- Copy all global values into the table
    LuaE e ()
forall e. LuaE e ()
pushglobaltable
    LuaE e ()
forall e. LuaE e ()
pushnil
    let copyval :: LuaE e ()
copyval = StackIndex -> LuaE e Bool
forall e. LuaError e => StackIndex -> LuaE e Bool
next (CInt -> StackIndex
nth CInt
2) LuaE e Bool -> (Bool -> LuaE e ()) -> LuaE e ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Bool
False -> () -> LuaE e ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Bool
True -> do
            StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
pushvalue (CInt -> StackIndex
nth CInt
2)
            StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
insert (CInt -> StackIndex
nth CInt
2)
            StackIndex -> LuaE e ()
forall e. LuaError e => StackIndex -> LuaE e ()
rawset StackIndex
idx
            LuaE e ()
copyval
    LuaE e ()
copyval
    Int -> LuaE e ()
forall e. Int -> LuaE e ()
pop Int
1  -- global table