haskell-debug-adapter 0.0.32.0 → 0.0.33.0

raw patch · 10 files changed

+166/−152 lines, 10 filesdep +optparse-applicativedep −cmdargsdep ~ghci-dapPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: optparse-applicative

Dependencies removed: cmdargs

Dependency ranges changed: ghci-dap

API changes (from Hackage documentation)

Files

• Changelog.md +4/−0
• app/Haskell/Debug/Adapter/Argument.hs +0/−46
• app/Haskell/Debug/Adapter/Main.hs +0/−30
• app/Main.hs +60/−6
• haskell-debug-adapter.cabal +8/−10
• src/Haskell/Debug/Adapter/Control.hs +39/−43
• src/Haskell/Debug/Adapter/GHCi.hs +19/−9
• src/Haskell/Debug/Adapter/State/Init/Launch.hs +2/−0
• src/Haskell/Debug/Adapter/Type.hs +28/−0
• test/Haskell/Debug/Adapter/ControlSpec.hs +6/−8

@@ -1,3 +1,7 @@+20200209 haskell-debug-adapter-0.0.33.0+  * [INFO] support ghci-dap-0.0.14.0.++ 20200105 haskell-debug-adapter-0.0.32.0   * [INFO] support haskell-dap-0.0.14.0.   * [INFO] support ghci-dap-0.0.13.0.

@@ -1,46 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-cse #-}--module Haskell.Debug.Adapter.Argument (-  setting-) where--import Paths_haskell_debug_adapter (version)-import Data.Version (showVersion)-import System.Console.CmdArgs--import Haskell.Debug.Adapter.Control---- |---  Annotation Setting----setting :: ArgData-setting = modes [mode]-  &= summary summaryMsg-  &= program "haskell-debug-adapter"-         -  where-    mode = ArgData {-        _hackageVersionArgData = showVersion version-          &= name "hackage-version"-          &= typ "VERSION"-          &= explicit-          &= help "hackage module version."-      } &= name "Mode"-        &= details detailMsg-        &= auto--    summaryMsg = unlines [-        ""-      , "VERSION: haskell-debug-adapter-" ++ showVersion version-      , ""-      ]-           -    detailMsg = [-        ""-      , "  DESCRIPTION: ... "-      , ""-      , "     Please see README.md"-      , ""-      ]-

@@ -1,30 +0,0 @@-module Haskell.Debug.Adapter.Main (run) where--import qualified System.IO as S-import qualified Control.Exception.Safe as E--import qualified Haskell.Debug.Adapter.Control as CTRL------ |---  Application Main--- -run :: CTRL.ArgData -> IO Int-run args = flip E.catchAny ehdl $ do--  -- run logic main-  flip E.finally finalize $ CTRL.run args S.stdin S.stdout--  where-    finalize = return () -    ehdl e   = putStrLn (criticalMsg e) >> return 1--    criticalMsg e = unlines [-        ""-      , "[CRITICAL] unexpected error. exit 1."-      , "--------------------------------------------------------------------------------"-      , show e-      , "--------------------------------------------------------------------------------"-      ]-

@@ -1,17 +1,71 @@ module Main where  import System.Exit-import qualified Haskell.Debug.Adapter.Main as M+import System.IO+import Control.Exception.Safe+import Data.Default+import Options.Applicative+import Paths_haskell_debug_adapter (version)+import Data.Version (showVersion) -import qualified Haskell.Debug.Adapter.Argument as A-import qualified System.Console.CmdArgs as CMD+import Haskell.Debug.Adapter.Control + -- | --  Main -- main :: IO ()-main = CMD.cmdArgs A.setting >>= M.run >>= \case-  0 -> exitSuccess-  c -> exitWith . ExitFailure $ c+main = getArgs >>= \args -> do+       flip catchAny exception+     $ flip finally  finalize+     $ run args stdin stdout +  where+    finalize = return ()+    exception e = print e >> exitFailure+++-------------------------------------------------------------------------------+-- |+--   optparse-applicative+--+getArgs :: IO ArgData+getArgs = execParser parseInfo++-- |+--+parseInfo :: ParserInfo ArgData+parseInfo = info options $ mconcat+  [ fullDesc+  , header ""+  , footer ""+  , progDesc "Please see README.md"+  ]++-- |+--+options :: Parser ArgData+options = (<*>) helper+  $ def+  <$> verOption+  <*> hackageOption++-- |+--+verOption :: Parser (a -> a)+verOption = infoOption msg $ mconcat+  [ short 'v'+  , long  "version"+  , help  "Show version"+  ]+  where+    msg = "haskell-debug-adapter-" ++ showVersion version++-- |+--+hackageOption :: Parser (Maybe String)+hackageOption = optional $ strOption $ mconcat+  [ long "hackage-version"+  , help "hackage version"+  ] 

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 68d1bb0d01048b286f46f92073a82bbfcd7882495077f4853d74f88246cdf8c2+-- hash: da77e0a33d754f6f5d7c7f1c43908127b950c2399a352febb7a7d8203d324a5d  name:           haskell-debug-adapter-version:        0.0.32.0+version:        0.0.33.0 synopsis:       Haskell Debug Adapter. description:    Please see README.md category:       Development@@ -68,7 +68,6 @@     , base >=4.7 && <5     , bytestring     , clock-    , cmdargs     , conduit     , conduit-extra     , containers@@ -76,11 +75,12 @@     , directory     , filepath     , fsnotify-    , ghci-dap >=0.0.13.0+    , ghci-dap >=0.0.14.0     , haskell-dap >=0.0.14.0     , hslogger     , lens     , mtl+    , optparse-applicative     , parsec     , process     , resourcet@@ -93,8 +93,6 @@ executable haskell-debug-adapter   main-is: Main.hs   other-modules:-      Haskell.Debug.Adapter.Argument-      Haskell.Debug.Adapter.Main       Paths_haskell_debug_adapter   hs-source-dirs:       app@@ -107,7 +105,6 @@     , base >=4.7 && <5     , bytestring     , clock-    , cmdargs     , conduit     , conduit-extra     , containers@@ -115,12 +112,13 @@     , directory     , filepath     , fsnotify-    , ghci-dap >=0.0.13.0+    , ghci-dap >=0.0.14.0     , haskell-dap >=0.0.14.0     , haskell-debug-adapter     , hslogger     , lens     , mtl+    , optparse-applicative     , parsec     , process     , resourcet@@ -148,7 +146,6 @@     , base >=4.7 && <5     , bytestring     , clock-    , cmdargs     , conduit     , conduit-extra     , containers@@ -156,13 +153,14 @@     , directory     , filepath     , fsnotify-    , ghci-dap >=0.0.13.0+    , ghci-dap >=0.0.14.0     , haskell-dap >=0.0.14.0     , haskell-debug-adapter     , hslogger     , hspec     , lens     , mtl+    , optparse-applicative     , parsec     , process     , resourcet

@@ -1,63 +1,60 @@-{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -module Haskell.Debug.Adapter.Control where+module Haskell.Debug.Adapter.Control (+    ArgData(..)+  , run+  ) where  import System.IO-import Data.Data-import Data.Default-import Control.Lens-import Data.Aeson.TH import qualified System.Log.Logger as L import qualified Control.Exception.Safe as E import Control.Concurrent.Async +import Haskell.Debug.Adapter.Type import Haskell.Debug.Adapter.Constant---import Haskell.Debug.Adapter.Type---import Haskell.Debug.Adapter.Logger import qualified Haskell.Debug.Adapter.Application as A import qualified Haskell.Debug.Adapter.Request as RQ import qualified Haskell.Debug.Adapter.Response as RP import qualified Haskell.Debug.Adapter.Thread as TD import qualified Haskell.Debug.Adapter.Watch as W-import Haskell.Debug.Adapter.TH.Utility  ------------------------------------------------------------------------------------ | Command Line Argument Data Type.----data ArgData = ArgData {-    _hackageVersionArgData :: String     -- ^hackage library version.-  } deriving (Data, Typeable, Show, Read, Eq)--makeLenses ''ArgData-$(deriveJSON-  defaultOptions {-      fieldLabelModifier = fieldModifier "ArgData"-    }-  ''ArgData)- -- |---   default value instance.+--   Start HDA.+--   Default implementation is using STDIN/STDOUT handle. ---instance Default ArgData where-  def = ArgData {-        _hackageVersionArgData = ""-      }----- |---   start running HDA.+--   Here is an example for using TCP Socket. ---run :: ArgData   -- ^command line arguments type.-    -> Handle    -- ^IN handle. used to get request from debug adapter client.-    -> Handle    -- ^OUT handle. used to response to debug adapter client.-    -> IO Int    -- ^Exit code.+-- > import Network.Socket+-- >+-- > sock <- socket AF_INET Stream defaultProtocol+-- > let host = tupleToHostAddress (0, 0, 0, 0)+-- >     port = 9999+-- >     reqQ = 5+-- >+-- > bind sock $ SockAddrInet port host+-- > listen sock reqQ+-- >+-- > (conn, _) <- accept sock+-- > hdl <- socketToHandle conn ReadWriteMode+-- >+-- > run def hdl hdl+-- >+--+--   Port 9999 could be specified in the launch.json with "debugServer" attribute.+--+-- > "debugServer : 9999"+--+run :: ArgData -- ^command line arguments.+    -> Handle  -- ^IN handle. used to get request from the debug adapter client.+    -> Handle  -- ^OUT handle. used to response to the debug adapter client.+    -> IO () run _ inHdl outHdl = E.bracket initialize finalize go    where     -- |-    -- +    --     initialize = do       L.debugM _LOG_NAME $ "initialize called." @@ -76,19 +73,18 @@       L.removeAllHandlers      -- |-    -- +    --     go appData = do        L.debugM _LOG_NAME $ "start thread manager."        let ths = [-                  RQ.run appData-                , A.run appData-                , RP.run appData-                , W.run appData+                  RQ.run appData    -- request handler+                , A.run  appData    -- main app+                , RP.run appData    -- response handler+                , W.run  appData    -- file watch                 ]        TD.start appData ths >>= wait -      return 0 

@@ -88,7 +88,7 @@     getReadHandleEncoding :: IO TextEncoding     getReadHandleEncoding = if       | Windows == buildOS -> mkTextEncoding "CP932//TRANSLIT"-      | otherwise -> mkTextEncoding "UTF-8//TRANSLIT"+      | otherwise          -> mkTextEncoding "UTF-8//TRANSLIT"      -- |     --@@ -125,20 +125,30 @@   proc <- U.liftIOE $ readMVar mvar   let hdl = proc^.rHdlGHCiProc -  xs <- go pmpt hdl ""--  let strs = map U.rstrip $ lines xs-  pout strs-  return strs+  go pmpt hdl "" >>= \case+    Right xs -> do+      let strs = map U.rstrip $ lines xs+      pout strs+      return strs+    Left xs -> do+      let strs = map U.rstrip $ lines xs+      pout strs+      throwError "[CRITICAL] can not get the initial ghci prompt."    where-    go key hdl acc = U.readChar hdl-                >>= byPmpt key hdl acc+    go :: String -> S.Handle -> String -> AppContext (Either String String)+    go key hdl acc = catchError+      (U.readChar hdl >>= byPmpt key hdl acc)+      (errHdl acc) +    errHdl :: String -> String -> AppContext (Either String String)+    errHdl acc e = return $ Left $ unlines [acc, "", e, ""]++    byPmpt :: String -> S.Handle -> String -> String -> AppContext (Either String String)     byPmpt key hdl acc b = do       let newAcc = acc ++ b       if L.isSuffixOf key newAcc-        then return newAcc+        then return $ Right newAcc         else go key hdl newAcc      pout [] = return ()

@@ -193,6 +193,8 @@   U.sendConsoleEventLF ""    P.startGHCi cmd opts cwd envs+  U.sendErrorEventLF $ "Now, waiting for an initial prompt(\""++initPmpt++"\")" ++ " from ghci."+  U.sendConsoleEventLF ""   res <- P.expectInitPmpt initPmpt    updateGHCiVersion res

@@ -6,6 +6,7 @@  module Haskell.Debug.Adapter.Type where +import Data.Data import Data.Default import Control.Lens import Data.Aeson@@ -24,7 +25,34 @@ import Haskell.Debug.Adapter.TH.Utility import Haskell.Debug.Adapter.Constant + --------------------------------------------------------------------------------+-- | Command Line Argument Data Type.+--+data ArgData = ArgData {+    _hackageVersionArgData :: Maybe String   -- ^deprecated.+  } deriving (Data, Typeable, Show, Read, Eq)++makeLenses ''ArgData+$(deriveJSON+  defaultOptions {+      fieldLabelModifier = fieldModifier "ArgData"+    }+  ''ArgData)+++-- |+--   default value instance.+--+instance Default ArgData where+  def = ArgData {+        _hackageVersionArgData = Nothing+      }+++--------------------------------------------------------------------------------+-- |+-- instance FromJSON  L.Priority  where   parseJSON (String v) = pure $ read $ T.unpack v   parseJSON o = error $ "json parse error. Priority:" ++ show o

@@ -4,7 +4,6 @@  import Test.Hspec import Data.Aeson-import Data.Default import Control.Concurrent (threadDelay) import qualified System.IO as S import Control.Concurrent.Async@@ -26,7 +25,7 @@     $ spec'    where-  +     beforeAll' :: IO ()     beforeAll' = do       return ()@@ -40,22 +39,21 @@      after' :: IO ()     after' = return ()-     +     spec' :: Spec     spec' = do       describe "run" $ do-        context "when default args" $ -          xit "should be 0" $ do-            let arg  = def+        context "ok" $+          xit "should be ()" $ do             (fromClient, toClient) <- createPipe             (fromServer, toServer) <- createPipe              (res, _) <- runConcurrently $ (,)-              <$> Concurrently (run arg fromClient toClient)+              <$> Concurrently (run fromClient toClient)               <*> Concurrently (client toServer) -            res `shouldBe` 0+            res `shouldBe` ()              S.hClose fromClient             S.hClose toClient