content: {-# LANGUAGE OverloadedStrings, OverloadedRecordDot, CPP, DeriveAnyClass, DeriveGeneric, DerivingVia, LambdaCase, RecordWildCards, ViewPatterns #-}
  module Main where
  
  import System.Environment
  import System.Process
  import Data.Maybe
  import Data.Aeson
  import Data.IORef
  import Text.Read
  import Control.Concurrent
  import Control.Monad
  import Control.Monad.IO.Class
  import Control.Monad.Except
  
  import DAP
  
  import Development.Debug.Adapter.Init
  import Development.Debug.Adapter.Breakpoints
  import Development.Debug.Adapter.Stepping
  import Development.Debug.Adapter.Stopped
  import Development.Debug.Adapter.Evaluation
  import Development.Debug.Adapter.Exit
  import Development.Debug.Adapter.Handles
  import GHC.Debugger.Logger
  import Prettyprinter
  
  import System.IO (hSetBuffering, BufferMode(LineBuffering))
  import qualified DAP.Log as DAP
  import qualified Data.Text as T
  import qualified Data.Text.IO as T
  import GHC.IO.Handle.FD
  
  import Development.Debug.Options (HdbOptions(..))
  import Development.Debug.Options.Parser (parseHdbOptions)
  import Development.Debug.Adapter
  import Development.Debug.Adapter.Proxy
  import Development.Debug.Interactive
  
  --------------------------------------------------------------------------------
  
  defaultStdoutForwardingAction :: T.Text -> IO ()
  defaultStdoutForwardingAction line = do
    T.hPutStrLn stderr ("[INTERCEPTED STDOUT] " <> line)
  
  main :: IO ()
  main = do
    hdbOpts <- parseHdbOptions
    let
      timeStampLogger  = cmapIO renderWithTimestamp . fromCologAction
      loggerWithSev    = cmap renderPrettyWithSeverity
      loggerFinal opts = applyVerbosity opts.verbosity . loggerWithSev . timeStampLogger
    case hdbOpts of
      HdbDAPServer{port} -> do
        config <- getConfig port
        withInterceptedStdoutForwarding defaultStdoutForwardingAction $ \realStdout -> do
          hSetBuffering realStdout LineBuffering
          l <- handleLogger realStdout
          let dapLogger = cmap DAP.renderDAPLog $ timeStampLogger l
          let runLogger = loggerFinal hdbOpts l
          init_var <- liftIO (newIORef False{-not supported by default-})
          pid_var  <- liftIO (newIORef Nothing)
          ccon_var <- liftIO newEmptyMVar
          runDAPServerWithLogger (toCologAction dapLogger) config
            (talk runLogger init_var pid_var ccon_var)
            (ack runLogger pid_var)
      HdbCLI{..} -> do
          l <- handleLogger stdout
          let runLogger = cmapWithSev InteractiveLog $ loggerFinal hdbOpts l
          runIDM runLogger entryPoint entryFile entryArgs extraGhcArgs $
            debugInteractive runLogger
      HdbProxy{port} -> do
          l <- handleLogger stdout
          let runLogger = cmapWithSev RunProxyClientLog $ loggerFinal hdbOpts l
          runInTerminalHdbProxy runLogger port
  
  -- | Fetch config from environment, fallback to sane defaults
  getConfig :: Int -> IO ServerConfig
  getConfig port = do
    let
      hostDefault = "0.0.0.0"
      portDefault = port
      capabilities = defaultCapabilities
        { -- Exception breakpoints!
          exceptionBreakpointFilters            = [ defaultExceptionBreakpointsFilter
                                                    { exceptionBreakpointsFilterLabel = "All exceptions"
                                                    , exceptionBreakpointsFilterFilter = BREAK_ON_EXCEPTION
                                                    }
                                                  , defaultExceptionBreakpointsFilter
                                                    { exceptionBreakpointsFilterLabel = "Uncaught exceptions"
                                                    , exceptionBreakpointsFilterFilter = BREAK_ON_ERROR
                                                    }
                                                  ]
          -- Function breakpoints!
        , supportsFunctionBreakpoints           = True
  
        , supportsEvaluateForHovers             = False
  
        -- display which breakpoints are valid when user intends to set
        -- breakpoint on given line.
        , supportsBreakpointLocationsRequest    = True
        , supportsConfigurationDoneRequest      = True
        , supportsHitConditionalBreakpoints     = False
        , supportsModulesRequest                = False
        , additionalModuleColumns               = [ defaultColumnDescriptor
                                                    { columnDescriptorAttributeName = "Extra"
                                                    , columnDescriptorLabel = "Label"
                                                    }
                                                  ]
        , supportsValueFormattingOptions        = True
        , supportTerminateDebuggee              = True
        , supportsLoadedSourcesRequest          = False
        , supportsExceptionOptions              = True
        , supportsExceptionFilterOptions        = False
        }
    ServerConfig
      <$> do fromMaybe hostDefault <$> lookupEnv "DAP_HOST"
      <*> do fromMaybe portDefault . (readMaybe =<<) <$> do lookupEnv "DAP_PORT"
      <*> pure capabilities
      <*> pure True
  
  --------------------------------------------------------------------------------
  -- * Talk
  --------------------------------------------------------------------------------
  
  data MainLog
    = InitLog InitLog
    | LaunchLog T.Text
    | InteractiveLog InteractiveLog
    | RunProxyServerLog ProxyLog
    | RunProxyClientLog ProxyLog
  
  instance Pretty MainLog where
    pretty = \ case
      InitLog msg -> pretty msg
      LaunchLog msg -> pretty msg
      InteractiveLog msg -> pretty msg
      RunProxyServerLog msg -> pretty ("Proxy Server:" :: String) <+> pretty msg
      RunProxyClientLog msg -> pretty ("Proxy Client:" :: String) <+> pretty msg
  
  -- | Main function where requests are received and Events + Responses are returned.
  -- The core logic of communicating between the client <-> adaptor <-> debugger
  -- is implemented in this function.
  talk :: Recorder (WithSeverity MainLog)
       -> IORef Bool
       -- ^ Whether the client supports runInTerminal
       -> IORef (Maybe Int)
       -- ^ The PID of the runInTerminal proxy process
       -> MVar ()
       -- ^ A var to block on waiting for the proxy client to connect, if a proxy
       -- connection is expected. See #95.
       -> Command -> DebugAdaptor ()
  --------------------------------------------------------------------------------
  talk l support_rit_var pid_var client_proxy_signal = \ case
    CommandInitialize -> do
      InitializeRequestArguments{supportsRunInTerminalRequest} <- getArguments
      let runInTerminal = fromMaybe False supportsRunInTerminalRequest
      liftIO $ writeIORef support_rit_var runInTerminal
      sendInitializeResponse
  
      -- If runInTerminal is not supported by the client, signal readiness right away
      when (not runInTerminal) $
        liftIO $ putMVar client_proxy_signal ()
  
  --------------------------------------------------------------------------------
    CommandLaunch -> do
      launch_args <- getArguments
  
      supportsRunInTerminalRequest <- liftIO $ readIORef support_rit_var
  
      merror <- runExceptT $ initDebugger (cmapWithSev InitLog l) supportsRunInTerminalRequest launch_args
      case merror of
        Right () -> do
          sendLaunchResponse   -- ack
          sendInitializedEvent -- our debugger is only ready to be configured after it has launched the session
  
          -- Run the proxy in a separate terminal to accept stdin / forward stdout
          -- if it is supported
          when supportsRunInTerminalRequest $ do
            -- Run proxy thread, server side, and
            -- send the 'runInTerminal' request
            serverSideHdbProxy (cmapWithSev RunProxyServerLog l) client_proxy_signal
  
          logWith l Info $ LaunchLog $ T.pack "Debugger launched successfully."
  
        Left (InitFailed err) -> do
          sendErrorResponse (ErrorMessage (T.pack err)) Nothing
          exitCleanly
  --------------------------------------------------------------------------------
    CommandAttach -> do
      sendErrorResponse (ErrorMessage (T.pack "hdb does not support \"attach\" mode yet")) Nothing
      exitCleanly
  --------------------------------------------------------------------------------
    CommandBreakpointLocations       -> commandBreakpointLocations
    CommandSetBreakpoints            -> commandSetBreakpoints
    CommandSetFunctionBreakpoints    -> commandSetFunctionBreakpoints
    CommandSetExceptionBreakpoints   -> commandSetExceptionBreakpoints
    CommandSetDataBreakpoints        -> undefined
    CommandSetInstructionBreakpoints -> undefined
  ----------------------------------------------------------------------------
    CommandLoadedSources -> undefined
  ----------------------------------------------------------------------------
    CommandConfigurationDone -> do
      sendConfigurationDoneResponse
      -- now that it has been configured, start executing until it halts, then send an event
  
      -- wait for the proxy client to connect before starting the execution (#95)
      () <- liftIO $ takeMVar client_proxy_signal
      startExecution >>= handleEvalResult False
  ----------------------------------------------------------------------------
    CommandThreads    -> commandThreads
    CommandStackTrace -> commandStackTrace
    CommandScopes     -> commandScopes
    CommandVariables  -> commandVariables
  ----------------------------------------------------------------------------
    CommandContinue   -> commandContinue
  ----------------------------------------------------------------------------
    CommandNext       -> commandNext
  ----------------------------------------------------------------------------
    CommandStepIn     -> commandStepIn
    CommandStepOut    -> commandStepOut
  ----------------------------------------------------------------------------
    CommandEvaluate   -> commandEvaluate
  ----------------------------------------------------------------------------
    CommandTerminate  -> do
      commandTerminate
    CommandDisconnect -> commandDisconnect
  ----------------------------------------------------------------------------
    CommandModules -> sendModulesResponse (ModulesResponse [] Nothing)
    CommandSource -> undefined
    CommandPause -> pure () -- TODO
    (CustomCommand "mycustomcommand") -> undefined
    (CustomCommand "runInTerminal") -> do
      -- Ignore result of runInTerminal (reverse request) response.
      -- If it fails, we simply continue without that functionality.
      pure ()
    other -> do
      sendErrorResponse (ErrorMessage (T.pack ("Unsupported command: " <> show other))) Nothing
      exitCleanly
  ----------------------------------------------------------------------------
  -- talk cmd = logInfo $ BL8.pack ("GOT cmd " <> show cmd)
  ----------------------------------------------------------------------------
  
  -- | Receive reverse request responses (such as runInTerminal response)
  ack :: Recorder (WithSeverity MainLog)
      -> IORef (Maybe Int)
      -- ^ Reference to PID of runInTerminal proxy process running
      -> ReverseRequestResponse -> DebugAdaptorCont ()
  ack l ref rrr = case rrr.reverseRequestCommand of
    ReverseCommandRunInTerminal -> do
      when rrr.success $ do
        logWith l Info $ LaunchLog $ T.pack "RunInTerminal was successful"
    _ -> pure ()
  
  