{-# LANGUAGE FlexibleInstances        #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MultiParamTypeClasses    #-}
{-# LANGUAGE OverloadedStrings        #-}
{-# LANGUAGE ScopedTypeVariables      #-}
{-# LANGUAGE TypeApplications         #-}
module HsLua.ObjectOrientation.ListType
  ( UDTypeWithList
  , ListSpec
  , listExtension
  ) where

import Control.Monad ((<$!>), forM_, void)
import Foreign.Ptr (FunPtr)
import HsLua.Core as Lua
import HsLua.Marshalling
import HsLua.ObjectOrientation.Generic
import HsLua.ObjectOrientation.Operation (metamethodName)

-- | Userdata type that (also) behaves like a list.
type UDTypeWithList e fn a itemtype =
  UDTypeGeneric e fn a
{-# DEPRECATED UDTypeWithList "Use UDTypeGeneric instead" #-}

-- | Pair of pairs, describing how a type can be used as a Lua list. The
-- first pair describes how to push the list items, and how the list is
-- extracted from the type; the second pair contains a method to
-- retrieve list items, and defines how the list is used to create an
-- updated value.
type ListSpec e a itemtype =
  ( (Pusher e itemtype, a -> [itemtype])
  , (Peeker e itemtype, a -> [itemtype] -> a)
  )

listExtension
  :: LuaError e
  => ListSpec e a itemtype
  -> UDTypeHooks e fn a
listExtension ((pushItem, toList), (peekItem, updateList)) =
  UDTypeHooks
  { hookMetatableSetup = do
      -- Add a function to evaluate the necessary parts of a lazy list.
      pushName "lazylisteval"
      pushHaskellFunction (lazylisteval pushItem)
      rawset (nth 3)
      -- Use different field getter
      pushName (metamethodName Index)
      pushcfunction hslua_list_udindex_ptr
      rawset (nth 3)
      -- Use different field setter
      pushName (metamethodName Newindex)
      pushcfunction hslua_list_udnewindex_ptr
      rawset (nth 3)

  , hookPeekUD = \x idx ->
    (`lastly` pop 1) $ liftLua (getiuservalue idx 1) >>= \case
      TypeTable -> setList peekItem updateList x
      _other    -> pure x

  , hookPushUD = \x -> do
      -- Add a field containing the thunk with the unevaluated part of
      -- the lazy list.
      newtable
      pushName "__lazylist"
      newhsuserdatauv (toList x) 1
      void (newudmetatable lazyListStateName)
      setmetatable (nth 2)
      rawset (nth 3)
      void (setiuservalue (nth 2) 1)

  , hookUservalues = 1
  }


-- | Evaluate part of a lazy list. Takes the following arguments, in
-- this order:
--
-- 1. userdata wrapping the unevalled part of the lazy list
-- 2. index of the last evaluated element
-- 3. index of the requested element
-- 4. the caching table
lazylisteval :: forall itemtype e. LuaError e
             => Pusher e itemtype -> LuaE e NumResults
lazylisteval pushItem = do
  munevaled <- fromuserdata @[itemtype] (nthBottom 1) lazyListStateName
  mcurindex <- tointeger (nthBottom 2)
  mnewindex <- tointeger (nthBottom 3)
  case (munevaled, mcurindex, mnewindex) of
    (Just unevaled, Just curindex, Just newindex) -> do
      let numElems = fromIntegral $ max (newindex - curindex) 0
          (as, rest) = splitAt numElems unevaled
      if null rest
        then do
          -- no more elements in list; unset variable
          pushName "__lazylistindex"
          pushBool False
          rawset (nthBottom 4)
        else do
          -- put back remaining unevalled list
          void $ putuserdata @[itemtype] (nthBottom 1) lazyListStateName rest
          pushName "__lazylistindex"
          pushinteger (curindex + fromIntegral (length as))
          rawset (nthBottom 4)
      -- push evaluated elements
      forM_ (zip [(curindex + 1)..] as) $ \(i, a) -> do
        pushItem a
        rawseti (nthBottom 4) i
      return (NumResults 0)
    _ -> pure (NumResults 0)

-- | Name of the metatable used for unevaluated lazy list rema
lazyListStateName :: Name
lazyListStateName = "HsLua unevalled lazy list"

-- | Gets a list from a uservalue table and sets it on the given value.
-- Expects the uservalue (i.e., caching) table to be at the top of the
-- stack.
setList :: forall itemtype a e. LuaError e
        => Peeker e itemtype
        -> (a -> [itemtype] -> a)
        -> a
        -> Peek e a
setList peekItem updateList x = (x `updateList`) <$!> do
  liftLua (getfield top "__lazylistindex") >>= \case
    TypeBoolean -> do
      -- list had been fully evaluated
      liftLua $ pop 1
      peekList peekItem top
    _ -> do
      let getLazyList = do
            liftLua (getfield top "__lazylist") >>= \case
              TypeUserdata -> pure ()
              otherType -> do
                tyname <- liftLua $ typename otherType
                failPeek $
                  "unevaled items of lazy list cannot be peeked: got " <>
                  tyname
            (`lastly` pop 1) $ reportValueOnFailure
              lazyListStateName
              (\idx -> fromuserdata @[itemtype] idx lazyListStateName)
              top
      mlastIndex <- liftLua (tointeger top <* pop 1)
      let itemsAfter = case mlastIndex of
            Nothing -> const getLazyList
            Just lastIndex -> \i ->
              if i <= lastIndex
              then liftLua (rawgeti top i) >>= \case
                TypeNil -> [] <$ liftLua (pop 1)
                _ -> do
                  y <- peekItem top `lastly` pop 1
                  (y:) <$!> itemsAfter (i + 1)
              else getLazyList
      itemsAfter 1


-- | Gets a new value in the userdata caching table via a getter
-- functions; this function differs from the normal getter in that it
-- treats numerical values as list indices.
foreign import ccall "hslobj.c &hslua_list_udindex"
  hslua_list_udindex_ptr :: FunPtr (State -> IO NumResults)

-- | Sets a new value in the userdata caching table via a setter
-- functions; this function differs from the normal setter in that it
-- treats numerical values as list indices.
foreign import ccall "hslobj.c &hslua_list_udnewindex"
  hslua_list_udnewindex_ptr :: FunPtr (State -> IO NumResults)
