LuaApi.hs

{-# LANGUAGE OverloadedStrings #-}

-- | The Oughta Lua API
module Oughta.LuaApi
  ( check
  ) where

import Control.Exception qualified as X
import Control.Monad.IO.Class (liftIO)
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.IORef (IORef)
import Data.IORef qualified as IORef
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Oughta.Exception (Exception)
import Oughta.Exception qualified as OE
import Oughta.Extract (LuaProgram, SourceMap, lookupSourceMap, programText, sourceMap, sourceMapFile)
import Oughta.Hooks qualified as OH
import Oughta.Lua qualified as OL
import Oughta.Pos qualified as OP
import Oughta.Result (Progress, Result)
import Oughta.Result qualified as OR
import Oughta.Traceback qualified as OT
import HsLua qualified as Lua

-- | Name of the @text@ global variable. Not exported.
text :: Lua.Name
text = Lua.Name "text"

-- | Set the @text@ global. Not exported.
setText :: ByteString -> Lua.LuaE Exception ()
setText txt = do
  Lua.pushstring txt
  Lua.setglobal text

-- | Helper, not exported.
withProgress :: IORef Progress -> (Progress -> Lua.LuaE Exception Progress) -> Lua.LuaE Exception ()
withProgress stateRef f = do
  p <- liftIO (IORef.readIORef stateRef)
  p' <- f p
  setText (OR.progressRemainder p')
  liftIO (IORef.writeIORef stateRef p')
  pure ()

-- | Implementation of @col@. Not exported.
col :: IORef Progress -> Lua.LuaE Exception Int
col stateRef = do
  p <- liftIO (IORef.readIORef stateRef)
  pure (OP.col (OP.pos (OR.progressLoc p)))

-- | Implementation of @fail@. Not exported.
fail_ :: SourceMap -> IORef Progress -> Lua.LuaE Exception ()
fail_ sm stateRef =
  withProgress stateRef $ \p -> do
    tb <- OT.getTraceback sm
    OE.throwNoMatch (OR.Failure p tb)

-- | Implementation of @file@. Not exported.
file :: SourceMap -> Lua.LuaE Exception Text
file sm = pure (sourceMapFile sm)

-- | Implementation of @line@. Not exported.
line :: IORef Progress -> Lua.LuaE Exception Int
line stateRef = do
  p <- liftIO (IORef.readIORef stateRef)
  pure (OP.line (OP.pos (OR.progressLoc p)))

-- | Implementation of @match@. Not exported.
match :: SourceMap -> IORef Progress -> Int -> Lua.LuaE Exception ()
match sm stateRef n =
  withProgress stateRef $ \p -> do
    tb <- OT.getTraceback sm
    let txt = OR.progressRemainder p
    let (matched, remainder) = BS.splitAt n txt
    let loc = OR.progressLoc p
    let start = OP.pos loc
    let end = OP.incPos (OP.pos loc) (Text.decodeUtf8Lenient matched)
    let m =
          OR.Match
          { OR.matchRemainder = remainder
          , OR.matchSpan = OP.Span (OP.path loc) start end
          , OR.matchText = matched
          , OR.matchTraceback = tb
          }
    pure (OR.updateProgress m p)

-- | Implementation of @reset@. Not exported.
reset :: IORef Progress -> String -> ByteString -> Lua.LuaE Exception ()
reset stateRef name txt = do
  setText txt
  let p0 = OR.newProgress name txt
  liftIO (IORef.writeIORef stateRef p0)

-- | Implementation of @seek@. Not exported.
seek :: IORef Progress -> Int -> Lua.LuaE Exception ()
seek stateRef chars =
  withProgress stateRef $ \p -> do
    let loc = OR.progressLoc p
    let txt = OR.progressRemainder p
    let (before, after) = BS.splitAt chars txt
    let pos' = OP.incPos (OP.pos loc) (Text.decodeUtf8Lenient before)
    let p' =
          p
          { OR.progressLoc = loc { OP.pos = pos' }
          , OR.progressRemainder = after
          }
    pure p'

-- | Implementation of @src_line@. Not exported.
srcLine :: SourceMap -> Int -> Lua.LuaE Exception Int
srcLine sm level = do
  Lua.getglobal' "debug.getinfo"
  -- Empirically, there are 3 levels of functions on the Lua stack between this
  -- function and user Lua code.
  Lua.pushinteger (Lua.Integer (fromIntegral level + 3))
  Lua.pushstring "lnS"
  Lua.call 2 1

  _ty <- Lua.getfield Lua.top "currentline"
  l0 <- Lua.peek @Int Lua.top
  Lua.pop 1

  _ty <- Lua.getfield Lua.top "short_src"
  src0 <- Lua.peek @Text Lua.top
  Lua.pop 1
  let src = Text.drop (Text.length "[string \"") (Text.dropEnd (Text.length "\"]") src0)

  pure (lookupSourceMap src l0 sm)

-- | Load user and Oughta Lua code. Helper, not exported.
luaSetup ::
  OH.Hooks ->
  IORef Progress ->
  -- | User code
  LuaProgram ->
  -- | Initial content of @text@ global
  ByteString ->
  Lua.LuaE Exception ()
luaSetup hooks stateRef prog txt = do
  Lua.openlibs
  setText txt

  let sm = sourceMap prog

  Lua.pushHaskellFunction (Lua.toHaskellFunction (col stateRef))
  Lua.setglobal (Lua.Name "col_no")

  Lua.pushHaskellFunction (Lua.toHaskellFunction (fail_ sm stateRef))
  Lua.setglobal (Lua.Name "fail")

  Lua.pushHaskellFunction (Lua.toHaskellFunction (file sm))
  Lua.setglobal (Lua.Name "file")

  Lua.pushHaskellFunction (Lua.toHaskellFunction (line stateRef))
  Lua.setglobal (Lua.Name "line")

  Lua.pushHaskellFunction (Lua.toHaskellFunction (match sm stateRef))
  Lua.setglobal (Lua.Name "match")

  Lua.pushHaskellFunction (Lua.toHaskellFunction (reset stateRef))
  Lua.setglobal (Lua.Name "reset")

  Lua.pushHaskellFunction (Lua.toHaskellFunction (seek stateRef))
  Lua.setglobal (Lua.Name "seek")

  Lua.pushHaskellFunction (Lua.toHaskellFunction (srcLine sm))
  Lua.setglobal (Lua.Name "src_line")

  _ <- Lua.loadbuffer OL.luaCode (Lua.Name "oughta.lua")
  Lua.call 0 0

  Lua.changeErrorType (OH.preHook hooks)

  let nm = Lua.Name (Text.encodeUtf8 (sourceMapFile sm))
  _ <- Lua.loadbuffer (Text.encodeUtf8 (programText prog)) nm
  Lua.call 0 0

  Lua.changeErrorType (OH.postHook hooks)

-- | Check some text against a Lua program using the API.
check ::
  OH.Hooks ->
  LuaProgram ->
  -- | Text to check
  ByteString ->
  IO Result
check hooks prog txt = do
  let p0 = OR.newProgress "<out>" txt
  stateRef <- IORef.newIORef p0
  result <- Lua.run (Lua.try (luaSetup hooks stateRef prog txt))
  case result of
    Left (OE.LuaException e) -> X.throwIO e
    Left (OE.Failure noMatch) ->
      OR.Result . Left <$> OE.noMatch noMatch
    Right () -> do
      state <- IORef.readIORef stateRef
      pure (OR.Result (Right (OR.progressToSuccess state)))