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 5bc64b7

Browse files
Dap estgi work (#14)
* fix dap-estgi extension launch.json template ; use more descriptive name * adjust extension name to 'dap-estgi-extension' ; use glob pattern in 'launch.json' template * support glob patterns in input 'program' path ; use .ghc_stgapp yaml as input and create fullpak from it at init * separate dap-estgi-server from generic dap library * update vscode dap-esgi-extension docs * update stack.yaml and cabal.project to build the dap library and dap-estgi server * use sendError with descriptive error messages * docs improvements * update comments
1 parent 0f34b14 commit 5bc64b7

32 files changed

+189
-4281
lines changed

‎.gitignore‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@ npm-debug.log
77
mock-debug.txt
88
*.vsix
99
.DS_Store
10+
dap-extension/package-lock.json
1011

1112
# haskell
1213
stack.yaml.lock

‎dap/cabal.project‎ renamed to ‎cabal.project‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
packages: .
1+
packages: dap dap-estgi-server
22

33
source-repository-package
44
type: git
@@ -8,7 +8,7 @@ source-repository-package
88
source-repository-package
99
type: git
1010
location: https://github.com/grin-compiler/ghc-whole-program-compiler-project
11-
tag: 9d7a96a0b831f980d8c9d5a30a9185b64fbbfa31
11+
tag: 80e408ebdeaf5c1cea72bfbf86823c32d4fdafbe
1212
subdir:
1313
external-stg
1414
external-stg-syntax

‎dap-estgi-server/CHANGELOG.md‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
# Revision history for dap
2+
3+
## 0.1.0.0 -- YYYY-mm-dd
4+
5+
* First version. Released on an unsuspecting world.

‎dap-estgi-server/LICENSE‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
Copyright (c) 2023, David M. Johnson
2+
All rights reserved.
3+
4+
Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
5+
6+
1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
7+
2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
8+
3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
9+
10+
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
Lines changed: 50 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,50 @@
1+
name: dap-estgi-server
2+
version: 0.1.0.0
3+
description: Debug Adaptor Protocol (DAP) implementation for External STG Interpreter
4+
synopsis: Debug adaptor protocol implementation for ESTGi
5+
bug-reports: https://github.com/dap/issues
6+
license: BSD3
7+
license-file: LICENSE
8+
author: David Johnson
9+
maintainer: djohnson.m@gmail.com
10+
copyright: (c) 2023 David Johnson
11+
category: Debuggers, Language
12+
build-type: Simple
13+
tested-with: GHC==9.2.4
14+
cabal-version: >= 1.10
15+
16+
extra-source-files:
17+
CHANGELOG.md
18+
19+
executable dap-estgi
20+
main-is:
21+
Main.hs
22+
ghc-options:
23+
-threaded
24+
build-depends:
25+
ansi-wl-pprint
26+
, base < 5
27+
, containers
28+
, dap
29+
, bytestring
30+
, external-stg-interpreter
31+
, external-stg-syntax
32+
, external-stg
33+
, filepath
34+
, filemanip
35+
, lifted-base
36+
, network
37+
, unagi-chan
38+
, unordered-containers
39+
, string-conversions
40+
, aeson
41+
, text
42+
, time
43+
, mtl
44+
, yaml
45+
, zip
46+
, bimap
47+
hs-source-dirs:
48+
src
49+
default-language:
50+
Haskell2010

‎dap/exe/Main.hs‎ renamed to ‎dap-estgi-server/src/Main.hs‎

Lines changed: 22 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -51,12 +51,13 @@ import Data.Maybe ( fromMaybe )
5151
import Data.List ( sortOn )
5252
import GHC.Generics ( Generic )
5353
import System.Environment ( lookupEnv )
54-
import System.FilePath ((</>), takeDirectory, takeExtension, dropExtension, splitFileName)
54+
import System.FilePath ((-<.>), (</>), takeDirectory, takeExtension, dropExtension, splitFileName, splitPath, joinPath)
5555
import Text.Read ( readMaybe )
5656
import qualified Data.ByteString.Lazy.Char8 as BL8 ( pack, unpack, fromStrict, toStrict )
5757
import qualified Control.Concurrent.Chan.Unagi.Bounded as Unagi
5858
import Control.Concurrent.MVar ( MVar )
5959
import qualified Control.Concurrent.MVar as MVar
60+
import qualified System.FilePath.Find as Glob
6061
----------------------------------------------------------------------------
6162
import Stg.Syntax hiding (sourceName, Scope)
6263
import Stg.IRLocation
@@ -69,6 +70,7 @@ import Stg.Interpreter.Debugger
6970
import Stg.Interpreter.Debugger.UI
7071
import Stg.IO
7172
import Stg.Program
73+
import Stg.Fullpak
7274
import Data.Yaml hiding (Array)
7375
----------------------------------------------------------------------------
7476
import DAP hiding (send)
@@ -113,17 +115,17 @@ getConfig = do
113115
-- > "__configurationTarget": 6,
114116
-- > "__sessionId": "6c0ba6f8-e478-4698-821e-356fc4a72c3d",
115117
-- > "name": "thing",
116-
-- > "program": "/home/dmjio/Desktop/stg-dap/test.fullpak",
118+
-- > "program": "/home/dmjio/Desktop/stg-dap/test.ghc_stgapp",
117119
-- > "request": "attach",
118-
-- > "type": "dap-extension"
120+
-- > "type": "dap-estgi-extension"
119121
-- > }
120122
--
121123
data AttachArgs
122124
= AttachArgs
123125
{ __sessionId :: Text
124126
-- ^ SessionID from VSCode
125127
, program :: String
126-
-- ^ Path to .fullpak file
128+
-- ^ Path or glob pattern to .ghc_stgapp file
127129
} deriving stock (Show, Eq, Generic)
128130
deriving anyclass FromJSON
129131
----------------------------------------------------------------------------
@@ -153,12 +155,25 @@ data ESTG
153155
-- ^ monotinic counter for unique BreakpointId assignment
154156
--
155157
}
158+
159+
findProgram :: String -> IO [FilePath]
160+
findProgram globPattern = do
161+
let isPattern = any (`elem` ("[*?" :: String))
162+
startDir = joinPath . takeWhile (not . isPattern) . splitPath $ takeDirectory globPattern
163+
Glob.find Glob.always (Glob.filePath Glob.~~? globPattern) startDir
164+
156165
----------------------------------------------------------------------------
157166
-- | Intialize ESTG interpreter
158167
----------------------------------------------------------------------------
159168
initESTG :: AttachArgs -> Adaptor ESTG ()
160169
initESTG AttachArgs {..} = do
161-
moduleInfos <- liftIO $ getModuleListFromFullPak program
170+
ghcstgappPath <- (liftIO $ findProgram program) >>= \case
171+
[fname] -> pure fname
172+
[] -> sendError (ErrorMessage (T.pack $ unlines ["No .ghc_stgapp program found at:", program])) Nothing
173+
names -> sendError (ErrorMessage (T.pack $ unlines $ ["Ambiguous program path:", program, "Use more specific path pattern to fix the issue.", "Multiple matches:"] ++ names)) Nothing
174+
let fullpakPath = ghcstgappPath -<.> ".fullpak"
175+
liftIO $ mkFullpak ghcstgappPath False False fullpakPath
176+
moduleInfos <- liftIO $ getModuleListFromFullPak fullpakPath
162177
(dbgAsyncI, dbgAsyncO) <- liftIO (Unagi.newChan 100)
163178
dbgRequestMVar <- liftIO MVar.newEmptyMVar
164179
dbgResponseMVar <- liftIO MVar.newEmptyMVar
@@ -170,7 +185,7 @@ initESTG AttachArgs {..} = do
170185
}
171186
estg = ESTG
172187
{ debuggerChan = dbgChan
173-
, fullPakPath = program
188+
, fullPakPath = fullpakPath
174189
, moduleInfoMap = M.fromList [(cs $ qualifiedModuleName mi, mi) | mi <- moduleInfos]
175190
, breakpointMap = mempty
176191
, dapSourceRefMap = Bimap.empty
@@ -181,7 +196,7 @@ initESTG AttachArgs {..} = do
181196
}
182197
flip catch handleDebuggerExceptions
183198
$ registerNewDebugSession __sessionId estg
184-
(loadAndRunProgram True True program [] dbgChan DbgStepByStep False defaultDebugSettings)
199+
(loadAndRunProgram True True fullpakPath [] dbgChan DbgStepByStep False defaultDebugSettings)
185200
(handleDebugEvents dbgChan)
186201

187202
----------------------------------------------------------------------------
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.

0 commit comments

Comments
(0)

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