Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit 6927d5d

Browse files
committed
- Update cabal file
- Fix bugs in JSON serialization / parsing - Implement more protocol commands
1 parent 6dbc72e commit 6927d5d

File tree

10 files changed

+458
-91
lines changed

10 files changed

+458
-91
lines changed

‎.gitignore‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -39,3 +39,6 @@ main
3939

4040
# tags
4141
tags
42+
43+
# external-stg-interpreter
44+
.ext-stg-work

‎dap/dap.cabal‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -23,9 +23,12 @@ executable dap
2323
-threaded
2424
build-depends:
2525
base < 5
26+
, containers
2627
, dap
2728
, bytestring
2829
, external-stg-interpreter
30+
, external-stg-syntax
31+
, external-stg
2932
, lifted-base
3033
, network
3134
, unagi-chan
@@ -34,6 +37,7 @@ executable dap
3437
, text
3538
, time
3639
, mtl
40+
, yaml
3741
hs-source-dirs:
3842
exe
3943
default-language:

‎dap/exe/Main.hs‎

Lines changed: 385 additions & 46 deletions
Large diffs are not rendered by default.

‎dap/hello/.vscode/launch.json‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@
77
{
88
"type": "dap-extension",
99
"request": "attach",
10-
"program": "${workspaceFolder}/test.fullpak",
10+
"program": "${workspaceFolder}/hello-macos.fullpak",
1111
"name": "hello"
1212
}
1313
]

‎dap/hello/stack.yaml‎

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
resolver: lts-20.18
2+
3+
packages:
4+
- '.'
5+
6+
apply-ghc-options:
7+
everything
8+
9+
ghc-options:
10+
"$everything":
11+
-fplugin-trustworthy
12+
-fplugin-library=../result/lib/libwpc-plugin.dylib;wpc-plugin-unit;WPC.Plugin;[]
13+
14+
# -fplugin-libary=-lwpc-plugin -fplugin=WPC.Plugin -optl-Wl,-rpath,-lwpc-plugin

‎dap/src/DAP/Adaptor.hs‎

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,7 @@ module DAP.Adaptor
2626
, getArguments
2727
, registerNewDebugSession
2828
, withDebugSession
29+
, getDebugSession
2930
, getDebugSessionId
3031
, destroyDebugSession
3132
-- * Logging
@@ -142,6 +143,19 @@ registerNewDebugSession k v action = do
142143
setDebugSessionId k
143144
logInfo $ BL8.pack $ "Registered new debug session: " <> unpack k
144145
----------------------------------------------------------------------------
146+
getDebugSession :: AdaptorClient app app
147+
getDebugSession = do
148+
getDebugSessionId >>= \case
149+
Nothing -> error "oops fix me"
150+
Just sessionId -> do
151+
appStore <- liftIO . readTVarIO =<< getAppStore
152+
case H.lookup sessionId appStore of
153+
Nothing ->
154+
error "oops fix me"
155+
Just (_, state) ->
156+
pure state
157+
158+
----------------------------------------------------------------------------
145159
withDebugSession :: (app -> AdaptorClient app ()) -> AdaptorClient app ()
146160
withDebugSession continuation = do
147161
getDebugSessionId >>= \case

‎dap/src/DAP/Types.hs‎

Lines changed: 30 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -71,6 +71,7 @@ module DAP.Types
7171
, StartMethod (..)
7272
, EvaluateArgumentsContext (..)
7373
, PathFormat (..)
74+
, StackFrame (..)
7475
-- * Command
7576
, Command (..)
7677
-- * Event
@@ -397,13 +398,13 @@ data Source
397398
-- has a name.
398399
-- When sending a source to the debug adapter this name is optional.
399400
--
400-
, sourcePath :: Text
401+
, sourcePath :: MaybeText
401402
-- ^
402403
-- The path of the source to be shown in the UI.
403404
-- It is only used to locate and load the content of the source if no
404405
-- `sourceReference` is specified (or its value is 0).
405406
--
406-
, sourceReference :: Maybe Int
407+
, sourceSourceReference :: Maybe Int
407408
-- ^
408409
-- If the value > 0 the contents of the source must be retrieved through the
409410
-- `source` request (even if a path is specified).
@@ -423,18 +424,18 @@ data Source
423424
-- The origin of this source. For example, 'internal module', 'inlined content
424425
-- from source map', etc.
425426
--
426-
, sourceSources :: [Source]
427+
, sourceSources :: Maybe[Source]
427428
-- ^
428429
-- A list of sources that are related to this source. These may be the source
429430
-- that generated this source.
430431
--
431-
, sourceAdapterData :: Value
432+
, sourceAdapterData :: MaybeValue
432433
-- ^
433434
-- Additional data that a debug adapter might want to loop through the client.
434435
-- The client should leave the data intact and persist it across sessions. The
435436
-- client should not interpret the data.
436437
--
437-
, sourceChecksums :: [Checksum]
438+
, sourceChecksums :: Maybe[Checksum]
438439
-- ^
439440
-- The checksums associated with this file.
440441
--
@@ -517,7 +518,7 @@ data StackFrame
517518
-- ^
518519
-- The name of the stack frame, typically a method name.
519520
--
520-
, stackFrameSource :: Source
521+
, stackFrameSource :: MaybeSource
521522
-- ^
522523
-- The source of the frame.
523524
--
@@ -613,23 +614,23 @@ defaultCapabilities = capabilities
613614
, supportsEvaluateForHovers = False
614615
, exceptionBreakpointFilters = []
615616
, supportsStepBack = False
616-
, supportsSetVariable = False
617+
, supportsSetVariable = True
617618
, supportsRestartFrame = False
618619
, supportsGotoTargetsRequest = False
619620
, supportsStepInTargetsRequest = False
620621
, supportsCompletionsRequest = False
621622
, completionTriggerCharacters = []
622-
, supportsModulesRequest = False
623+
, supportsModulesRequest = True
623624
, additionalModuleColumns = []
624625
, supportedChecksumAlgorithms = []
625626
, supportsRestartRequest = False
626627
, supportsExceptionOptions = False
627-
, supportsValueFormattingOptions = False
628+
, supportsValueFormattingOptions = True
628629
, supportsExceptionInfoRequest = False
629630
, supportTerminateDebuggee = False
630631
, supportSuspendDebuggee = False
631632
, supportsDelayedStackTraceLoading = False
632-
, supportsLoadedSourcesRequest = False
633+
, supportsLoadedSourcesRequest = True
633634
, supportsLogPoints = False
634635
, supportsTerminateThreadsRequest = False
635636
, supportsSetExpression = False
@@ -1230,7 +1231,7 @@ data Scope
12301231
-- ^
12311232
-- The source for this scope.
12321233
--
1233-
, line :: Int
1234+
, line :: MaybeInt
12341235
-- ^
12351236
-- The start line of the range covered by this scope.
12361237
--
@@ -1257,7 +1258,7 @@ instance ToJSON Scope where
12571258
= object
12581259
[ "name" .= scopeName
12591260
, "presentationHint" .= presentationHint
1260-
, "variableReference" .= variablesReference
1261+
, "variablesReference" .= variablesReference
12611262
, "namedVariables" .= namedVariables
12621263
, "indexedVariables" .= indexedVariables
12631264
, "expensive" .= expensive
@@ -1313,7 +1314,7 @@ data Variable
13131314
-- This attribute should only be returned by a debug adapter if the
13141315
-- corresponding capability `supportsVariableType` is true.
13151316
--
1316-
, variablePresentationHint :: VariablePresentationHint
1317+
, variablePresentationHint :: MaybeVariablePresentationHint
13171318
-- ^
13181319
-- Properties of a variable that can be used to determine how to render the
13191320
-- variable in the UI.
@@ -1323,7 +1324,7 @@ data Variable
13231324
-- The evaluatable name of this variable which can be passed to the `evaluate`
13241325
-- request to fetch the variable's value.
13251326
--
1326-
, variableReference :: Int
1327+
, variableVariablesReference :: Int
13271328
-- ^
13281329
-- If `variablesReference` is > 0, the variable is structured and its children
13291330
-- can be retrieved by passing `variablesReference` to the `variables` request
@@ -1349,20 +1350,20 @@ data Variable
13491350
-- This attribute is only required if the corresponding capability
13501351
-- `supportsMemoryReferences` is true.
13511352
--
1352-
} deriving stock (Show, Eq)
1353+
} deriving stock (Show, Eq, Generic)
13531354
----------------------------------------------------------------------------
13541355
instance ToJSON Variable where
1355-
toJSON Variable {..}
1356-
= object
1357-
[ "value" .= variableValue
1358-
, "type" .= variableType
1359-
, "presentationHint" .= variablePresentationHint
1360-
, "evaluateName" .= variableEvaluateName
1361-
, "reference" .= variableReference
1362-
, "namedVariables" .= variableNamedVariables
1363-
, "IndexedVariables" .= variableIndexedVariables
1364-
, "memoryReference" .= variableMemoryReference
1365-
]
1356+
toJSON = genericToJSONWithModifier
1357+
--= object
1358+
--[ "value" .= variableValue
1359+
--, "type" .= variableType
1360+
--, "presentationHint" .= variablePresentationHint
1361+
--, "evaluateName" .= variableEvaluateName
1362+
--, "reference" .= variablesReference
1363+
--, "namedVariables" .= variableNamedVariables
1364+
--, "IndexedVariables" .= variableIndexedVariables
1365+
--, "memoryReference" .= variableMemoryReference
1366+
--]
13661367
----------------------------------------------------------------------------
13671368
data VariablePresentationHint
13681369
= VariablePresentationHint
@@ -3159,7 +3160,7 @@ data NextArguments
31593160
-- Specifies the thread for which to resume execution for one step (of the
31603161
-- given granularity).
31613162
--
3162-
, nextArgumentsSingleThread :: Bool
3163+
, nextArgumentsSingleThread :: MaybeBool
31633164
-- ^
31643165
-- If this flag is true, all other suspended threads are not resumed.
31653166
--
@@ -3385,13 +3386,13 @@ instance FromJSON VariablesFilter where
33853386
----------------------------------------------------------------------------
33863387
data VariablesArguments
33873388
= VariablesArguments
3388-
{ variablesArgumentsReference :: Int
3389+
{ variablesArgumentsVariablesReference :: Int
33893390
-- ^
33903391
-- The variable for which to retrieve its children. The `variablesReference`
33913392
-- must have been obtained in the current suspended state. See 'Lifetime of
33923393
-- Object References' in the Overview section for details.
33933394
--
3394-
, variablesArgumentsFilter :: Maybe VariablesArguments
3395+
, variablesArgumentsFilter :: Maybe VariablesFilter
33953396
-- ^
33963397
-- Filter to limit the child variables to either named or indexed. If omitted,
33973398
-- both types are fetched.

‎dap/src/DAP/Utils.hs‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ import GHC.Generics (Generic, Rep)
2222
import Data.Aeson ( ToJSON(toJSON), Value, fieldLabelModifier
2323
, genericToJSON, genericParseJSON, fieldLabelModifier
2424
, defaultOptions, GToJSON, GFromJSON, Zero, Options
25-
, constructorTagModifier
25+
, constructorTagModifier, sumEncoding, SumEncoding(UntaggedValue), omitNothingFields
2626
)
2727
import Data.Aeson.Types ( Parser )
2828
import Data.Aeson.Encode.Pretty ( encodePretty )
@@ -104,6 +104,8 @@ genericToJSONWithModifier
104104
= genericToJSON defaultOptions
105105
{ fieldLabelModifier = modifier (Proxy @a)
106106
, constructorTagModifier = modifier (Proxy @a)
107+
, sumEncoding = UntaggedValue
108+
, omitNothingFields = True
107109
}
108110
----------------------------------------------------------------------------
109111
-- | Used as a fieldLabelModifier when generating aeson parsers
@@ -117,6 +119,8 @@ genericParseJSONWithModifier
117119
= genericParseJSON defaultOptions
118120
{ fieldLabelModifier = modifier (Proxy @a)
119121
, constructorTagModifier = modifier (Proxy @a)
122+
, sumEncoding = UntaggedValue
123+
, omitNothingFields = True
120124
}
121125
----------------------------------------------------------------------------
122126
-- | Log formatting util

‎dap/stack.yaml‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@ resolver: lts-20.18
22

33
packages:
44
- '.'
5+
- 'ghc-whole-program-compiler-project/external-stg-interpreter'
56

67
extra-deps:
78
- souffle-haskell-3.4.0
@@ -16,7 +17,7 @@ extra-deps:
1617
subdirs:
1718
- external-stg
1819
- external-stg-syntax
19-
- external-stg-interpreter
20+
#- external-stg-interpreter
2021

2122
flags:
2223
digest:

‎dap/stack.yaml.lock‎

Lines changed: 0 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -62,19 +62,6 @@ packages:
6262
commit: 9d7a96a0b831f980d8c9d5a30a9185b64fbbfa31
6363
git: https://github.com/grin-compiler/ghc-whole-program-compiler-project
6464
subdir: external-stg-syntax
65-
- completed:
66-
commit: 9d7a96a0b831f980d8c9d5a30a9185b64fbbfa31
67-
git: https://github.com/grin-compiler/ghc-whole-program-compiler-project
68-
name: external-stg-interpreter
69-
pantry-tree:
70-
sha256: d296571bee5b9ce9e7bb3c4f63b59bd1077a1f90881d9e3524e11017fefdcc2a
71-
size: 6662
72-
subdir: external-stg-interpreter
73-
version: 0.1.0.1
74-
original:
75-
commit: 9d7a96a0b831f980d8c9d5a30a9185b64fbbfa31
76-
git: https://github.com/grin-compiler/ghc-whole-program-compiler-project
77-
subdir: external-stg-interpreter
7865
snapshots:
7966
- completed:
8067
sha256: 9fa4bece7acfac1fc7930c5d6e24606004b09e80aa0e52e9f68b148201008db9

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /