Verified Commit adee8cc5 authored by Camil Staps's avatar Camil Staps 🚀

Add debug option

parent fded74cb
...@@ -12,6 +12,11 @@ from iTasks.SDS.Definition import :: SimpleSDSLens, :: SDSLens, ...@@ -12,6 +12,11 @@ from iTasks.SDS.Definition import :: SimpleSDSLens, :: SDSLens,
from iTasks.UI.Editor.Generic import :: Editor, generic gEditor from iTasks.UI.Editor.Generic import :: Editor, generic gEditor
from iTasks.WF.Definition import :: Task, class iTask from iTasks.WF.Definition import :: Task, class iTask
:: ElectronOptions =
{ port :: !Int
, debug :: !Bool
}
:: ElectronProcess :: ElectronProcess
= MainProcess = MainProcess
| RendererProcess !Int | RendererProcess !Int
...@@ -46,7 +51,7 @@ derive JSONDecode TransportMethod ...@@ -46,7 +51,7 @@ derive JSONDecode TransportMethod
tcpQueueEmpty :: SimpleSDSLens Bool tcpQueueEmpty :: SimpleSDSLens Bool
serveElectron :: serveElectron ::
!([String] EngineOptions -> EngineOptions) !([String] ElectronOptions EngineOptions -> (ElectronOptions, EngineOptions))
!(String ElectronProcess UniversalConnectionDetails -> Task Connection) !(String ElectronProcess UniversalConnectionDetails -> Task Connection)
!*World -> *World !*World -> *World
......
...@@ -27,6 +27,8 @@ import iTasks => qualified forever ...@@ -27,6 +27,8 @@ import iTasks => qualified forever
import iTasks.Internal.IWorld import iTasks.Internal.IWorld
import iTasks.Internal.Task import iTasks.Internal.Task
import Electron.Debug
derive JSONEncode TransportMethod derive JSONEncode TransportMethod
derive JSONDecode TransportMethod derive JSONDecode TransportMethod
...@@ -121,14 +123,21 @@ tcpConnections :: SimpleSDSLens (Map ElectronProcess Connection) ...@@ -121,14 +123,21 @@ tcpConnections :: SimpleSDSLens (Map ElectronProcess Connection)
tcpConnections =: sdsFocus "tcpConnections" (memoryStore "Electron" (Just 'Data.Map'.newMap)) tcpConnections =: sdsFocus "tcpConnections" (memoryStore "Electron" (Just 'Data.Map'.newMap))
serveElectron :: serveElectron ::
!([String] EngineOptions -> EngineOptions) !([String] ElectronOptions EngineOptions -> (ElectronOptions, EngineOptions))
!(String ElectronProcess UniversalConnectionDetails -> Task Connection) !(String ElectronProcess UniversalConnectionDetails -> Task Connection)
!*World -> *World !*World -> *World
serveElectron modOpts startConnection w = doTasksWithOptions serveElectron modOpts startConnection w = doTasksWithOptions
(\cli opts (\cli opts
# (cli,opts) = parseBaseOptions (tl cli) opts # electron_opts =
# opts = modOpts cli opts { port = 0
-> Ok (onStartup (task opts.serverPort),opts)) , debug = False
}
# (cli,electron_opts,opts) = parseBaseOptions (tl cli) electron_opts opts
# (electron_opts,opts) = modOpts cli electron_opts opts
# main = onStartup (task electron_opts.ElectronOptions.port)
| electron_opts.debug
-> Ok ([main, onRequest "/debug" showDebugInfo], opts)
-> Ok ([main], opts))
w w
where where
task :: !Int -> Task () task :: !Int -> Task ()
...@@ -262,10 +271,10 @@ where ...@@ -262,10 +271,10 @@ where
-> w -> w
} }
parseBaseOptions :: ![String] !EngineOptions -> (![String], !EngineOptions) parseBaseOptions :: ![String] !ElectronOptions !EngineOptions -> (![String], !ElectronOptions, !EngineOptions)
parseBaseOptions ["--port":p:rest] opts = parseBaseOptions ["--port":p:rest] electron_opts opts =
parseBaseOptions rest {opts & serverPort=toInt p} parseBaseOptions rest {ElectronOptions | electron_opts & port=toInt p} opts
parseBaseOptions cli opts = (cli,opts) parseBaseOptions cli electron_opts opts = (cli,electron_opts,opts)
closeAllWindows :: Task () closeAllWindows :: Task ()
closeAllWindows = closeAllWindows =
......
definition module Electron.Debug
from iTasks.WF.Definition import :: Task
showDebugInfo :: Task ()
implementation module Electron.Debug
import StdEnv
import qualified Data.Map
import graph_copy
import iTasks
import iTasks.Internal.IWorld
import iTasks.Internal.Task
:: DebugInfo =
{ memory_shares :: !ShareSizes
}
:: ShareSizes =
{ total_size :: !Int
, elements :: ![(String,Int)]
}
derive class iTask DebugInfo, ShareSizes
showDebugInfo :: Task ()
showDebugInfo = getInfo >>- \info -> viewInformation [] info @! ()
where
getInfo :: Task DebugInfo
getInfo = mkInstantTask \_ iworld
# (info,iworld) = getInfo iworld
-> (Ok info, iworld)
where
getInfo :: !*IWorld -> (!DebugInfo, !*IWorld)
getInfo iworld=:{memoryShares} =
(
{ memory_shares = shareSizes memoryShares
}
, iworld
)
shareSizes :: !('Data.Map'.Map String a) -> ShareSizes
shareSizes shares
# elements = [(name, fst (usize (copy_to_string val))) \\ (name,val) <- 'Data.Map'.toList shares]
=
{ total_size = sum (map snd elements)
, elements = elements
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment