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

Author: csabahruska

.gitignore

@@ -7,6 +7,7 @@ npm-debug.log
 mock-debug.txt
 *.vsix
 .DS_Store
+dap-extension/package-lock.json
 
 # haskell
 stack.yaml.lock

dap/cabal.project cabal.projectdap/cabal.project renamed to cabal.project

@@ -1,4 +1,4 @@
-packages: .
+packages: dap dap-estgi-server
 
 source-repository-package
     type: git
@@ -8,7 +8,7 @@ source-repository-package
 source-repository-package
     type: git
     location: https://github.com/grin-compiler/ghc-whole-program-compiler-project
-    tag: 9d7a96a0b831f980d8c9d5a30a9185b64fbbfa31
+    tag: 80e408ebdeaf5c1cea72bfbf86823c32d4fdafbe
     subdir:
       external-stg
       external-stg-syntax

dap-estgi-server/CHANGELOG.md

@@ -0,0 +1,5 @@
+# Revision history for dap
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

dap-estgi-server/LICENSE

@@ -0,0 +1,10 @@
+Copyright (c) 2023, David M. Johnson
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
+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.
+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.
+
+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.

dap-estgi-server/dap-estgi-server.cabal

@@ -0,0 +1,50 @@
+name:               dap-estgi-server
+version:            0.1.0.0
+description:        Debug Adaptor Protocol (DAP) implementation for External STG Interpreter
+synopsis:           Debug adaptor protocol implementation for ESTGi
+bug-reports:        https://github.com/dap/issues
+license:            BSD3
+license-file:       LICENSE
+author:             David Johnson
+maintainer:         djohnson.m@gmail.com
+copyright:          (c) 2023 David Johnson
+category:           Debuggers, Language
+build-type:         Simple
+tested-with:        GHC==9.2.4
+cabal-version:      >= 1.10
+
+extra-source-files:
+  CHANGELOG.md
+
+executable dap-estgi
+  main-is:
+    Main.hs
+  ghc-options:
+    -threaded
+  build-depends:
+      ansi-wl-pprint
+    , base < 5
+    , containers
+    , dap
+    , bytestring
+    , external-stg-interpreter
+    , external-stg-syntax
+    , external-stg
+    , filepath
+    , filemanip
+    , lifted-base
+    , network
+    , unagi-chan
+    , unordered-containers
+    , string-conversions
+    , aeson
+    , text
+    , time
+    , mtl
+    , yaml
+    , zip
+    , bimap
+  hs-source-dirs:
+    src
+  default-language:
+    Haskell2010

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

@@ -51,12 +51,13 @@ import           Data.Maybe                            ( fromMaybe )
 import           Data.List                             ( sortOn )
 import           GHC.Generics                          ( Generic )
 import           System.Environment                    ( lookupEnv )
-import           System.FilePath                       ((</>), takeDirectory, takeExtension, dropExtension, splitFileName)
+import           System.FilePath                       ( (-<.>), (</>), takeDirectory, takeExtension, dropExtension, splitFileName, splitPath, joinPath)
 import           Text.Read                             ( readMaybe )
 import qualified Data.ByteString.Lazy.Char8            as BL8 ( pack, unpack, fromStrict, toStrict )
 import qualified Control.Concurrent.Chan.Unagi.Bounded as Unagi
 import           Control.Concurrent.MVar               ( MVar )
 import qualified Control.Concurrent.MVar               as MVar
+import qualified System.FilePath.Find                  as Glob
 ----------------------------------------------------------------------------
 import           Stg.Syntax                            hiding (sourceName, Scope)
 import           Stg.IRLocation
@@ -69,6 +70,7 @@ import           Stg.Interpreter.Debugger
 import           Stg.Interpreter.Debugger.UI
 import           Stg.IO
 import           Stg.Program
+import           Stg.Fullpak
 import           Data.Yaml                             hiding (Array)
 ----------------------------------------------------------------------------
 import           DAP                                   hiding (send)
@@ -113,17 +115,17 @@ getConfig = do
 -- >      "__configurationTarget": 6,
 -- >      "__sessionId": "6c0ba6f8-e478-4698-821e-356fc4a72c3d",
 -- >      "name": "thing",
--- >      "program": "/home/dmjio/Desktop/stg-dap/test.fullpak",
+-- >      "program": "/home/dmjio/Desktop/stg-dap/test.ghc_stgapp",
 -- >      "request": "attach",
--- >      "type": "dap-extension"
+-- >      "type": "dap-estgi-extension"
 -- >  }
 --
 data AttachArgs
   = AttachArgs
   { __sessionId :: Text
     -- ^ SessionID from VSCode
   , program :: String
-    -- ^ Path to .fullpak file
+    -- ^ Path or glob pattern to .ghc_stgapp file
   } deriving stock (Show, Eq, Generic)
     deriving anyclass FromJSON
 ----------------------------------------------------------------------------
@@ -153,12 +155,25 @@ data ESTG
     -- ^ monotinic counter for unique BreakpointId assignment
     --
   }
+
+findProgram :: String -> IO [FilePath]
+findProgram globPattern = do
+  let isPattern = any (`elem` ("[*?" :: String))
+      startDir = joinPath . takeWhile (not . isPattern) . splitPath $ takeDirectory globPattern
+  Glob.find Glob.always (Glob.filePath Glob.~~? globPattern) startDir
+
 ----------------------------------------------------------------------------
 -- | Intialize ESTG interpreter
 ----------------------------------------------------------------------------
 initESTG :: AttachArgs -> Adaptor ESTG ()
 initESTG AttachArgs {..} = do
-  moduleInfos <- liftIO $ getModuleListFromFullPak program
+  ghcstgappPath <- (liftIO $ findProgram program) >>= \case
+    [fname] -> pure fname
+    []      -> sendError (ErrorMessage (T.pack $ unlines ["No .ghc_stgapp program found at:", program])) Nothing
+    names   -> sendError (ErrorMessage (T.pack $ unlines $ ["Ambiguous program path:", program, "Use more specific path pattern to fix the issue.", "Multiple matches:"] ++ names)) Nothing
+  let fullpakPath = ghcstgappPath -<.> ".fullpak"
+  liftIO $ mkFullpak ghcstgappPath False False fullpakPath
+  moduleInfos <- liftIO $ getModuleListFromFullPak fullpakPath
   (dbgAsyncI, dbgAsyncO) <- liftIO (Unagi.newChan 100)
   dbgRequestMVar <- liftIO MVar.newEmptyMVar
   dbgResponseMVar <- liftIO MVar.newEmptyMVar
@@ -170,7 +185,7 @@ initESTG AttachArgs {..} = do
         }
       estg = ESTG
         { debuggerChan          = dbgChan
-        , fullPakPath           = program
+        , fullPakPath           = fullpakPath
         , moduleInfoMap         = M.fromList [(cs $ qualifiedModuleName mi, mi) | mi <- moduleInfos]
         , breakpointMap         = mempty
         , dapSourceRefMap       = Bimap.empty
@@ -181,7 +196,7 @@ initESTG AttachArgs {..} = do
         }
   flip catch handleDebuggerExceptions
     $ registerNewDebugSession __sessionId estg
-      (loadAndRunProgram True True program [] dbgChan DbgStepByStep False defaultDebugSettings)
+      (loadAndRunProgram True True fullpakPath [] dbgChan DbgStepByStep False defaultDebugSettings)
       (handleDebugEvents dbgChan)
 
 ----------------------------------------------------------------------------