    {-
    Copyright © 2012-2018 John MacFarlane <jgm@berkeley.edu>
                2017-2018 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
    -}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE NoImplicitPrelude #-}
    {- |
       Module      : Text.Pandoc.Lua.Util
       Copyright   : © 2012–2018 John MacFarlane,
                     © 2017-2018 Albert Krewinkel
       License     : GNU GPL, version 2 or above

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

    Lua utility functions.
    -}
    module Text.Pandoc.Lua.Util
      ( getTag
      , rawField
      , addField
      , addFunction
      , addValue
      , pushViaConstructor
      , loadScriptFromDataDir
      , defineHowTo
      , throwTopMessageAsError'
      , callWithTraceback
      , dofileWithTraceback
      ) where

    import Prelude
    import Control.Monad (unless, when)
    import Foreign.Lua ( Lua, NumArgs, NumResults, Peekable, Pushable, StackIndex
                       , Status, ToHaskellFunction )
    import Text.Pandoc.Class (readDataFile, runIOorExplode, setUserDataDir)

    import qualified Foreign.Lua as Lua
    import qualified Text.Pandoc.UTF8 as UTF8

    -- | Get value behind key from table at given index.
    rawField :: Peekable a => StackIndex -> String -> Lua a
    rawField idx key = do
      absidx <- Lua.absindex idx
      Lua.push key
      Lua.rawget absidx
      Lua.popValue

    -- | Add a value to the table at the top of the stack at a string-index.
    addField :: Pushable a => String -> a -> Lua ()
    addField = addValue

    -- | Add a key-value pair to the table at the top of the stack.
    addValue :: (Pushable a, Pushable b) => a -> b -> Lua ()
    addValue key value = do
      Lua.push key
      Lua.push value
      Lua.rawset (Lua.nthFromTop 3)

    -- | Add a function to the table at the top of the stack, using the given name.
    addFunction :: ToHaskellFunction a => String -> a -> Lua ()
    addFunction name fn = do
      Lua.push name
      Lua.pushHaskellFunction fn
      Lua.rawset (-3)

    -- | Helper class for pushing a single value to the stack via a lua function.
    -- See @pushViaCall@.
    class PushViaCall a where
      pushViaCall' :: String -> Lua () -> NumArgs -> a

    instance PushViaCall (Lua ()) where
      pushViaCall' fn pushArgs num = do
        Lua.push fn
        Lua.rawget Lua.registryindex
        pushArgs
        Lua.call num 1

    instance (Pushable a, PushViaCall b) => PushViaCall (a -> b) where
      pushViaCall' fn pushArgs num x =
        pushViaCall' fn (pushArgs *> Lua.push x) (num + 1)

    -- | Push an value to the stack via a lua function. The lua function is called
    -- with all arguments that are passed to this function and is expected to return
    -- a single value.
    pushViaCall :: PushViaCall a => String -> a
    pushViaCall fn = pushViaCall' fn (return ()) 0

    -- | Call a pandoc element constructor within lua, passing all given arguments.
    pushViaConstructor :: PushViaCall a => String -> a
    pushViaConstructor pandocFn = pushViaCall ("pandoc." ++ pandocFn)

    -- | Load a file from pandoc's data directory.
    loadScriptFromDataDir :: Maybe FilePath -> FilePath -> Lua ()
    loadScriptFromDataDir datadir scriptFile = do
      script <- Lua.liftIO . runIOorExplode $
                setUserDataDir datadir >> readDataFile scriptFile
      status <- Lua.dostring script
      when (status /= Lua.OK) $
        throwTopMessageAsError' (("Couldn't load '" ++ scriptFile ++ "'.\n") ++)

    -- | Get the tag of a value. This is an optimized and specialized version of
    -- @Lua.getfield idx "tag"@. It only checks for the field on the table at index
    -- @idx@ and on its metatable, also ignoring any @__index@ value on the
    -- metatable.
    getTag :: StackIndex -> Lua String
    getTag idx = do
      -- push metatable or just the table
      Lua.getmetatable idx >>= \hasMT -> unless hasMT (Lua.pushvalue idx)
      Lua.push "tag"
      Lua.rawget (Lua.nthFromTop 2)
      Lua.tostring Lua.stackTop <* Lua.pop 2 >>= \case
        Nothing -> Lua.throwException "untagged value"
        Just x -> return (UTF8.toString x)

    -- | Modify the message at the top of the stack before throwing it as an
    -- Exception.
    throwTopMessageAsError' :: (String -> String) -> Lua a
    throwTopMessageAsError' modifier = do
      msg <- Lua.tostring' Lua.stackTop
      Lua.pop 2 -- remove error and error string pushed by tostring'
      Lua.throwException (modifier (UTF8.toString msg))

    -- | Mark the context of a Lua computation for better error reporting.
    defineHowTo :: String -> Lua a -> Lua a
    defineHowTo ctx = Lua.withExceptionMessage (("Could not " <> ctx <> ": ") <>)

    -- | Like @'Lua.pcall'@, but uses a predefined error handler which adds a
    -- traceback on error.
    pcallWithTraceback :: NumArgs -> NumResults -> Lua Status
    pcallWithTraceback nargs nresults = do
      let traceback' :: Lua NumResults
          traceback' = do
            l <- Lua.state
            msg <- Lua.tostring' (Lua.nthFromBottom 1)
            Lua.traceback l (Just (UTF8.toString msg)) 2
            return 1
      tracebackIdx <- Lua.absindex (Lua.nthFromTop (Lua.fromNumArgs nargs + 1))
      Lua.pushHaskellFunction traceback'
      Lua.insert tracebackIdx
      result <- Lua.pcall nargs nresults (Just tracebackIdx)
      Lua.remove tracebackIdx
      return result

    -- | Like @'Lua.call'@, but adds a traceback to the error message (if any).
    callWithTraceback :: NumArgs -> NumResults -> Lua ()
    callWithTraceback nargs nresults = do
      result <- pcallWithTraceback nargs nresults
      when (result /= Lua.OK) Lua.throwTopMessage

    -- | Run the given string as a Lua program, while also adding a traceback to the
    -- error message if an error occurs.
    dofileWithTraceback :: FilePath -> Lua Status
    dofileWithTraceback fp = do
      loadRes <- Lua.loadfile fp
      case loadRes of
        Lua.OK -> pcallWithTraceback 0 Lua.multret
        _ -> return loadRes