{-|
Module      : Lua.LPeg
Copyright   : © 2021-2023 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb@hslua.org>

Haskell bindings to the LPeg Lua package.
-}
module Lua.LPeg
  ( luaopen_lpeg_ptr
  , luaopen_re_ptr
  , lpeg_searcher
  ) where

import Foreign.C (peekCStringLen)
import Foreign.Ptr (nullPtr)
import Foreign.Storable (peek)
import Foreign.Marshal (alloca)
import Lua

-- | Pointer to the function which loads the lpeg library.
foreign import ccall unsafe "lptree.c &luaopen_lpeg"
  luaopen_lpeg_ptr :: CFunction

-- | Pointer to the function which loads the "re" library.
foreign import ccall unsafe "&luaopen_re"
  luaopen_re_ptr :: CFunction

-- | A package searcher to be used with @package.searchers@), just for
-- the "lpeg" module. Returns @nil@ on most inputs, but pushes a
-- function that loads the LPeg module when called with key @"lpeg"@.
lpeg_searcher :: PreCFunction
lpeg_searcher :: PreCFunction
lpeg_searcher State
l = NumResults
1 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
  forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CSize
lenPtr -> do
    Ptr CChar
cstr <- State -> StackIndex -> Ptr CSize -> IO (Ptr CChar)
lua_tolstring State
l StackIndex
1 Ptr CSize
lenPtr
    if Ptr CChar
cstr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
      then State -> IO ()
lua_pushnil State
l
      else do
        CSize
cstrLen <- forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
lenPtr
        String
pkg <- CStringLen -> IO String
peekCStringLen (Ptr CChar
cstr, forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
cstrLen)
        case String
pkg of
          String
"lpeg" -> State -> CFunction -> IO ()
lua_pushcfunction State
l CFunction
luaopen_lpeg_ptr
          String
"re"   -> State -> CFunction -> IO ()
lua_pushcfunction State
l CFunction
luaopen_re_ptr
          String
_      -> State -> IO ()
lua_pushnil State
l