{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Haskell.Debug.Adapter.Control 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.Constant
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
data ArgData = ArgData {
_hackageVersionArgData :: String
} deriving (Data, Typeable, Show, Read, Eq)
makeLenses ''ArgData
$(deriveJSON
defaultOptions {
fieldLabelModifier = fieldModifier "ArgData"
}
''ArgData)
instance Default ArgData where
def = ArgData {
_hackageVersionArgData = ""
}
run :: ArgData
-> Handle
-> Handle
-> IO Int
run _ inHdl outHdl = E.bracket initialize finalize go
where
initialize = do
L.debugM _LOG_NAME $ "initialize called."
hSetBuffering inHdl NoBuffering
hSetEncoding inHdl utf8
hSetBuffering outHdl NoBuffering
hSetEncoding outHdl utf8
A.defaultAppStores inHdl outHdl
finalize _ = do
L.debugM _LOG_NAME $ "finalize called."
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
]
TD.start appData ths >>= wait
return 0