    {-# 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 :: forall e a itemtype fn.
    LuaError e =>
    ListSpec e a itemtype -> UDTypeHooks e fn a
    listExtension ((Pusher e itemtype
    pushItem, a -> [itemtype]
    toList), (Peeker e itemtype
    peekItem, a -> [itemtype] -> a
    updateList)) =
      UDTypeHooks
      { hookMetatableSetup :: LuaE e ()
    hookMetatableSetup = do
          -- Add a function to evaluate the necessary parts of a lazy list.
          Name -> LuaE e ()
    forall e. Name -> LuaE e ()
    pushName Name
    "lazylisteval"
          HaskellFunction e -> LuaE e ()
    forall e. LuaError e => HaskellFunction e -> LuaE e ()
    pushHaskellFunction (Pusher e itemtype -> HaskellFunction e
    forall itemtype e.
    LuaError e =>
    Pusher e itemtype -> LuaE e NumResults
    lazylisteval Pusher e itemtype
    pushItem)
          StackIndex -> LuaE e ()
    forall e. LuaError e => StackIndex -> LuaE e ()
    rawset (CInt -> StackIndex
    nth CInt
    3)
          -- Use different field getter
          Name -> LuaE e ()
    forall e. Name -> LuaE e ()
    pushName (Operation -> Name
    metamethodName Operation
    Index)
          CFunction -> LuaE e ()
    forall e. CFunction -> LuaE e ()
    pushcfunction CFunction
    hslua_list_udindex_ptr
          StackIndex -> LuaE e ()
    forall e. LuaError e => StackIndex -> LuaE e ()
    rawset (CInt -> StackIndex
    nth CInt
    3)
          -- Use different field setter
          Name -> LuaE e ()
    forall e. Name -> LuaE e ()
    pushName (Operation -> Name
    metamethodName Operation
    Newindex)
          CFunction -> LuaE e ()
    forall e. CFunction -> LuaE e ()
    pushcfunction CFunction
    hslua_list_udnewindex_ptr
          StackIndex -> LuaE e ()
    forall e. LuaError e => StackIndex -> LuaE e ()
    rawset (CInt -> StackIndex
    nth CInt
    3)

      , hookPeekUD :: a -> StackIndex -> Peek e a
    hookPeekUD = \a
    x StackIndex
    idx ->
        (Peek e a -> LuaE e () -> Peek e a
    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 a -> Peek e a) -> Peek e a -> Peek e a
    forall a b. (a -> b) -> a -> b
    $ LuaE e Type -> Peek e Type
    forall e a. LuaE e a -> Peek e a
    liftLua (StackIndex -> Int -> LuaE e Type
    forall e. StackIndex -> Int -> LuaE e Type
    getiuservalue StackIndex
    idx Int
    1) Peek e Type -> (Type -> Peek e a) -> Peek e a
    forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
          Type
    TypeTable -> Peeker e itemtype -> (a -> [itemtype] -> a) -> a -> Peek e a
    forall itemtype a e.
    LuaError e =>
    Peeker e itemtype -> (a -> [itemtype] -> a) -> a -> Peek e a
    setList Peeker e itemtype
    peekItem a -> [itemtype] -> a
    updateList a
    x
          Type
    _other    -> a -> Peek e a
    forall a. a -> Peek e a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    x

      , hookPushUD :: a -> LuaE e ()
    hookPushUD = \a
    x -> do
          -- Add a field containing the thunk with the unevaluated part of
          -- the lazy list.
          LuaE e ()
    forall e. LuaE e ()
    newtable
          Name -> LuaE e ()
    forall e. Name -> LuaE e ()
    pushName Name
    "__lazylist"
          [itemtype] -> Int -> LuaE e ()
    forall a e. a -> Int -> LuaE e ()
    newhsuserdatauv (a -> [itemtype]
    toList a
    x) Int
    1
          LuaE e Bool -> LuaE e ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (Name -> LuaE e Bool
    forall e. Name -> LuaE e Bool
    newudmetatable Name
    lazyListStateName)
          StackIndex -> LuaE e ()
    forall e. StackIndex -> LuaE e ()
    setmetatable (CInt -> StackIndex
    nth CInt
    2)
          StackIndex -> LuaE e ()
    forall e. LuaError e => StackIndex -> LuaE e ()
    rawset (CInt -> StackIndex
    nth CInt
    3)
          LuaE e Bool -> LuaE e ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (StackIndex -> Int -> LuaE e Bool
    forall e. StackIndex -> Int -> LuaE e Bool
    setiuservalue (CInt -> StackIndex
    nth CInt
    2) Int
    1)

      , hookUservalues :: Int
    hookUservalues = Int
    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 :: forall itemtype e.
    LuaError e =>
    Pusher e itemtype -> LuaE e NumResults
    lazylisteval Pusher e itemtype
    pushItem = do
      munevaled <- forall a e. StackIndex -> Name -> LuaE e (Maybe a)
    fromuserdata @[itemtype] (CInt -> StackIndex
    nthBottom CInt
    1) Name
    lazyListStateName
      mcurindex <- tointeger (nthBottom 2)
      mnewindex <- tointeger (nthBottom 3)
      case (munevaled, mcurindex, mnewindex) of
        (Just [itemtype]
    unevaled, Just Integer
    curindex, Just Integer
    newindex) -> do
          let numElems :: Int
    numElems = Integer -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> Int) -> Integer -> Int
    forall a b. (a -> b) -> a -> b
    $ Integer -> Integer -> Integer
    forall a. Ord a => a -> a -> a
    max (Integer
    newindex Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    curindex) Integer
    0
              ([itemtype]
    as, [itemtype]
    rest) = Int -> [itemtype] -> ([itemtype], [itemtype])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    numElems [itemtype]
    unevaled
          if [itemtype] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [itemtype]
    rest
            then do
              -- no more elements in list; unset variable
              Name -> LuaE e ()
    forall e. Name -> LuaE e ()
    pushName Name
    "__lazylistindex"
              Pusher e Bool
    forall e. Pusher e Bool
    pushBool Bool
    False
              StackIndex -> LuaE e ()
    forall e. LuaError e => StackIndex -> LuaE e ()
    rawset (CInt -> StackIndex
    nthBottom CInt
    4)
            else do
              -- put back remaining unevalled list
              LuaE e Bool -> LuaE e ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (LuaE e Bool -> LuaE e ()) -> LuaE e Bool -> LuaE e ()
    forall a b. (a -> b) -> a -> b
    $ forall a e. StackIndex -> Name -> a -> LuaE e Bool
    putuserdata @[itemtype] (CInt -> StackIndex
    nthBottom CInt
    1) Name
    lazyListStateName [itemtype]
    rest
              Name -> LuaE e ()
    forall e. Name -> LuaE e ()
    pushName Name
    "__lazylistindex"
              Integer -> LuaE e ()
    forall e. Integer -> LuaE e ()
    pushinteger (Integer
    curindex Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ([itemtype] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [itemtype]
    as))
              StackIndex -> LuaE e ()
    forall e. LuaError e => StackIndex -> LuaE e ()
    rawset (CInt -> StackIndex
    nthBottom CInt
    4)
          -- push evaluated elements
          [(Integer, itemtype)]
    -> ((Integer, itemtype) -> LuaE e ()) -> LuaE e ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ ([Integer] -> [itemtype] -> [(Integer, itemtype)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [(Integer
    curindex Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    1)..] [itemtype]
    as) (((Integer, itemtype) -> LuaE e ()) -> LuaE e ())
    -> ((Integer, itemtype) -> LuaE e ()) -> LuaE e ()
    forall a b. (a -> b) -> a -> b
    $ \(Integer
    i, itemtype
    a) -> do
            Pusher e itemtype
    pushItem itemtype
    a
            StackIndex -> Integer -> LuaE e ()
    forall e. LuaError e => StackIndex -> Integer -> LuaE e ()
    rawseti (CInt -> StackIndex
    nthBottom CInt
    4) Integer
    i
          NumResults -> LuaE e NumResults
    forall a. a -> LuaE e a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CInt -> NumResults
    NumResults CInt
    0)
        (Maybe [itemtype], Maybe Integer, Maybe Integer)
    _ -> NumResults -> LuaE e NumResults
    forall a. a -> LuaE e a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (CInt -> NumResults
    NumResults CInt
    0)

    -- | Name of the metatable used for unevaluated lazy list rema
    lazyListStateName :: Name
    lazyListStateName :: Name
    lazyListStateName = Name
    "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 :: forall itemtype a e.
    LuaError e =>
    Peeker e itemtype -> (a -> [itemtype] -> a) -> a -> Peek e a
    setList Peeker e itemtype
    peekItem a -> [itemtype] -> a
    updateList a
    x = (a
    x a -> [itemtype] -> a
    `updateList`) ([itemtype] -> a) -> Peek e [itemtype] -> Peek e a
    forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
    <$!> do
      LuaE e Type -> Peek e Type
    forall e a. LuaE e a -> Peek e a
    liftLua (StackIndex -> Name -> LuaE e Type
    forall e. LuaError e => StackIndex -> Name -> LuaE e Type
    getfield StackIndex
    top Name
    "__lazylistindex") Peek e Type -> (Type -> Peek e [itemtype]) -> Peek e [itemtype]
    forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        Type
    TypeBoolean -> do
          -- list had been fully evaluated
          LuaE e () -> Peek e ()
    forall e a. LuaE e a -> Peek e a
    liftLua (LuaE e () -> Peek e ()) -> LuaE e () -> Peek e ()
    forall a b. (a -> b) -> a -> b
    $ Int -> LuaE e ()
    forall e. Int -> LuaE e ()
    pop Int
    1
          Peeker e itemtype -> Peeker e [itemtype]
    forall a e. LuaError e => Peeker e a -> Peeker e [a]
    peekList Peeker e itemtype
    peekItem StackIndex
    top
        Type
    _ -> do
          let getLazyList :: Peek e [itemtype]
    getLazyList = do
                LuaE e Type -> Peek e Type
    forall e a. LuaE e a -> Peek e a
    liftLua (StackIndex -> Name -> LuaE e Type
    forall e. LuaError e => StackIndex -> Name -> LuaE e Type
    getfield StackIndex
    top Name
    "__lazylist") Peek e Type -> (Type -> Peek e ()) -> Peek e ()
    forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
                  Type
    TypeUserdata -> () -> Peek e ()
    forall a. a -> Peek e a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                  Type
    otherType -> do
                    tyname <- LuaE e ByteString -> Peek e ByteString
    forall e a. LuaE e a -> Peek e a
    liftLua (LuaE e ByteString -> Peek e ByteString)
    -> LuaE e ByteString -> Peek e ByteString
    forall a b. (a -> b) -> a -> b
    $ Type -> LuaE e ByteString
    forall e. Type -> LuaE e ByteString
    typename Type
    otherType
                    failPeek $
                      "unevaled items of lazy list cannot be peeked: got " <>
                      tyname
                (Peek e [itemtype] -> LuaE e () -> Peek e [itemtype]
    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 [itemtype] -> Peek e [itemtype])
    -> Peek e [itemtype] -> Peek e [itemtype]
    forall a b. (a -> b) -> a -> b
    $ Name
    -> (StackIndex -> LuaE e (Maybe [itemtype])) -> Peeker e [itemtype]
    forall e a. Name -> (StackIndex -> LuaE e (Maybe a)) -> Peeker e a
    reportValueOnFailure
                  Name
    lazyListStateName
                  (\StackIndex
    idx -> forall a e. StackIndex -> Name -> LuaE e (Maybe a)
    fromuserdata @[itemtype] StackIndex
    idx Name
    lazyListStateName)
                  StackIndex
    top
          mlastIndex <- LuaE e (Maybe Integer) -> Peek e (Maybe Integer)
    forall e a. LuaE e a -> Peek e a
    liftLua (StackIndex -> LuaE e (Maybe Integer)
    forall e. StackIndex -> LuaE e (Maybe Integer)
    tointeger StackIndex
    top LuaE e (Maybe Integer) -> LuaE e () -> LuaE e (Maybe Integer)
    forall a b. LuaE e a -> LuaE e b -> LuaE e a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Int -> LuaE e ()
    forall e. Int -> LuaE e ()
    pop Int
    1)
          let itemsAfter = case Maybe Integer
    mlastIndex of
                Maybe Integer
    Nothing -> Peek e [itemtype] -> Integer -> Peek e [itemtype]
    forall a b. a -> b -> a
    const Peek e [itemtype]
    getLazyList
                Just Integer
    lastIndex -> \Integer
    i ->
                  if Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    lastIndex
                  then 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
    top Integer
    i) Peek e Type -> (Type -> Peek e [itemtype]) -> Peek e [itemtype]
    forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
                    Type
    TypeNil -> [] [itemtype] -> Peek e () -> Peek e [itemtype]
    forall a b. a -> Peek e b -> Peek e a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ LuaE e () -> Peek e ()
    forall e a. LuaE e a -> Peek e a
    liftLua (Int -> LuaE e ()
    forall e. Int -> LuaE e ()
    pop Int
    1)
                    Type
    _ -> do
                      y <- Peeker e itemtype
    peekItem StackIndex
    top Peek e itemtype -> LuaE e () -> Peek e itemtype
    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
                      (y:) <$!> itemsAfter (i + 1)
                  else Peek e [itemtype]
    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)