{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
module Language.R.Debug
( inspect )
where
import Control.Memory.Region (V)
import qualified Data.Vector.SEXP as Vector
import qualified Foreign.R as R
import Foreign.R (SEXP, SomeSEXP(..), SEXPTYPE, SEXPInfo)
import Foreign.R.Type (IsVector)
import Foreign.Storable
import Language.R.Globals as H
import Language.R.HExp
import Data.Complex
import System.IO.Unsafe ( unsafePerformIO )
import Data.Aeson as A
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Data.ByteString.Lazy.Char8 as LBS
instance ToJSON SEXPTYPE where
toJSON :: SEXPTYPE -> Value
toJSON = Text -> Value
A.String (Text -> Value) -> (SEXPTYPE -> Text) -> SEXPTYPE -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (SEXPTYPE -> String) -> SEXPTYPE -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SEXPTYPE -> String
forall a. Show a => a -> String
show
instance ToJSON SEXPInfo where
toJSON :: SEXPInfo -> Value
toJSON x :: SEXPInfo
x =
[Pair] -> Value
object
[ "type" Text -> SEXPTYPE -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXPInfo -> SEXPTYPE
R.infoType SEXPInfo
x
, "obj" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXPInfo -> Bool
R.infoObj SEXPInfo
x
, "named" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXPInfo -> Int
R.infoNamed SEXPInfo
x
, "gp" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXPInfo -> Int
R.infoGp SEXPInfo
x
, "mark" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXPInfo -> Bool
R.infoMark SEXPInfo
x
, "debug" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXPInfo -> Bool
R.infoDebug SEXPInfo
x
, "trace" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXPInfo -> Bool
R.infoTrace SEXPInfo
x
, "spare" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXPInfo -> Bool
R.infoSpare SEXPInfo
x
, "gcgen" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXPInfo -> Int
R.infoGcGen SEXPInfo
x
, "gccls" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXPInfo -> Int
R.infoGcCls SEXPInfo
x
]
instance ToJSON a => ToJSON (Complex a) where
toJSON :: Complex a -> Value
toJSON (x :: a
x :+ y :: a
y) =
[Pair] -> Value
object ["Re" Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
x, "Im" Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
y]
instance ToJSON (SEXP s a) where
toJSON :: SEXP s a -> Value
toJSON x :: SEXP s a
x =
[Pair] -> Value
object
[ "header" Text -> SEXPInfo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXPInfo
info
, "attributes" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= if SEXP s a -> SEXP0
forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
R.unsexp SEXP s a
x SEXP0 -> SEXP0 -> Bool
forall a. Eq a => a -> a -> Bool
== SEXP s Any -> SEXP0
forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
R.unsexp SEXP s Any
attr then "loop" else SEXP s Any -> Value
forall a. ToJSON a => a -> Value
toJSON SEXP s Any
attr
, Text
tp Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXP s a -> Value
forall s (a :: SEXPTYPE). SEXP s a -> Value
go SEXP s a
x
]
where
vector :: (IsVector a, ToJSON (Vector.ElemRep V a), Storable (Vector.ElemRep V a))
=> Vector.Vector a (Vector.ElemRep V a) -> V.Vector Value
vector :: Vector a (ElemRep V a) -> Vector Value
vector = [Value] -> Vector Value
forall a. [a] -> Vector a
V.fromList ([Value] -> Vector Value)
-> (Vector a (ElemRep V a) -> [Value])
-> Vector a (ElemRep V a)
-> Vector Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ElemRep V a -> Value) -> [ElemRep V a] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ElemRep V a -> Value
forall a. ToJSON a => a -> Value
toJSON ([ElemRep V a] -> [Value])
-> (Vector a (ElemRep V a) -> [ElemRep V a])
-> Vector a (ElemRep V a)
-> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a (ElemRep V a) -> [ElemRep V a]
forall (ty :: SEXPTYPE) a. SVECTOR ty a => Vector ty a -> [a]
Vector.toList
ub :: SEXP0
ub = SEXP G 'Symbol -> SEXP0
forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
R.unsexp SEXP G 'Symbol
H.unboundValue
nil :: SEXP0
nil = SEXP G 'Nil -> SEXP0
forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
R.unsexp SEXP G 'Nil
H.nilValue
miss :: SEXP0
miss = SEXP G 'Symbol -> SEXP0
forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
R.unsexp SEXP G 'Symbol
H.missingArg
info :: SEXPInfo
info = IO SEXPInfo -> SEXPInfo
forall a. IO a -> a
unsafePerformIO (IO SEXPInfo -> SEXPInfo) -> IO SEXPInfo -> SEXPInfo
forall a b. (a -> b) -> a -> b
$ SEXP s a -> IO SEXPInfo
forall s (a :: SEXPTYPE). SEXP s a -> IO SEXPInfo
R.peekInfo SEXP s a
x
attr :: SEXP s Any
attr = IO (SEXP s Any) -> SEXP s Any
forall a. IO a -> a
unsafePerformIO (IO (SEXP s Any) -> SEXP s Any) -> IO (SEXP s Any) -> SEXP s Any
forall a b. (a -> b) -> a -> b
$ SEXP s a -> IO (SEXP s Any)
forall s (a :: SEXPTYPE) (b :: SEXPTYPE). SEXP s a -> IO (SEXP s b)
R.getAttributes SEXP s a
x
tp :: Text
tp = String -> Text
T.pack (String -> Text) -> (SEXPTYPE -> String) -> SEXPTYPE -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SEXPTYPE -> String
forall a. Show a => a -> String
show (SEXPTYPE -> Text) -> SEXPTYPE -> Text
forall a b. (a -> b) -> a -> b
$ SEXPInfo -> SEXPTYPE
R.infoType SEXPInfo
info
go :: SEXP s a -> Value
go :: SEXP s a -> Value
go y :: SEXP s a
y | SEXP s a -> SEXP0
forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
R.unsexp SEXP s a
y SEXP0 -> SEXP0 -> Bool
forall a. Eq a => a -> a -> Bool
== SEXP0
ub = Text -> Value
A.String "UnboundValue"
| SEXP s a -> SEXP0
forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
R.unsexp SEXP s a
y SEXP0 -> SEXP0 -> Bool
forall a. Eq a => a -> a -> Bool
== SEXP0
nil = Text -> Value
A.String "NilValue"
| SEXP s a -> SEXP0
forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
R.unsexp SEXP s a
y SEXP0 -> SEXP0 -> Bool
forall a. Eq a => a -> a -> Bool
== SEXP0
miss = Text -> Value
A.String "MissingArg"
go (SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> HExp s a
Nil) = Text -> Value
A.String "NilValue"
go (SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Lang i :: SEXP s a
i j :: SEXP s b
j) =
[Pair] -> Value
object [ "function" Text -> SEXP s a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXP s a
i
, "parameters" Text -> SEXP s b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXP s b
j
]
go h :: SEXP s a
h@(SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Symbol i :: SEXP s a
i j :: SEXP s b
j k :: SEXP s c
k) =
[Pair] -> Value
object [ "name" Text -> SEXP s a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXP s a
i
, "value" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= if SEXP s b -> SEXP0
forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
R.unsexp SEXP s b
j SEXP0 -> SEXP0 -> Bool
forall a. Eq a => a -> a -> Bool
== SEXP s a -> SEXP0
forall s (a :: SEXPTYPE). SEXP s a -> SEXP0
R.unsexp SEXP s a
h then "loop" else SEXP s b -> Value
forall a. ToJSON a => a -> Value
toJSON SEXP s b
j
, "internal" Text -> SEXP s c -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXP s c
k
]
go (SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Special i :: Int32
i) = [Pair] -> Value
object ["index" Text -> Int32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int32
i]
go (SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Builtin i :: Int32
i) = [Pair] -> Value
object ["index" Text -> Int32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int32
i]
go (SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Char v :: Vector 'Char Word8
v) = Text -> Value
A.String (String -> Text
T.pack (Vector 'Char Word8 -> String
Vector.toString Vector 'Char Word8
v))
go (SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Int v :: Vector 'Int Int32
v) = Vector Value -> Value
A.Array (Vector 'Int (ElemRep V 'Int) -> Vector Value
forall (a :: SEXPTYPE).
(IsVector a, ToJSON (ElemRep V a), Storable (ElemRep V a)) =>
Vector a (ElemRep V a) -> Vector Value
vector Vector 'Int Int32
Vector 'Int (ElemRep V 'Int)
v)
go (SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Real v :: Vector 'Real Double
v) = Vector Value -> Value
A.Array (Vector 'Real (ElemRep V 'Real) -> Vector Value
forall (a :: SEXPTYPE).
(IsVector a, ToJSON (ElemRep V a), Storable (ElemRep V a)) =>
Vector a (ElemRep V a) -> Vector Value
vector Vector 'Real Double
Vector 'Real (ElemRep V 'Real)
v)
go (SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Complex v :: Vector 'Complex (Complex Double)
v) = Vector Value -> Value
A.Array (Vector 'Complex (ElemRep V 'Complex) -> Vector Value
forall (a :: SEXPTYPE).
(IsVector a, ToJSON (ElemRep V a), Storable (ElemRep V a)) =>
Vector a (ElemRep V a) -> Vector Value
vector Vector 'Complex (Complex Double)
Vector 'Complex (ElemRep V 'Complex)
v)
go (SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Vector _ v :: Vector 'Vector (SomeSEXP V)
v) = Vector Value -> Value
A.Array (Vector 'Vector (ElemRep V 'Vector) -> Vector Value
forall (a :: SEXPTYPE).
(IsVector a, ToJSON (ElemRep V a), Storable (ElemRep V a)) =>
Vector a (ElemRep V a) -> Vector Value
vector Vector 'Vector (SomeSEXP V)
Vector 'Vector (ElemRep V 'Vector)
v)
go (SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> List i :: SEXP s a
i j :: SEXP s b
j k :: SEXP s c
k) =
[Pair] -> Value
object [ "value" Text -> SEXP s a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXP s a
i
, "next" Text -> SEXP s b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXP s b
j
, "tag" Text -> SEXP s c -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXP s c
k
]
go (SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Env _ _ _) = Text -> Value
A.String "Environment"
go (SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Closure f :: SEXP s a
f b :: SEXP s b
b e :: SEXP s 'Env
e) =
[Pair] -> Value
object [ "formals" Text -> SEXP s a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXP s a
f
, "body" Text -> SEXP s b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXP s b
b
, "environment" Text -> SEXP s 'Env -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXP s 'Env
e
]
go (SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Promise vl :: SEXP s a
vl ex :: SEXP s b
ex en :: SEXP s c
en) =
[Pair] -> Value
object [ "value" Text -> SEXP s a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXP s a
vl
, "expr" Text -> SEXP s b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXP s b
ex
, "environment" Text -> SEXP s c -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXP s c
en
]
go (SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> DotDotDot v :: SEXP s a
v) =
[Pair] -> Value
object [ "promises" Text -> SEXP s a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXP s a
v]
go (SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Expr _ v :: Vector 'Expr (SomeSEXP V)
v) = Vector Value -> Value
A.Array (Vector 'Expr (ElemRep V 'Expr) -> Vector Value
forall (a :: SEXPTYPE).
(IsVector a, ToJSON (ElemRep V a), Storable (ElemRep V a)) =>
Vector a (ElemRep V a) -> Vector Value
vector Vector 'Expr (SomeSEXP V)
Vector 'Expr (ElemRep V 'Expr)
v)
go (SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> HExp s a
Bytecode) = Text -> Value
A.String "Bytecode"
go (SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> ExtPtr _ a :: SEXP s b
a b :: SEXP s 'Symbol
b) =
[Pair] -> Value
object [ "ptr" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
A.String "<PTR>"
, "second" Text -> SEXP s b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXP s b
a
, "symbol" Text -> SEXP s 'Symbol -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXP s 'Symbol
b
]
go (SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> WeakRef k :: SEXP s a
k v :: SEXP s b
v fn :: SEXP s c
fn nxt :: SEXP s d
nxt) =
[Pair] -> Value
object [ "key" Text -> SEXP s a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXP s a
k
, "value" Text -> SEXP s b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXP s b
v
, "finalizer" Text -> SEXP s c -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXP s c
fn
, "next" Text -> SEXP s d -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXP s d
nxt
]
go (SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> Raw _bs :: Vector 'Raw Word8
_bs) = Text -> Value
A.String "<data>"
go (SEXP s a -> HExp s a
forall s (a :: SEXPTYPE). SEXP s a -> HExp s a
hexp -> S4 s :: SEXP s a
s) =
[Pair] -> Value
object [ "tagval" Text -> SEXP s a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SEXP s a
s ]
go _ = Text -> Value
A.String "Unimplemented."
instance ToJSON (SomeSEXP s) where
toJSON :: SomeSEXP s -> Value
toJSON (R.SomeSEXP s :: SEXP s a
s) = SEXP s a -> Value
forall a. ToJSON a => a -> Value
toJSON SEXP s a
s
inspect :: SEXP s a -> String
inspect :: SEXP s a -> String
inspect = ByteString -> String
LBS.unpack (ByteString -> String)
-> (SEXP s a -> ByteString) -> SEXP s a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SEXP s a -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode