module Network.OnRmt.UI.BrickUI (brickUI) where
import Brick.AttrMap
import Brick.Main
import Brick.Types
import BrickCompat (BChan, newBChan, writeBChan, defaultConfig)
import Concurrent.Worker ( WorkMsg, StateCmd(..), WorkMsg(..)
, WorkItems(..), WorkState(..)
, WorkId, DispBlk(..))
import Control.Monad.IO.Class (liftIO)
import Data.Default (def)
import qualified Data.Text as T
import Graphics.Vty (Attr(..), Event(..), mkVty)
import Graphics.Vty.Attributes (defAttr)
import Network.OnRmt.UI (OnRmtUI(..), stateEventHandler)
import Network.OnRmt.UI.MainScreen ( Screen(..), newScreen, drawScreen
, handleScreenEvents, chooseScreenCursor
, ScreenElementNames, ScreenEventResult(..)
, screenDefaultAttrs
, setScreenItemState
, setScreenProgress
, resetOutput, addScreenOutput, updateScreen
, logWrite)
import TextUI.ItemField
type UIElementNames = ScreenElementNames
data BrickConfig = BrickConfig { b_appName :: T.Text
, b_userAttrs :: [(AttrName, Attr)]
, b_eventChan :: BChan BrickUIEvent
}
instance OnRmtUI BrickConfig BrickState where
startUI = startBrickUI
setUIItems = setBrickItems
newOutput = setBrickOutput
addOutput = addBrickOutput
setProgress = setBrickProgress
addLogInfo = addBrickLog
setItemState = setBrickItemState
endInfo = return
setBrickItems s i f =
let ff = itemfield $ b_scrn s
nf = ItemFieldWidget (itemFieldName ff) $ newItemField ni (identFunc f)
ni = map w2i i
w2i (WorkGroup n i) = ItemGroup n $ w2i i
w2i (WorkItems n) = Items n
scrn' = (b_scrn s) { itemfield = nf }
s' = s { b_scrn = scrn' }
identFunc Nothing = Nothing
identFunc (Just f') = Just $ identF f'
identF f' i s = f' i (ist82wst8 s)
ist82wst8 Free = NoWork
ist82wst8 Good = WorkDone
ist82wst8 Bad = WorkFailed
ist82wst8 Marked = NoWork
in return s'
data BrickState = BrickState { b_cfg :: BrickConfig
, b_scrn :: Screen
, b_workerRequest :: WorkMsg -> IO ()
, b_queryResponses :: [T.Text]
}
instance Show BrickState where
show = show . b_scrn
brickUI :: T.Text -> [(AttrName, Attr)] -> IO (BrickConfig, StateCmd -> IO (), BrickState)
brickUI appName attrs =
do eventChan <- newBChan 100000
return ( BrickConfig { b_appName = appName
, b_userAttrs = attrs
, b_eventChan = eventChan
}
, writeBChan eventChan . BUIE_StateEvent
, undefined)
startBrickUI :: BrickConfig -> (WorkMsg -> IO ()) -> BrickState -> IO BrickState
startBrickUI brickCfg workerReq _ = customMain vty (Just evchan) brickApp brickState
where brickApp =
App { appDraw = drawUI
, appHandleEvent = handleOnRmtEvents
, appStartEvent = return
, appAttrMap = const
$ applyAttrMappings (b_userAttrs brickCfg)
$ applyAttrMappings screenDefaultAttrs
$ applyAttrMappings itemDefaultAttrs $ attrMap defAttr []
, appChooseCursor = chooseUICursor
}
vty = mkVty defaultConfig
evchan = b_eventChan brickCfg
brickState = BrickState { b_cfg = brickCfg
, b_scrn = newScreen (b_appName brickCfg) field
, b_workerRequest = workerReq
, b_queryResponses = []
}
field = newItemField nodes $ Just showf
showf = showNode nodes
nodes = []
showNode a b c = T.pack ""
drawUI = drawScreen . b_scrn
chooseUICursor = chooseScreenCursor . b_scrn
data BrickUIEvent = BUIE_StateEvent StateCmd
handleOnRmtEvents :: BrickState
-> BrickEvent ScreenElementNames BrickUIEvent
-> EventM ScreenElementNames (Next BrickState)
handleOnRmtEvents ui (VtyEvent ev) =
let workop s o = liftIO (b_workerRequest ui o) >> updscrn s
updscrn s = continue $ ui { b_scrn = s }
workop' o = liftIO (b_workerRequest ui o) >> continue ui
in do r <- handleScreenEvents (b_scrn ui) ev
case r of
Continue s -> updscrn s
ResetAll s -> do liftIO $ b_workerRequest ui ClearAll
continue $ ui { b_scrn = s
, b_queryResponses = []
}
RequestWork s i m -> workop s $ StartRun i m
UpdateSelection s n -> workop s $ ShowSelInfo n
Quit -> halt ui
MoreParallel -> workop' IncrParallel
LessParallel -> workop' DecrParallel
EnteredResponseGen s -> workop s StartResponse
ResponseGenAdd s t -> workop s $ AddToResponse t
ResponseGenRecord -> workop' EndResponse
ExitedResponseGen s -> workop s AbandonResponse
handleOnRmtEvents ui (AppEvent (BUIE_StateEvent ev)) =
do ui' <- liftIO $ stateEventHandler ui ev
continue ui'
handleOnRmtEvents ui _ = continue ui
setBrickOutput, addBrickOutput :: BrickState -> DispBlk -> IO BrickState
setBrickOutput ui o = do n <- addScreenOutput o $ resetOutput $ outRgn $ b_scrn ui
return $ ui { b_scrn = (b_scrn ui) { outRgn = n } }
addBrickOutput ui o = do n <- addScreenOutput o $ outRgn $ b_scrn ui
return $ ui { b_scrn = (b_scrn ui) { outRgn = n } }
setBrickProgress ui t c =
do s <- updateScreen (b_scrn ui) (return . setScreenProgress t c)
return $ ui { b_scrn = s }
addBrickLog ui t = return $ ui { b_scrn = logWrite t (b_scrn ui) }
setBrickItemState ui s i = return $ ui { b_scrn = setScreenItemState s i (b_scrn ui) }