{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE TypeFamilies #-} module Network.OnRmt.UI (OnRmtUI(..), runUI, stateEventHandler) where import Concurrent.Worker (DispBlk, StateCmd(..), WorkMsg(..) , WorkItems(..), WorkId, WorkState) import qualified Data.Text as T class Show b => OnRmtUI a b | b -> a where startUI :: a -> (WorkMsg -> IO ()) -> b -> IO b setUIItems :: b -> [WorkItems] -> Maybe (WorkId -> WorkState -> T.Text) -> IO b newOutput :: b -> DispBlk -> IO b addOutput :: b -> DispBlk -> IO b setProgress :: b -> T.Text -> Int -> IO b addLogInfo :: b -> T.Text -> IO b setItemState :: b -> WorkState -> WorkId -> IO b endInfo :: b -> IO b -- n.b. the third argument to startUI is not strictly necessary -- (startUI could easily be implemented absent that argument) but then -- there's undecideability on what type b is since it never appears as -- an argument to runUI (e.g. could not decide the Show instance for -- uistate). The UI instances typically pass "undefined" for this -- parameter and never expect it to be evaluated. runUI :: (OnRmtUI ui uistate, Show uistate) => ui -> (WorkMsg -> IO ()) -> uistate -> IO uistate runUI = startUI stateEventHandler :: OnRmtUI cfg ui => ui -> StateCmd -> IO ui stateEventHandler ui (NewItems ns idfun) = setUIItems ui ns idfun stateEventHandler ui (DisplaySet dsp) = newOutput ui dsp stateEventHandler ui (DisplayAdd dsp) = addOutput ui dsp stateEventHandler ui (SetProgress t n) = setProgress ui t n stateEventHandler ui (LogInfo i) = addLogInfo ui i stateEventHandler ui (ChgState s i) = setItemState ui s i stateEventHandler ui ResetUI = putStr "No handling for ResetUI" >> return ui stateEventHandler ui EndOfInformation = endInfo ui