{-
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'
  ) where

import Prelude
import Control.Monad (unless, when)
import Foreign.Lua ( Lua, NumArgs, Peekable, Pushable, StackIndex
                   , 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))


defineHowTo :: String -> Lua a -> Lua a
defineHowTo ctx = Lua.withExceptionMessage (("Could not " <> ctx <> ": ") <>)