{-# 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 HsLua ( Field (..), Module (..), (###), (<#>), (=#>), (#?)
             , defun, failLua, functionResult, liftIO, parameter, pop
             , pushViaJSON, rawgeti, top)
import HsLua.Marshalling (lastly, liftLua, peekList, peekString)
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
  { moduleName :: Name
moduleName = Name
"pandoc.cli"
  , moduleDescription :: Text
moduleDescription =
      Text
"Command line options and argument parsing."
  , moduleFields :: [Field PandocError]
moduleFields =
      [ 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`."
           ]
      ]
  , 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 a b. Peek e a -> Peek e b -> Peek e b
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 a. Peek e a -> Peek e a -> Peek e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Peek e String
forall a. a -> Peek e a
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 a b. Peek e (a -> b) -> Peek e a -> Peek e b
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 a. IO a -> LuaE e a
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 a b. LuaE e a -> (a -> LuaE e b) -> LuaE e b
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 a. a -> LuaE e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Opt
opts