-
-
Notifications
You must be signed in to change notification settings - Fork 96
Parsing Simula's Template Haskell Output
From Control.Lens.TH:
makeLenses :: Name -> DecsQ
Build lenses (and traversals) with a sensible default configuration.
e.g.
data FooBar
= Foo { _x, _y :: Int }
| Bar { _x :: Int }
makeLenses ''FooBar
will create
x :: Lens' FooBar Int
x f (Foo a b) = (\a' -> Foo a' b) <$> f a
x f (Bar a) = Bar <$> f a
y :: Traversal' FooBar Int
y f (Foo a b) = (\b' -> Foo a b') <$> f b
y _ c@(Bar _) = pure c
For a Simula specific example, consider the datatype
data OpenVRContext = OpenVRContext
{ _vrSystem :: Ptr VR_IVRSystem_FnTable
, _vrChaperone :: Ptr VR_IVRChaperone_FnTable
, _vrChaperoneSetup :: Ptr VR_IVRChaperoneSetup_FnTable
, _vrCompositor :: Ptr VR_IVRCompositor_FnTable
, _vrOverlay :: Ptr VR_IVROverlay_FnTable
, _vrResources :: Ptr VR_IVRResources_FnTable
, _vrRenderModels :: Ptr VR_IVRRenderModels_FnTable
, _vrExtendedDisplay :: Ptr VR_IVRExtendedDisplay_FnTable
, _vrSettings :: Ptr VR_IVRSettings_FnTable
, _vrApplications :: Ptr VR_IVRApplications_FnTable
, _vrTrackedCamera :: Ptr VR_IVRTrackedCamera_FnTable
, _vrScreenshots :: Ptr VR_IVRScreenshots_FnTable
, _vrDriverManager :: Ptr VR_IVRDriverManager_FnTable
, _vrNotifications :: Ptr VR_IVRNotifications_FnTable }
so that
makeLenses ''OpenVRContext
expands to
vrApplications ::
Lens' OpenVRContext (Ptr VR_IVRApplications_FnTable)
vrApplications
f_aXF5
(OpenVRContext x1_aXF6
x2_aXF7
x3_aXF8
x4_aXF9
x5_aXFa
x6_aXFb
x7_aXFc
x8_aXFd
x9_aXFe
x10_aXFf
x11_aXFg
x12_aXFh
x13_aXFi
x14_aXFj)
= (fmap
(\ y1_aXFk
-> (((((((((((((OpenVRContext x1_aXF6) x2_aXF7) x3_aXF8) x4_aXF9)
x5_aXFa)
x6_aXFb)
x7_aXFc)
x8_aXFd)
x9_aXFe)
y1_aXFk)
x11_aXFg)
x12_aXFh)
x13_aXFi)
x14_aXFj))
(f_aXF5 x10_aXFf)
{-# INLINE vrApplications #-}
vrChaperone :: Lens' OpenVRContext (Ptr VR_IVRChaperone_FnTable)
vrChaperone
f_aXFl
(OpenVRContext x1_aXFm
x2_aXFn
x3_aXFo
x4_aXFp
x5_aXFq
x6_aXFr
x7_aXFs
x8_aXFt
x9_aXFu
x10_aXFv
x11_aXFw
x12_aXFx
x13_aXFy
x14_aXFz)
= (fmap
(\ y1_aXFA
-> (((((((((((((OpenVRContext x1_aXFm) y1_aXFA) x3_aXFo) x4_aXFp)
x5_aXFq)
x6_aXFr)
x7_aXFs)
x8_aXFt)
x9_aXFu)
x10_aXFv)
x11_aXFw)
x12_aXFx)
x13_aXFy)
x14_aXFz))
(f_aXFl x2_aXFn)
{-# INLINE vrChaperone #-}
vrChaperoneSetup ::
Lens' OpenVRContext (Ptr VR_IVRChaperoneSetup_FnTable)
vrChaperoneSetup
f_aXFB
(OpenVRContext x1_aXFC
x2_aXFD
x3_aXFE
x4_aXFF
x5_aXFG
x6_aXFH
x7_aXFI
x8_aXFJ
x9_aXFK
x10_aXFL
x11_aXFM
x12_aXFN
x13_aXFO
x14_aXFP)
= (fmap
(\ y1_aXFQ
-> (((((((((((((OpenVRContext x1_aXFC) x2_aXFD) y1_aXFQ) x4_aXFF)
x5_aXFG)
x6_aXFH)
x7_aXFI)
x8_aXFJ)
x9_aXFK)
x10_aXFL)
x11_aXFM)
x12_aXFN)
x13_aXFO)
x14_aXFP))
(f_aXFB x3_aXFE)
{-# INLINE vrChaperoneSetup #-}
vrCompositor :: Lens' OpenVRContext (Ptr VR_IVRCompositor_FnTable)
vrCompositor
f_aXFR
(OpenVRContext x1_aXFS
x2_aXFT
x3_aXFU
x4_aXFV
x5_aXFW
x6_aXFX
x7_aXFY
x8_aXFZ
x9_aXG0
x10_aXG1
x11_aXG2
x12_aXG3
x13_aXG4
x14_aXG5)
= (fmap
(\ y1_aXG6
-> (((((((((((((OpenVRContext x1_aXFS) x2_aXFT) x3_aXFU) y1_aXG6)
x5_aXFW)
x6_aXFX)
x7_aXFY)
x8_aXFZ)
x9_aXG0)
x10_aXG1)
x11_aXG2)
x12_aXG3)
x13_aXG4)
x14_aXG5))
(f_aXFR x4_aXFV)
{-# INLINE vrCompositor #-}
vrDriverManager ::
Lens' OpenVRContext (Ptr VR_IVRDriverManager_FnTable)
vrDriverManager
f_aXG7
(OpenVRContext x1_aXG8
x2_aXG9
x3_aXGa
x4_aXGb
x5_aXGc
x6_aXGd
x7_aXGe
x8_aXGf
x9_aXGg
x10_aXGh
x11_aXGi
x12_aXGj
x13_aXGk
x14_aXGl)
= (fmap
(\ y1_aXGm
-> (((((((((((((OpenVRContext x1_aXG8) x2_aXG9) x3_aXGa) x4_aXGb)
x5_aXGc)
x6_aXGd)
x7_aXGe)
x8_aXGf)
x9_aXGg)
x10_aXGh)
x11_aXGi)
x12_aXGj)
y1_aXGm)
x14_aXGl))
(f_aXG7 x13_aXGk)
{-# INLINE vrDriverManager #-}
vrExtendedDisplay ::
Lens' OpenVRContext (Ptr VR_IVRExtendedDisplay_FnTable)
vrExtendedDisplay
f_aXGn
(OpenVRContext x1_aXGo
x2_aXGp
x3_aXGq
x4_aXGr
x5_aXGs
x6_aXGt
x7_aXGu
x8_aXGv
x9_aXGw
x10_aXGx
x11_aXGy
x12_aXGz
x13_aXGA
x14_aXGB)
= (fmap
(\ y1_aXGC
-> (((((((((((((OpenVRContext x1_aXGo) x2_aXGp) x3_aXGq) x4_aXGr)
x5_aXGs)
x6_aXGt)
x7_aXGu)
y1_aXGC)
x9_aXGw)
x10_aXGx)
x11_aXGy)
x12_aXGz)
x13_aXGA)
x14_aXGB))
(f_aXGn x8_aXGv)
{-# INLINE vrExtendedDisplay #-}
vrNotifications ::
Lens' OpenVRContext (Ptr VR_IVRNotifications_FnTable)
vrNotifications
f_aXGD
(OpenVRContext x1_aXGE
x2_aXGF
x3_aXGG
x4_aXGH
x5_aXGI
x6_aXGJ
x7_aXGK
x8_aXGL
x9_aXGM
x10_aXGN
x11_aXGO
x12_aXGP
x13_aXGQ
x14_aXGR)
= (fmap
(\ y1_aXGS
-> (((((((((((((OpenVRContext x1_aXGE) x2_aXGF) x3_aXGG) x4_aXGH)
x5_aXGI)
x6_aXGJ)
x7_aXGK)
x8_aXGL)
x9_aXGM)
x10_aXGN)
x11_aXGO)
x12_aXGP)
x13_aXGQ)
y1_aXGS))
(f_aXGD x14_aXGR)
{-# INLINE vrNotifications #-}
vrOverlay :: Lens' OpenVRContext (Ptr VR_IVROverlay_FnTable)
vrOverlay
f_aXGT
(OpenVRContext x1_aXGU
x2_aXGV
x3_aXGW
x4_aXGX
x5_aXGY
x6_aXGZ
x7_aXH0
x8_aXH1
x9_aXH2
x10_aXH3
x11_aXH4
x12_aXH5
x13_aXH6
x14_aXH7)
= (fmap
(\ y1_aXH8
-> (((((((((((((OpenVRContext x1_aXGU) x2_aXGV) x3_aXGW) x4_aXGX)
y1_aXH8)
x6_aXGZ)
x7_aXH0)
x8_aXH1)
x9_aXH2)
x10_aXH3)
x11_aXH4)
x12_aXH5)
x13_aXH6)
x14_aXH7))
(f_aXGT x5_aXGY)
{-# INLINE vrOverlay #-}
vrRenderModels ::
Lens' OpenVRContext (Ptr VR_IVRRenderModels_FnTable)
vrRenderModels
f_aXH9
(OpenVRContext x1_aXHa
x2_aXHb
x3_aXHc
x4_aXHd
x5_aXHe
x6_aXHf
x7_aXHg
x8_aXHh
x9_aXHi
x10_aXHj
x11_aXHk
x12_aXHl
x13_aXHm
x14_aXHn)
= (fmap
(\ y1_aXHo
-> (((((((((((((OpenVRContext x1_aXHa) x2_aXHb) x3_aXHc) x4_aXHd)
x5_aXHe)
x6_aXHf)
y1_aXHo)
x8_aXHh)
x9_aXHi)
x10_aXHj)
x11_aXHk)
x12_aXHl)
x13_aXHm)
x14_aXHn))
(f_aXH9 x7_aXHg)
{-# INLINE vrRenderModels #-}
vrResources :: Lens' OpenVRContext (Ptr VR_IVRResources_FnTable)
vrResources
f_aXHp
(OpenVRContext x1_aXHq
x2_aXHr
x3_aXHs
x4_aXHt
x5_aXHu
x6_aXHv
x7_aXHw
x8_aXHx
x9_aXHy
x10_aXHz
x11_aXHA
x12_aXHB
x13_aXHC
x14_aXHD)
= (fmap
(\ y1_aXHE
-> (((((((((((((OpenVRContext x1_aXHq) x2_aXHr) x3_aXHs) x4_aXHt)
x5_aXHu)
y1_aXHE)
x7_aXHw)
x8_aXHx)
x9_aXHy)
x10_aXHz)
x11_aXHA)
x12_aXHB)
x13_aXHC)
x14_aXHD))
(f_aXHp x6_aXHv)
{-# INLINE vrResources #-}
vrScreenshots ::
Lens' OpenVRContext (Ptr VR_IVRScreenshots_FnTable)
vrScreenshots
f_aXHF
(OpenVRContext x1_aXHG
x2_aXHH
x3_aXHI
x4_aXHJ
x5_aXHK
x6_aXHL
x7_aXHM
x8_aXHN
x9_aXHO
x10_aXHP
x11_aXHQ
x12_aXHR
x13_aXHS
x14_aXHT)
= (fmap
(\ y1_aXHU
-> (((((((((((((OpenVRContext x1_aXHG) x2_aXHH) x3_aXHI) x4_aXHJ)
x5_aXHK)
x6_aXHL)
x7_aXHM)
x8_aXHN)
x9_aXHO)
x10_aXHP)
x11_aXHQ)
y1_aXHU)
x13_aXHS)
x14_aXHT))
(f_aXHF x12_aXHR)
{-# INLINE vrScreenshots #-}
vrSettings :: Lens' OpenVRContext (Ptr VR_IVRSettings_FnTable)
vrSettings
f_aXHV
(OpenVRContext x1_aXHW
x2_aXHX
x3_aXHY
x4_aXHZ
x5_aXI0
x6_aXI1
x7_aXI2
x8_aXI3
x9_aXI4
x10_aXI5
x11_aXI6
x12_aXI7
x13_aXI8
x14_aXI9)
= (fmap
(\ y1_aXIa
-> (((((((((((((OpenVRContext x1_aXHW) x2_aXHX) x3_aXHY) x4_aXHZ)
x5_aXI0)
x6_aXI1)
x7_aXI2)
x8_aXI3)
y1_aXIa)
x10_aXI5)
x11_aXI6)
x12_aXI7)
x13_aXI8)
x14_aXI9))
(f_aXHV x9_aXI4)
{-# INLINE vrSettings #-}
vrSystem :: Lens' OpenVRContext (Ptr VR_IVRSystem_FnTable)
vrSystem
f_aXIb
(OpenVRContext x1_aXIc
x2_aXId
x3_aXIe
x4_aXIf
x5_aXIg
x6_aXIh
x7_aXIi
x8_aXIj
x9_aXIk
x10_aXIl
x11_aXIm
x12_aXIn
x13_aXIo
x14_aXIp)
= (fmap
(\ y1_aXIq
-> (((((((((((((OpenVRContext y1_aXIq) x2_aXId) x3_aXIe) x4_aXIf)
x5_aXIg)
x6_aXIh)
x7_aXIi)
x8_aXIj)
x9_aXIk)
x10_aXIl)
x11_aXIm)
x12_aXIn)
x13_aXIo)
x14_aXIp))
(f_aXIb x1_aXIc)
{-# INLINE vrSystem #-}
vrTrackedCamera ::
Lens' OpenVRContext (Ptr VR_IVRTrackedCamera_FnTable)
vrTrackedCamera
f_aXIr
(OpenVRContext x1_aXIs
x2_aXIt
x3_aXIu
x4_aXIv
x5_aXIw
x6_aXIx
x7_aXIy
x8_aXIz
x9_aXIA
x10_aXIB
x11_aXIC
x12_aXID
x13_aXIE
x14_aXIF)
= (fmap
(\ y1_aXIG
-> (((((((((((((OpenVRContext x1_aXIs) x2_aXIt) x3_aXIu) x4_aXIv)
x5_aXIw)
x6_aXIx)
x7_aXIy)
x8_aXIz)
x9_aXIA)
x10_aXIB)
y1_aXIG)
x12_aXID)
x13_aXIE)
x14_aXIF))
(f_aXIr x11_aXIC)
{-# INLINE vrTrackedCamera #-}
See here. For a Simula example, consider the datatype
data Const = Const
{ constname :: Text
, consttype :: Text
, constval :: Text
} deriving (Show, Eq)
so that
deriveJSON defaultOptions ''Const
expands to
instance ToJSON Const where
toJSON
= \ value_aWVv
-> case value_aWVv of {
Const arg1_aWVw arg2_aWVx arg3_aWVy
-> object
[((T.pack "constname") .= (toJSON arg1_aWVw)),
((T.pack "consttype") .= (toJSON arg2_aWVx)),
((T.pack "constval") .= (toJSON arg3_aWVy))] }
toEncoding
= \ value_aWVz
-> case value_aWVz of {
Const arg1_aWVA arg2_aWVB arg3_aWVC
-> Data.Aeson.Encoding.Internal.wrapObject
(Data.Aeson.TH.commaSep
[((Data.Aeson.Encoding.Internal.string "constname")
Data.Aeson.Encoding.Internal.><
(Data.Aeson.Encoding.Internal.colon
Data.Aeson.Encoding.Internal.>< (toEncoding arg1_aWVA))),
((Data.Aeson.Encoding.Internal.string "consttype")
Data.Aeson.Encoding.Internal.><
(Data.Aeson.Encoding.Internal.colon
Data.Aeson.Encoding.Internal.>< (toEncoding arg2_aWVB))),
((Data.Aeson.Encoding.Internal.string "constval")
Data.Aeson.Encoding.Internal.><
(Data.Aeson.Encoding.Internal.colon
Data.Aeson.Encoding.Internal.>< (toEncoding arg3_aWVC)))]) }
instance FromJSON Const where
parseJSON
= \ value_aWVD
-> case value_aWVD of
Object recObj_aWVE
-> (((Const
<$>
(((((Data.Aeson.TH.lookupField parseJSON) "OpenVR.TH.Const")
"Const")
recObj_aWVE)
(T.pack "constname")))
<*>
(((((Data.Aeson.TH.lookupField parseJSON) "OpenVR.TH.Const")
"Const")
recObj_aWVE)
(T.pack "consttype")))
<*>
(((((Data.Aeson.TH.lookupField parseJSON) "OpenVR.TH.Const")
"Const")
recObj_aWVE)
(T.pack "constval")))
other_aWVF
-> (((Data.Aeson.TH.parseTypeMismatch' "Const") "OpenVR.TH.Const")
"Object")
(Data.Aeson.TH.valueConName other_aWVF)
We have that
parseOpenVRJSON "openvr/headers/openvr_api.json"
expands to
instance VRInterface VR_IVRApplications_FnTable where
interfaceVersion _ = "IVRApplications_006"
interface = vrApplications
instance VRInterface VR_IVRChaperone_FnTable where
interfaceVersion _ = "IVRChaperone_003"
interface = vrChaperone
instance VRInterface VR_IVRChaperoneSetup_FnTable where
interfaceVersion _ = "IVRChaperoneSetup_005"
interface = vrChaperoneSetup
instance VRInterface VR_IVRCompositor_FnTable where
interfaceVersion _ = "IVRCompositor_022"
interface = vrCompositor
instance VRInterface VR_IVRDriverManager_FnTable where
interfaceVersion _ = "IVRDriverManager_001"
interface = vrDriverManager
instance VRInterface VR_IVRExtendedDisplay_FnTable where
interfaceVersion _ = "IVRExtendedDisplay_001"
interface = vrExtendedDisplay
instance VRInterface VR_IVRNotifications_FnTable where
interfaceVersion _ = "IVRNotifications_002"
interface = vrNotifications
instance VRInterface VR_IVROverlay_FnTable where
interfaceVersion _ = "IVROverlay_017"
interface = vrOverlay
instance VRInterface VR_IVRRenderModels_FnTable where
interfaceVersion _ = "IVRRenderModels_005"
interface = vrRenderModels
instance VRInterface VR_IVRResources_FnTable where
interfaceVersion _ = "IVRResources_001"
interface = vrResources
instance VRInterface VR_IVRScreenshots_FnTable where
interfaceVersion _ = "IVRScreenshots_001"
interface = vrScreenshots
instance VRInterface VR_IVRSettings_FnTable where
interfaceVersion _ = "IVRSettings_002"
interface = vrSettings
instance VRInterface VR_IVRSystem_FnTable where
interfaceVersion _ = "IVRSystem_017"
interface = vrSystem
instance VRInterface VR_IVRTrackedCamera_FnTable where
interfaceVersion _ = "IVRTrackedCamera_003"
interface = vrTrackedCamera
k_pch_MimeType_HomeApp :: String
k_pch_MimeType_HomeApp = "vr/home"
k_pch_MimeType_GameTheater :: String
k_pch_MimeType_GameTheater = "vr/game_theater"
k_pch_Controller_Component_GDC2015 :: String
k_pch_Controller_Component_GDC2015 = "gdc2015"
k_pch_Controller_Component_Base :: String
k_pch_Controller_Component_Base = "base"
k_pch_Controller_Component_Tip :: String
k_pch_Controller_Component_Tip = "tip"
k_pch_Controller_Component_HandGrip :: String
k_pch_Controller_Component_HandGrip = "handgrip"
k_pch_Controller_Component_Status :: String
k_pch_Controller_Component_Status = "status"
k_pch_SteamVR_Section :: String
k_pch_SteamVR_Section = "steamvr"
k_pch_SteamVR_RequireHmd_String :: String
k_pch_SteamVR_RequireHmd_String = "requireHmd"
k_pch_SteamVR_ForcedDriverKey_String :: String
k_pch_SteamVR_ForcedDriverKey_String = "forcedDriver"
k_pch_SteamVR_ForcedHmdKey_String :: String
k_pch_SteamVR_ForcedHmdKey_String = "forcedHmd"
k_pch_SteamVR_DisplayDebug_Bool :: String
k_pch_SteamVR_DisplayDebug_Bool = "displayDebug"
k_pch_SteamVR_DebugProcessPipe_String :: String
k_pch_SteamVR_DebugProcessPipe_String = "debugProcessPipe"
k_pch_SteamVR_DisplayDebugX_Int32 :: String
k_pch_SteamVR_DisplayDebugX_Int32 = "displayDebugX"
k_pch_SteamVR_DisplayDebugY_Int32 :: String
k_pch_SteamVR_DisplayDebugY_Int32 = "displayDebugY"
k_pch_SteamVR_SendSystemButtonToAllApps_Bool :: String
k_pch_SteamVR_SendSystemButtonToAllApps_Bool
= "sendSystemButtonToAllApps"
k_pch_SteamVR_LogLevel_Int32 :: String
k_pch_SteamVR_LogLevel_Int32 = "loglevel"
k_pch_SteamVR_IPD_Float :: String
k_pch_SteamVR_IPD_Float = "ipd"
k_pch_SteamVR_Background_String :: String
k_pch_SteamVR_Background_String = "background"
k_pch_SteamVR_BackgroundUseDomeProjection_Bool :: String
k_pch_SteamVR_BackgroundUseDomeProjection_Bool
= "backgroundUseDomeProjection"
k_pch_SteamVR_BackgroundCameraHeight_Float :: String
k_pch_SteamVR_BackgroundCameraHeight_Float
= "backgroundCameraHeight"
k_pch_SteamVR_BackgroundDomeRadius_Float :: String
k_pch_SteamVR_BackgroundDomeRadius_Float = "backgroundDomeRadius"
k_pch_SteamVR_GridColor_String :: String
k_pch_SteamVR_GridColor_String = "gridColor"
k_pch_SteamVR_PlayAreaColor_String :: String
k_pch_SteamVR_PlayAreaColor_String = "playAreaColor"
k_pch_SteamVR_ShowStage_Bool :: String
k_pch_SteamVR_ShowStage_Bool = "showStage"
k_pch_SteamVR_ActivateMultipleDrivers_Bool :: String
k_pch_SteamVR_ActivateMultipleDrivers_Bool
= "activateMultipleDrivers"
k_pch_SteamVR_DirectMode_Bool :: String
k_pch_SteamVR_DirectMode_Bool = "directMode"
k_pch_SteamVR_DirectModeEdidVid_Int32 :: String
k_pch_SteamVR_DirectModeEdidVid_Int32 = "directModeEdidVid"
k_pch_SteamVR_DirectModeEdidPid_Int32 :: String
k_pch_SteamVR_DirectModeEdidPid_Int32 = "directModeEdidPid"
k_pch_SteamVR_UsingSpeakers_Bool :: String
k_pch_SteamVR_UsingSpeakers_Bool = "usingSpeakers"
k_pch_SteamVR_SpeakersForwardYawOffsetDegrees_Float :: String
k_pch_SteamVR_SpeakersForwardYawOffsetDegrees_Float
= "speakersForwardYawOffsetDegrees"
k_pch_SteamVR_BaseStationPowerManagement_Bool :: String
k_pch_SteamVR_BaseStationPowerManagement_Bool
= "basestationPowerManagement"
k_pch_SteamVR_NeverKillProcesses_Bool :: String
k_pch_SteamVR_NeverKillProcesses_Bool = "neverKillProcesses"
k_pch_SteamVR_SupersampleScale_Float :: String
k_pch_SteamVR_SupersampleScale_Float = "supersampleScale"
k_pch_SteamVR_AllowAsyncReprojection_Bool :: String
k_pch_SteamVR_AllowAsyncReprojection_Bool
= "allowAsyncReprojection"
k_pch_SteamVR_AllowReprojection_Bool :: String
k_pch_SteamVR_AllowReprojection_Bool
= "allowInterleavedReprojection"
k_pch_SteamVR_ForceReprojection_Bool :: String
k_pch_SteamVR_ForceReprojection_Bool = "forceReprojection"
k_pch_SteamVR_ForceFadeOnBadTracking_Bool :: String
k_pch_SteamVR_ForceFadeOnBadTracking_Bool
= "forceFadeOnBadTracking"
k_pch_SteamVR_DefaultMirrorView_Int32 :: String
k_pch_SteamVR_DefaultMirrorView_Int32 = "defaultMirrorView"
k_pch_SteamVR_ShowMirrorView_Bool :: String
k_pch_SteamVR_ShowMirrorView_Bool = "showMirrorView"
k_pch_SteamVR_MirrorViewGeometry_String :: String
k_pch_SteamVR_MirrorViewGeometry_String = "mirrorViewGeometry"
k_pch_SteamVR_StartMonitorFromAppLaunch :: String
k_pch_SteamVR_StartMonitorFromAppLaunch
= "startMonitorFromAppLaunch"
k_pch_SteamVR_StartCompositorFromAppLaunch_Bool :: String
k_pch_SteamVR_StartCompositorFromAppLaunch_Bool
= "startCompositorFromAppLaunch"
k_pch_SteamVR_StartDashboardFromAppLaunch_Bool :: String
k_pch_SteamVR_StartDashboardFromAppLaunch_Bool
= "startDashboardFromAppLaunch"
k_pch_SteamVR_StartOverlayAppsFromDashboard_Bool :: String
k_pch_SteamVR_StartOverlayAppsFromDashboard_Bool
= "startOverlayAppsFromDashboard"
k_pch_SteamVR_EnableHomeApp :: String
k_pch_SteamVR_EnableHomeApp = "enableHomeApp"
k_pch_SteamVR_CycleBackgroundImageTimeSec_Int32 :: String
k_pch_SteamVR_CycleBackgroundImageTimeSec_Int32
= "CycleBackgroundImageTimeSec"
k_pch_SteamVR_RetailDemo_Bool :: String
k_pch_SteamVR_RetailDemo_Bool = "retailDemo"
k_pch_SteamVR_IpdOffset_Float :: String
k_pch_SteamVR_IpdOffset_Float = "ipdOffset"
k_pch_SteamVR_AllowSupersampleFiltering_Bool :: String
k_pch_SteamVR_AllowSupersampleFiltering_Bool
= "allowSupersampleFiltering"
k_pch_SteamVR_EnableLinuxVulkanAsync_Bool :: String
k_pch_SteamVR_EnableLinuxVulkanAsync_Bool
= "enableLinuxVulkanAsync"
k_pch_SteamVR_HaveStartedTutorialForNativeChaperoneDriver_Bool ::
String
k_pch_SteamVR_HaveStartedTutorialForNativeChaperoneDriver_Bool
= "haveStartedTutorialForNativeChaperoneDriver"
k_pch_Lighthouse_Section :: String
k_pch_Lighthouse_Section = "driver_lighthouse"
k_pch_Lighthouse_DisableIMU_Bool :: String
k_pch_Lighthouse_DisableIMU_Bool = "disableimu"
k_pch_Lighthouse_UseDisambiguation_String :: String
k_pch_Lighthouse_UseDisambiguation_String = "usedisambiguation"
k_pch_Lighthouse_DisambiguationDebug_Int32 :: String
k_pch_Lighthouse_DisambiguationDebug_Int32 = "disambiguationdebug"
k_pch_Lighthouse_PrimaryBasestation_Int32 :: String
k_pch_Lighthouse_PrimaryBasestation_Int32 = "primarybasestation"
k_pch_Lighthouse_DBHistory_Bool :: String
k_pch_Lighthouse_DBHistory_Bool = "dbhistory"
k_pch_Lighthouse_EnableBluetooth_Bool :: String
k_pch_Lighthouse_EnableBluetooth_Bool = "enableBluetooth"
k_pch_Null_Section :: String
k_pch_Null_Section = "driver_null"
k_pch_Null_SerialNumber_String :: String
k_pch_Null_SerialNumber_String = "serialNumber"
k_pch_Null_ModelNumber_String :: String
k_pch_Null_ModelNumber_String = "modelNumber"
k_pch_Null_WindowX_Int32 :: String
k_pch_Null_WindowX_Int32 = "windowX"
k_pch_Null_WindowY_Int32 :: String
k_pch_Null_WindowY_Int32 = "windowY"
k_pch_Null_WindowWidth_Int32 :: String
k_pch_Null_WindowWidth_Int32 = "windowWidth"
k_pch_Null_WindowHeight_Int32 :: String
k_pch_Null_WindowHeight_Int32 = "windowHeight"
k_pch_Null_RenderWidth_Int32 :: String
k_pch_Null_RenderWidth_Int32 = "renderWidth"
k_pch_Null_RenderHeight_Int32 :: String
k_pch_Null_RenderHeight_Int32 = "renderHeight"
k_pch_Null_SecondsFromVsyncToPhotons_Float :: String
k_pch_Null_SecondsFromVsyncToPhotons_Float
= "secondsFromVsyncToPhotons"
k_pch_Null_DisplayFrequency_Float :: String
k_pch_Null_DisplayFrequency_Float = "displayFrequency"
k_pch_UserInterface_Section :: String
k_pch_UserInterface_Section = "userinterface"
k_pch_UserInterface_StatusAlwaysOnTop_Bool :: String
k_pch_UserInterface_StatusAlwaysOnTop_Bool = "StatusAlwaysOnTop"
k_pch_UserInterface_MinimizeToTray_Bool :: String
k_pch_UserInterface_MinimizeToTray_Bool = "MinimizeToTray"
k_pch_UserInterface_Screenshots_Bool :: String
k_pch_UserInterface_Screenshots_Bool = "screenshots"
k_pch_UserInterface_ScreenshotType_Int :: String
k_pch_UserInterface_ScreenshotType_Int = "screenshotType"
k_pch_Notifications_Section :: String
k_pch_Notifications_Section = "notifications"
k_pch_Notifications_DoNotDisturb_Bool :: String
k_pch_Notifications_DoNotDisturb_Bool = "DoNotDisturb"
k_pch_Keyboard_Section :: String
k_pch_Keyboard_Section = "keyboard"
k_pch_Keyboard_TutorialCompletions :: String
k_pch_Keyboard_TutorialCompletions = "TutorialCompletions"
k_pch_Keyboard_ScaleX :: String
k_pch_Keyboard_ScaleX = "ScaleX"
k_pch_Keyboard_ScaleY :: String
k_pch_Keyboard_ScaleY = "ScaleY"
k_pch_Keyboard_OffsetLeftX :: String
k_pch_Keyboard_OffsetLeftX = "OffsetLeftX"
k_pch_Keyboard_OffsetRightX :: String
k_pch_Keyboard_OffsetRightX = "OffsetRightX"
k_pch_Keyboard_OffsetY :: String
k_pch_Keyboard_OffsetY = "OffsetY"
k_pch_Keyboard_Smoothing :: String
k_pch_Keyboard_Smoothing = "Smoothing"
k_pch_Perf_Section :: String
k_pch_Perf_Section = "perfcheck"
k_pch_Perf_HeuristicActive_Bool :: String
k_pch_Perf_HeuristicActive_Bool = "heuristicActive"
k_pch_Perf_NotifyInHMD_Bool :: String
k_pch_Perf_NotifyInHMD_Bool = "warnInHMD"
k_pch_Perf_NotifyOnlyOnce_Bool :: String
k_pch_Perf_NotifyOnlyOnce_Bool = "warnOnlyOnce"
k_pch_Perf_AllowTimingStore_Bool :: String
k_pch_Perf_AllowTimingStore_Bool = "allowTimingStore"
k_pch_Perf_SaveTimingsOnExit_Bool :: String
k_pch_Perf_SaveTimingsOnExit_Bool = "saveTimingsOnExit"
k_pch_Perf_TestData_Float :: String
k_pch_Perf_TestData_Float = "perfTestData"
k_pch_Perf_LinuxGPUProfiling_Bool :: String
k_pch_Perf_LinuxGPUProfiling_Bool = "linuxGPUProfiling"
k_pch_CollisionBounds_Section :: String
k_pch_CollisionBounds_Section = "collisionBounds"
k_pch_CollisionBounds_Style_Int32 :: String
k_pch_CollisionBounds_Style_Int32 = "CollisionBoundsStyle"
k_pch_CollisionBounds_GroundPerimeterOn_Bool :: String
k_pch_CollisionBounds_GroundPerimeterOn_Bool
= "CollisionBoundsGroundPerimeterOn"
k_pch_CollisionBounds_CenterMarkerOn_Bool :: String
k_pch_CollisionBounds_CenterMarkerOn_Bool
= "CollisionBoundsCenterMarkerOn"
k_pch_CollisionBounds_PlaySpaceOn_Bool :: String
k_pch_CollisionBounds_PlaySpaceOn_Bool
= "CollisionBoundsPlaySpaceOn"
k_pch_CollisionBounds_FadeDistance_Float :: String
k_pch_CollisionBounds_FadeDistance_Float
= "CollisionBoundsFadeDistance"
k_pch_CollisionBounds_ColorGammaR_Int32 :: String
k_pch_CollisionBounds_ColorGammaR_Int32
= "CollisionBoundsColorGammaR"
k_pch_CollisionBounds_ColorGammaG_Int32 :: String
k_pch_CollisionBounds_ColorGammaG_Int32
= "CollisionBoundsColorGammaG"
k_pch_CollisionBounds_ColorGammaB_Int32 :: String
k_pch_CollisionBounds_ColorGammaB_Int32
= "CollisionBoundsColorGammaB"
k_pch_CollisionBounds_ColorGammaA_Int32 :: String
k_pch_CollisionBounds_ColorGammaA_Int32
= "CollisionBoundsColorGammaA"
k_pch_Camera_Section :: String
k_pch_Camera_Section = "camera"
k_pch_Camera_EnableCamera_Bool :: String
k_pch_Camera_EnableCamera_Bool = "enableCamera"
k_pch_Camera_EnableCameraInDashboard_Bool :: String
k_pch_Camera_EnableCameraInDashboard_Bool
= "enableCameraInDashboard"
k_pch_Camera_EnableCameraForCollisionBounds_Bool :: String
k_pch_Camera_EnableCameraForCollisionBounds_Bool
= "enableCameraForCollisionBounds"
k_pch_Camera_EnableCameraForRoomView_Bool :: String
k_pch_Camera_EnableCameraForRoomView_Bool
= "enableCameraForRoomView"
k_pch_Camera_BoundsColorGammaR_Int32 :: String
k_pch_Camera_BoundsColorGammaR_Int32 = "cameraBoundsColorGammaR"
k_pch_Camera_BoundsColorGammaG_Int32 :: String
k_pch_Camera_BoundsColorGammaG_Int32 = "cameraBoundsColorGammaG"
k_pch_Camera_BoundsColorGammaB_Int32 :: String
k_pch_Camera_BoundsColorGammaB_Int32 = "cameraBoundsColorGammaB"
k_pch_Camera_BoundsColorGammaA_Int32 :: String
k_pch_Camera_BoundsColorGammaA_Int32 = "cameraBoundsColorGammaA"
k_pch_Camera_BoundsStrength_Int32 :: String
k_pch_Camera_BoundsStrength_Int32 = "cameraBoundsStrength"
k_pch_audio_Section :: String
k_pch_audio_Section = "audio"
k_pch_audio_OnPlaybackDevice_String :: String
k_pch_audio_OnPlaybackDevice_String = "onPlaybackDevice"
k_pch_audio_OnRecordDevice_String :: String
k_pch_audio_OnRecordDevice_String = "onRecordDevice"
k_pch_audio_OnPlaybackMirrorDevice_String :: String
k_pch_audio_OnPlaybackMirrorDevice_String
= "onPlaybackMirrorDevice"
k_pch_audio_OffPlaybackDevice_String :: String
k_pch_audio_OffPlaybackDevice_String = "offPlaybackDevice"
k_pch_audio_OffRecordDevice_String :: String
k_pch_audio_OffRecordDevice_String = "offRecordDevice"
k_pch_audio_VIVEHDMIGain :: String
k_pch_audio_VIVEHDMIGain = "viveHDMIGain"
k_pch_Power_Section :: String
k_pch_Power_Section = "power"
k_pch_Power_PowerOffOnExit_Bool :: String
k_pch_Power_PowerOffOnExit_Bool = "powerOffOnExit"
k_pch_Power_TurnOffScreensTimeout_Float :: String
k_pch_Power_TurnOffScreensTimeout_Float = "turnOffScreensTimeout"
k_pch_Power_TurnOffControllersTimeout_Float :: String
k_pch_Power_TurnOffControllersTimeout_Float
= "turnOffControllersTimeout"
k_pch_Power_ReturnToWatchdogTimeout_Float :: String
k_pch_Power_ReturnToWatchdogTimeout_Float
= "returnToWatchdogTimeout"
k_pch_Power_AutoLaunchSteamVROnButtonPress :: String
k_pch_Power_AutoLaunchSteamVROnButtonPress
= "autoLaunchSteamVROnButtonPress"
k_pch_Power_PauseCompositorOnStandby_Bool :: String
k_pch_Power_PauseCompositorOnStandby_Bool
= "pauseCompositorOnStandby"
k_pch_Dashboard_Section :: String
k_pch_Dashboard_Section = "dashboard"
k_pch_Dashboard_EnableDashboard_Bool :: String
k_pch_Dashboard_EnableDashboard_Bool = "enableDashboard"
k_pch_Dashboard_ArcadeMode_Bool :: String
k_pch_Dashboard_ArcadeMode_Bool = "arcadeMode"
k_pch_modelskin_Section :: String
k_pch_modelskin_Section = "modelskins"
k_pch_Driver_Enable_Bool :: String
k_pch_Driver_Enable_Bool = "enable"
k_nDriverNone :: Int
k_nDriverNone = 4294967295
k_unMaxDriverDebugResponseSize :: Int
k_unMaxDriverDebugResponseSize = 32768
k_unTrackedDeviceIndex_Hmd :: Int
k_unTrackedDeviceIndex_Hmd = 0
k_unMaxTrackedDeviceCount :: Int
k_unMaxTrackedDeviceCount = 64
k_unTrackedDeviceIndexOther :: Int
k_unTrackedDeviceIndexOther = 4294967294
k_unTrackedDeviceIndexInvalid :: Int
k_unTrackedDeviceIndexInvalid = 4294967295
k_unMaxPropertyStringSize :: Int
k_unMaxPropertyStringSize = 32768
k_unControllerStateAxisCount :: Int
k_unControllerStateAxisCount = 5
k_unScreenshotHandleInvalid :: Int
k_unScreenshotHandleInvalid = 0
k_unMaxApplicationKeyLength :: Int
k_unMaxApplicationKeyLength = 128
k_unVROverlayMaxKeyLength :: Int
k_unVROverlayMaxKeyLength = 128
k_unVROverlayMaxNameLength :: Int
k_unVROverlayMaxNameLength = 128
k_unMaxOverlayCount :: Int
k_unMaxOverlayCount = 64
k_unMaxOverlayIntersectionMaskPrimitivesCount :: Int
k_unMaxOverlayIntersectionMaskPrimitivesCount = 32
k_unNotificationTextMaxSize :: Int
k_unNotificationTextMaxSize = 256
k_unMaxSettingsKeyLength :: Int
k_unMaxSettingsKeyLength = 128
Consider
makeVrCall 'ivrCompositorSubmit_ "ivrCompositorSubmit"
To understand what this expands to, we can work backwards from the C++ function vr::IVRCompositor::Submit(..)
from openvr.h:
namespace vr
{
class IVRCompositor
{
public:
//...
virtual EVRCompositorError Submit( EVREye eEye, const Texture_t *pTexture, const VRTextureBounds_t* pBounds = 0, EVRSubmitFlags nSubmitFlags = Submit_Default ) = 0;
//...
};
}
In this context, the class IVRCompositor
gives rise to two objects:
-
A virtual table. Since
Submit(..)
isvirtual
, our C++ compiler will implicitly insert a (static) pointer to a virtual table inIVRCompositor
. This virtual table is itself an array of pointers to (virtual) functions. It contains the addresses of functions which implement thevirtual
methods ofIVRCompositor
, so that the proper one can be called at runtime. -
A virtual pointer. If
instanceIVRCompositor
is an instance ofvr::IVRCompositor
, then our C++ compiler will also implicitly create a pointer to the virtual table described in (1), and make it an instance variable ofinstanceIVRCompositor
. In C++, this hidden virtual pointer is retrieved behind the scenes fromthis
, so that C++ calls toSubmit(..)
are implicitly resolved asSubmit(this, ..)
(or, for our purposes, asSubmit(vpointer, ..)
) by the compiler.
With this in mind, consider the c2hs function ivrCompositorSubmit_
:
-- Internal.chs
{#fun VR_IVRCompositor_FnTable->Submit as ivrCompositorSubmit_
{ coerce `VR_IVRCompositor_FnTable' -- <-- virtual table
, castPtr `Ptr VR_IVRCompositor_FnTable' -- <-- virtual pointer to virtual table
, `EVREye'
, `TexturePtr'
, `VRTextureBounds_t'
, `EVRSubmitFlags' } -> `EVRCompositorError' #}
The function ivrCompositorSubmit_
emulates a C++ call to vr::IVRCompositor::Submit(..)
. Since we’re in Haskell and not C++, this function requires us to supply as first argument a VR_IVRCompositor_FnTable
(i.e., IVRCompositor
’s static virtual table), and as second argument a Ptr VR_IVRCompositor_FnTable
(i.e., a vpointer which would normally be accessed from this
).
Fortunately, we don’t actually use ivrCompositorSubmit_
in Simula; instead, we use ivrCompositorSubmit
:
makeVrCall 'ivrCompositorSubmit_ "ivrCompositorSubmit"
Here, ivrCompositorSubmit
is a version of ivrCompositorSubmit_
that is automatically supplied with its first two arguments. In particular, we have that
makeVrCall 'ivrCompositorSubmit_ "ivrCompositorSubmit"
expands to
ivrCompositorSubmit ::
EVREye
-> TexturePtr
-> VRTextureBounds_t -> EVRSubmitFlags -> IO EVRCompositorError
ivrCompositorSubmit
= \ x_aY6M x_aY6N x_aY6O x_aY6P
-> do ctx_aY6Q <- getOpenVRContext
let ptr_aY6S = (view interface) ctx -- <-- Simula keeps ONE instance of an IVRCompositor alive, whose vpointer is accessed here through some black magic that isn't important to understand
vtbl_aY6R <- peek ptr_aY6S -- <-- We then peek this vpointer to get the actual vr::IVRCompositor vtable
(((((ivrCompositorSubmit_ vtbl_aY6R) ptr_aY6S) x_aY6M) x_aY6N) -- <-- We then jam the vtable and vpointer as the two arguments to ivrCompositorSubmit_
x_aY6O)
x_aY6P
Through some black magic that isn’t important to understand, ivrCompositorSubmit
emulates a call to ivrCompositorSubmit_
with its first two arguments supplied.
In conclusion, the following calls to vr::IVRCompositor::Submit(..)
are all three equivalent to each other.
ivrCompositorSubmit ..
ivrCompositorSubmit_ IVRCompositorVTable globalIVRCompositorIntance ..
globalIVRCompositorInstance->Submit(..)
In *.cabal
or package.yaml
, add
ghc-options: -ddump-splices
After building, stack generates *.dump-*
files inside .stack-work
, which can be retrieved via
$ find . -name "*.dump-*"
Setting this option also causes TH splices to be displayed first thing to the console when launching stack ghci
.
*OpenVR.Interface> :set -ddump-splices
*OpenVR.Interface> :l src/OpenVR/Interface.hs -- this will dump the splices of Interface.hs to the REPL
Consider a snippet from simula-openvr
:
parseOpenVRJSON "openvr/headers/openvr_api.json"
Noting that parseOpenVRJSON :: FilePath -> Q [Dec]
, it is not clear what this expands to. To solve the problem, open up a GHCi in simula-openvr
and add the following helper function:
*OpenVR.TH OpenVR OpenVR.Interface OpenVR.Internal OpenVR.TH> :{
printDecs decs = do
expr <- runQ decs
putStrLn $ pprint expr
:}
This allows us to take a term of type Q [Dec]
and pretty print it to the GHCi REPL. In particular, we can use it on parseOpenVRJSON
:
> printDecs $ parseOpenVRJSON "openvr/headers/openvr_api.json"
-- ...output...
https://en.wikipedia.org/wiki/Virtual_method_table
Ok so in `openvr.h` we have:
class COpenVRContext
{
public:
//...
IVRSystem *VRSystem()
{
CheckClear();
if ( m_pVRSystem == nullptr )
{
EVRInitError eError;
m_pVRSystem = ( IVRSystem * )VR_GetGenericInterface( IVRSystem_Version, &eError );
}
return m_pVRSystem;
}
//...
};
Here, `VRSystem()` is a method that takes no arguments and returns a `IVRSystem *`. But you’re saying this is actually a `this` pointer, which is a vpointer of an instance of a `IVRCompositor`?