{-# LANGUAGE OverloadedStrings #-}

-- | Get Lua stack traces
module Oughta.Traceback
  ( Traceback
  , getTraceback
  , printTraceback
  ) where

import Data.Int (Int64)
import Data.Text (Text)
import Oughta.Extract (SourceMap)
import Oughta.Extract qualified as OE
import HsLua qualified as Lua
import qualified Data.Text as Text

-- | Data about a single stack frame
data Frame
  = Frame
    { -- | Source line number (NOT Lua line number)
      Frame -> Int
_frameLine :: {-# UNPACK #-} !Int
    , Frame -> Text
_frameName :: !Text
    , Frame -> Text
frameSource :: !Text
    }

printFrame :: Frame -> Text
printFrame :: Frame -> Text
printFrame (Frame Int
line Text
name Text
src) =
  Text
src Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
line) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name

-- | The stack trace from the Lua interpreter.
--
-- Excludes C internals.
newtype Traceback = Traceback { Traceback -> [Frame]
_getTraceback :: [Frame] }

getFrame ::
  Lua.LuaError e =>
  SourceMap ->
  -- | Lua stack level
  Int64 ->
  Lua.LuaE e (Maybe Frame)
getFrame :: forall e. LuaError e => SourceMap -> Int64 -> LuaE e (Maybe Frame)
getFrame SourceMap
sm Int64
level = do
  Name -> LuaE e ()
forall e. LuaError e => Name -> LuaE e ()
Lua.getglobal' Name
"debug.getinfo"
  Integer -> LuaE e ()
forall e. Integer -> LuaE e ()
Lua.pushinteger (Int64 -> Integer
Lua.Integer Int64
level)
  ByteString -> LuaE e ()
forall e. ByteString -> LuaE e ()
Lua.pushstring ByteString
"lnS"
  NumArgs -> NumResults -> LuaE e ()
forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
Lua.call NumArgs
2 NumResults
1

  Bool
nil <- StackIndex -> LuaE e Bool
forall e. StackIndex -> LuaE e Bool
Lua.isnil StackIndex
Lua.top
  if Bool
nil
  then do
    Int -> LuaE e ()
forall e. Int -> LuaE e ()
Lua.pop Int
1
    Maybe Frame -> LuaE e (Maybe Frame)
forall a. a -> LuaE e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Frame
forall a. Maybe a
Nothing
  else do
    Type
_ty <- StackIndex -> Name -> LuaE e Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
Lua.getfield StackIndex
Lua.top Name
"what"
    Text
what <- forall a e. (LuaError e, Peekable a) => StackIndex -> LuaE e a
Lua.peek @Text StackIndex
Lua.top
    Int -> LuaE e ()
forall e. Int -> LuaE e ()
Lua.pop Int
1

    Type
ty <- StackIndex -> Name -> LuaE e Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
Lua.getfield StackIndex
Lua.top Name
"name"
    Text
name <-
      case Type
ty of
        Type
Lua.TypeString -> do
          Text
name <- forall a e. (LuaError e, Peekable a) => StackIndex -> LuaE e a
Lua.peek @Text StackIndex
Lua.top
          Text -> LuaE e Text
forall a. a -> LuaE e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
name
        Type
_ -> Text -> LuaE e Text
forall a. a -> LuaE e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"<main>"
    Int -> LuaE e ()
forall e. Int -> LuaE e ()
Lua.pop Int
1

    Type
_ty <- StackIndex -> Name -> LuaE e Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
Lua.getfield StackIndex
Lua.top Name
"short_src"
    Text
src0 <- forall a e. (LuaError e, Peekable a) => StackIndex -> LuaE e a
Lua.peek @Text StackIndex
Lua.top
    Int -> LuaE e ()
forall e. Int -> LuaE e ()
Lua.pop Int
1

    let src :: Text
src = Int -> Text -> Text
Text.drop (Text -> Int
Text.length Text
"[string \"") (Int -> Text -> Text
Text.dropEnd (Text -> Int
Text.length Text
"\"]") Text
src0)
    let src' :: Text
src' =
          if Text
what Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"C"
          then Text
"C"
          else Text
src

    Type
_ty <- StackIndex -> Name -> LuaE e Type
forall e. LuaError e => StackIndex -> Name -> LuaE e Type
Lua.getfield StackIndex
Lua.top Name
"currentline"
    Int
l0 <- forall a e. (LuaError e, Peekable a) => StackIndex -> LuaE e a
Lua.peek @Int StackIndex
Lua.top
    Int -> LuaE e ()
forall e. Int -> LuaE e ()
Lua.pop Int
1
    let l :: Int
l = Text -> Int -> SourceMap -> Int
OE.lookupSourceMap Text
src' Int
l0 SourceMap
sm

    Maybe Frame -> LuaE e (Maybe Frame)
forall a. a -> LuaE e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Frame -> Maybe Frame
forall a. a -> Maybe a
Just (Int -> Text -> Text -> Frame
Frame Int
l Text
name Text
src'))

-- | Get a Lua stack trace.
getTraceback ::
  Lua.LuaError e =>
  SourceMap ->
  Lua.LuaE e Traceback
getTraceback :: forall e. LuaError e => SourceMap -> LuaE e Traceback
getTraceback SourceMap
sm =
  [Frame] -> Traceback
Traceback ([Frame] -> Traceback)
-> ([Frame] -> [Frame]) -> [Frame] -> Traceback
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Frame -> Bool) -> [Frame] -> [Frame]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== SourceMap -> Text
OE.sourceMapFile SourceMap
sm) (Text -> Bool) -> (Frame -> Text) -> Frame -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Frame -> Text
frameSource) ([Frame] -> [Frame]) -> ([Frame] -> [Frame]) -> [Frame] -> [Frame]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Frame] -> [Frame]
forall a. [a] -> [a]
reverse ([Frame] -> Traceback) -> LuaE e [Frame] -> LuaE e Traceback
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> [Frame] -> LuaE e [Frame]
forall {e}. LuaError e => Int64 -> [Frame] -> LuaE e [Frame]
go Int64
3 []
  where
    go :: Int64 -> [Frame] -> LuaE e [Frame]
go Int64
level [Frame]
frames = do
      Maybe Frame
mf <- SourceMap -> Int64 -> LuaE e (Maybe Frame)
forall e. LuaError e => SourceMap -> Int64 -> LuaE e (Maybe Frame)
getFrame SourceMap
sm Int64
level
      case Maybe Frame
mf of
        Maybe Frame
Nothing -> [Frame] -> LuaE e [Frame]
forall a. a -> LuaE e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Frame]
frames
        Just Frame
f -> Int64 -> [Frame] -> LuaE e [Frame]
go (Int64
level Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1) (Frame
f Frame -> [Frame] -> [Frame]
forall a. a -> [a] -> [a]
: [Frame]
frames)

printTraceback :: Traceback -> Text
printTraceback :: Traceback -> Text
printTraceback (Traceback [Frame]
tb) =
  [Text] -> Text
Text.unlines (Text
"stack trace:" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Frame -> Text) -> [Frame] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text
"  " <>) (Text -> Text) -> (Frame -> Text) -> Frame -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Frame -> Text
printFrame) [Frame]
tb)