Permalink
Browse files

Code cleaning

  • Loading branch information...
1 parent 485aa1b commit 4e85501746c34d51dbe0ace368d990520c649874 @ivanperez-keera ivanperez-keera committed Apr 15, 2012
View
@@ -69,6 +69,7 @@ Executable SoOSiM-ui
, base >= 4.0 && < 5.0
, ghc
, containers
+ , IfElse
, mtl
, stm
View
@@ -315,7 +315,7 @@
<property name="visible">True</property>
<property name="can_focus">False</property>
<child>
- <object class="GtkIconView" id="iconview1">
+ <object class="GtkIconView" id="infoIconView">
<property name="visible">True</property>
<property name="can_focus">True</property>
</object>
@@ -330,7 +330,7 @@
</packing>
</child>
<child>
- <object class="GtkNotebook" id="notebook3">
+ <object class="GtkNotebook" id="infoSelNotebook">
<property name="visible">True</property>
<property name="can_focus">True</property>
<property name="show_tabs">False</property>
@@ -362,7 +362,7 @@
<property name="visible">True</property>
<property name="can_focus">False</property>
<child>
- <object class="GtkTextView" id="textview1">
+ <object class="GtkTextView" id="infoTextView">
<property name="visible">True</property>
<property name="can_focus">True</property>
<property name="editable">False</property>
@@ -398,7 +398,7 @@
<property name="visible">True</property>
<property name="can_focus">False</property>
<child>
- <object class="GtkTextView" id="textview2">
+ <object class="GtkTextView" id="traceTextView">
<property name="visible">True</property>
<property name="can_focus">True</property>
<property name="editable">False</property>
@@ -526,7 +526,7 @@
<property name="visible">True</property>
<property name="can_focus">False</property>
<child>
- <object class="GtkEventBox" id="eventbox1">
+ <object class="GtkEventBox" id="overviewEventBox">
<property name="width_request">200</property>
<property name="height_request">150</property>
<property name="visible">True</property>
@@ -595,7 +595,7 @@
<property name="can_focus">False</property>
<property name="spacing">2</property>
<child>
- <object class="GtkLabel" id="label12">
+ <object class="GtkLabel" id="statusLbl">
<property name="visible">True</property>
<property name="can_focus">False</property>
<property name="xalign">0</property>
@@ -1,100 +1,95 @@
-- | Condition: the notebook showing the component info will show basic info of
-- the currently selected component
module Controller.Conditions.InfoBasicInfo
- (installHandlers, getElemInfo)
+ (installHandlers)
where
-- External imports
-import Control.Concurrent.STM
-import Control.Monad
-import Control.Monad.Trans
-import Data.CBMVar
-import Data.List
-import Graphics.UI.Gtk
-import Hails.MVC.Model.ProtectedModel.Reactive
-import qualified Data.IntMap as I
-import qualified SoOSiM.Types as S
-import Unique
+import Control.Concurrent.STM
+import Control.Monad
+import Control.Monad.IfElse
+import Data.CBMVar
+import qualified Data.IntMap as I
+import Data.List
+import Graphics.UI.Gtk
+import qualified SoOSiM.Types as S
-- Local imports
import CombinedEnvironment
+import Data.Tuple4
import Graphics.Diagrams.MultiCoreStatus
import Graphics.Diagrams.Types
+import Graphics.UI.Gtk.Multiline.TextBufferHelpers
-- | Selects the appropriate page in the info notebook as the user
-- chooses between basic info and component trace
installHandlers :: CEnv -> IO()
-installHandlers cenv = void $ do
+installHandlers cenv = void $
installCallbackCBMVar mcsRef $ conditionShowCompInfo cenv
where mcsRef = mcs (view cenv)
-- | Shows component info of the selected component
conditionShowCompInfo :: CEnv -> IO()
conditionShowCompInfo cenv = do
st <- readCBMVar $ mcs $ view cenv
- bf1 <- textViewGetBuffer <=< textview1 $ uiBuilder $ view cenv
- bf2 <- textViewGetBuffer <=< textview2 $ uiBuilder $ view cenv
-
- ei <- getElemInfo (selection (fst4 st)) (snd4 st)
- case ei of
- Nothing -> return ()
- Just (ni,nt) -> do textBufferSetText bf1 ni
- textBufferSetText bf2 nt
- where fst4 (a,_,_,_) = a
- snd4 (_,b,_,_) = b
-
--- | Updates a text buffer only if it's necessary (to avoid extra events)
-textBufferUpdateText :: TextBuffer -> String -> IO ()
-textBufferUpdateText bf s = do
- tx <- textBufferGetAllText bf
- when (tx /= s) $ textBufferSetText bf s
-
--- | Gets all the text from a text buffer
-textBufferGetAllText :: TextBuffer -> IO String
-textBufferGetAllText bf = do
- si <- textBufferGetStartIter bf
- ei <- textBufferGetEndIter bf
- textBufferGetText bf si ei True
-
-getElemInfo :: [Name] -> S.SimState -> IO (Maybe (String, String))
+ bf1 <- textViewGetBuffer <=< infoTextView $ uiBuilder $ view cenv
+ bf2 <- textViewGetBuffer <=< traceTextView $ uiBuilder $ view cenv
+
+ let sel = selection (fst4 st)
+ simSt = snd4 st
+
+ awhenM (getElemInfo sel simSt) $ \(ni,nt) -> do
+ textBufferUpdateText bf1 ni
+ textBufferUpdateText bf2 nt
+
+-- | Renders the info relative to a given element (both basic info and a trace)
+getElemInfo :: [Name] -- ^ The qualified name of the element whose info we need
+ -> S.SimState -- ^ The current SimState
+ -> IO (Maybe (String, String)) -- ^ If the element exists, it's associated info, and
+ -- Nothing otherwise
getElemInfo [x] ss = getNodeInfo x ss
getElemInfo [x,y] ss = getCompInfo x y ss
getElemInfo _ _ = return Nothing
-- | Gets the node info
getNodeInfo :: Name -> S.SimState -> IO (Maybe (String, String))
-getNodeInfo n ss = return $ do
- (_,e) <- find ((n ==) . show . S.nodeId . snd) ns
- let binfo = unlines ["Node: " ++ show (S.nodeId e)]
- return (binfo, "Traces are only available for components")
- where ns = I.toList $ S.nodes ss
+getNodeInfo n _ss = return $ do
+ -- (_,e) <- find ((n ==) . show . S.nodeId . snd) ns
+ let binfo = "Node: " ++ n
+ tinfo = "Traces are only available for components"
+ return (binfo, tinfo)
+ -- where ns = I.toList $ S.nodes ss
-- | Compiles the component info
getCompInfo :: Name -> Name -> S.SimState -> IO (Maybe (String, String))
-getCompInfo nn cn ss = do
- let ctx = getCompCtx nn cn ss
- case ctx of
- Nothing -> return Nothing
- Just ctx' -> fmap Just $ showCompInfo nn cn ss ctx'
+getCompInfo nn cn ss =
+ maybe (return Nothing) (fmap Just . showCompInfo nn cn ss) ctx
+ where ctx = getCompCtx nn cn ss
-- | Gets the component context for a given node+name combination
getCompCtx :: Name -> Name -> S.SimState -> Maybe S.ComponentContext
getCompCtx nn cn ss = do
+
+ -- Find node by name
(_,e) <- find ((nn ==) . show . S.nodeId . snd) ns
+
+ -- Find component in node by name
(_,c) <- find ((cn ==) . show . S.componentId . snd) $ I.toList $ S.nodeComponents e
+
+ -- Return component
return c
where ns = I.toList $ S.nodes ss
-- | Renders two strings with the basic component info and the trace
showCompInfo :: Name -> Name -> S.SimState -> S.ComponentContext -> IO (String, String)
-showCompInfo nn cn ss cc@(S.CC cid csu cse cr buf trc smd) = do
+showCompInfo nn cn ss cc = do
bi <- showCompBasicInfo nn cn ss cc
msg <- showCompTrace nn cn ss cc
return (bi, msg)
-- | Creates a string with the basic component info for a given S.ComponentContext
showCompBasicInfo :: Name -> Name -> S.SimState -> S.ComponentContext -> IO String
-showCompBasicInfo nn cn ss (S.CC cid csu cse cr buf trc smd) = do
+showCompBasicInfo nn cn _ss (S.CC _cid csu cse _cr _buf _trc smd) = do
metaData <- readTVarIO smd
cKind <- fmap S.componentName $ readTVarIO cse
cStatus <- readTVarIO csu
@@ -105,8 +100,9 @@ showCompBasicInfo nn cn ss (S.CC cid csu cse cr buf trc smd) = do
S.WaitingForMsg sid _ -> "Waiting for message from " ++ show sid
return $ unlines
- [ "Component pid: " ++ show cid
+ [ "Component pid: " ++ cn
, "Component kind: " ++ cKind
+ , "Node: " ++ nn
, "Component status: " ++ st
, "Cycles running: " ++ show (S.cyclesRunning metaData)
, "Cycles waiting: " ++ show (S.cyclesWaiting metaData)
@@ -115,5 +111,4 @@ showCompBasicInfo nn cn ss (S.CC cid csu cse cr buf trc smd) = do
-- | Creates a component trace from a given S.ComponentContext
showCompTrace :: Name -> Name -> S.SimState -> S.ComponentContext -> IO String
-showCompTrace nn cn ss (S.CC cid csu cse cr buf trc smd) =
- return $ unlines trc
+showCompTrace _nn _cn _ss (S.CC _ _ _ _ _ trc _) = return $ unlines trc
@@ -6,9 +6,7 @@ module Controller.Conditions.InfoSelectionArea
-- External imports
import Control.Monad
-import Control.Monad.Trans
import Graphics.UI.Gtk
-import Hails.MVC.Model.ProtectedModel.Reactive
-- Local imports
import CombinedEnvironment
@@ -17,16 +15,20 @@ import CombinedEnvironment
-- chooses between basic info and component trace
installHandlers :: CEnv -> IO()
installHandlers cenv = void $ do
- iv <- iconview1 $ uiBuilder $ view cenv
+ iv <- infoIconView $ uiBuilder $ view cenv
iv `on` selectionChanged $ condition cenv
model cenv `onEvent` Initialised $ condition cenv
-- | Shows appropriate page based on current selection
condition :: CEnv -> IO()
condition cenv = do
- iv <- iconview1 $ uiBuilder $ view cenv
- nb <- notebook3 $ uiBuilder $ view cenv
+ iv <- infoIconView ui
+ nb <- infoSelNotebook ui
(path, _) <- iconViewGetCursor iv
- case path of
- [x] -> notebookSetCurrentPage nb (x + 1)
- _ -> notebookSetCurrentPage nb 0
+ let page = case path of { [x] -> x + 1; _ -> 0 }
+
+ notebookSetCurrentPage nb page
+ -- case path of
+ -- [x] -> notebookSetCurrentPage nb (x + 1)
+ -- _ -> notebookSetCurrentPage nb 0
+ where ui = uiBuilder $ view cenv
@@ -4,58 +4,61 @@ module Controller.Conditions.InfoTooltip
where
-- External imports
-import Control.Concurrent.STM
-import Control.Monad
-import Data.CBMVar
-import Data.List
-import Data.Maybe
-import Graphics.UI.Gtk
-import qualified Data.IntMap as I
-import qualified SoOSiM.Types as S
-import Unique
+import Control.Concurrent.STM
+import Control.Monad
+import Data.CBMVar
+import qualified Data.IntMap as I
+import Data.List
+import Data.Maybe
+import Data.Tuple4
+import Graphics.UI.Gtk
+import qualified SoOSiM.Types as S
-- Internal imports
import CombinedEnvironment
-import Graphics.Diagrams.MultiCoreStatus
import Graphics.Diagrams.Types
-- | Handles changes in the box selection in the gloss diagram
installHandlers :: CEnv -> IO()
-installHandlers cenv = void $ do
+installHandlers cenv = void $
installCallbackCBMVar mcsRef $ conditionShowPage cenv
where mcsRef = mcs (view cenv)
-- | Shows component info only when a component is selected
conditionShowPage :: CEnv -> IO()
conditionShowPage cenv = do
- st <- readCBMVar $ mcs $ view cenv
- let sel = fth4 st
- tt <- getElemInfo sel (snd4 st)
- lbl <- label12 $ uiBuilder $ view cenv
+ -- Get elem info if possible
+ st <- readCBMVar $ mcs $ view cenv
+ tt <- getElemInfo (fth4 st) (snd4 st)
- let txt = map (\x -> if x == '\n' then ' ' else x) $ fromMaybe "" tt
- labelSetText lbl txt
-
- where fth4 (a,b,c,d) = d
- snd4 (a,b,c,d) = b
+ -- Update label text
+ lbl <- statusLbl $ uiBuilder $ view cenv
+ labelSetText lbl $ fromMaybe "" tt
+-- | Gets the summarised info from components only
getElemInfo :: [Name] -> S.SimState -> IO (Maybe String)
getElemInfo [x,y] ss = getCompInfo x y ss
getElemInfo _ _ = return Nothing
-- | Compiles the component info
getCompInfo :: Name -> Name -> S.SimState -> IO (Maybe String)
-getCompInfo nn cn ss = do
- let ctx = getCompCtx nn cn ss
+getCompInfo nn cn ss =
case ctx of
Nothing -> return Nothing
Just ctx' -> fmap Just $ showCompBasicInfo nn cn ss ctx'
+ where ctx = getCompCtx nn cn ss
-- | Gets the component context for a given node+name combination
getCompCtx :: Name -> Name -> S.SimState -> Maybe S.ComponentContext
getCompCtx nn cn ss = do
+
+ -- Find node by name
(_,e) <- find ((nn ==) . show . S.nodeId . snd) ns
+
+ -- Find component in node by name
(_,c) <- find ((cn ==) . show . S.componentId . snd) $ I.toList $ S.nodeComponents e
+
+ -- Return component
return c
where ns = I.toList $ S.nodes ss
@@ -71,7 +74,7 @@ showCompBasicInfo nn cn ss (S.CC cid csu cse cr buf trc smd) = do
S.Running -> "Running"
S.WaitingForMsg _ _ -> "Waiting"
- return $ unlines
+ return $ map (\x -> if x == '\n' then ' ' else x) $ unlines
[ show cid
, ": " ++ cKind
, "| " ++ st
@@ -6,6 +6,7 @@ module Controller.Conditions.Selection
-- External imports
import Control.Monad
import Data.CBMVar
+import Data.Tuple4
import Graphics.UI.Gtk
-- Internal imports
@@ -27,4 +28,3 @@ conditionShowPage cenv = do
case sel of
[] -> notebookSetCurrentPage nb 0
_ -> notebookSetCurrentPage nb 1
- where fst4 (a,b,c,d) = a
@@ -0,0 +1,19 @@
+-- | Auxiliary functions userful to manipulate TextBuffers
+module Graphics.UI.Gtk.Multiline.TextBufferHelpers where
+
+-- External imports
+import Control.Monad
+import Graphics.UI.Gtk
+
+-- | Updates a text buffer only if it's necessary (to avoid extra events)
+textBufferUpdateText :: TextBuffer -> String -> IO ()
+textBufferUpdateText bf s = do
+ tx <- textBufferGetAllText bf True
+ when (tx /= s) $ textBufferSetText bf s
+
+-- | Gets all the text from a text buffer
+textBufferGetAllText :: TextBuffer -> Bool -> IO String
+textBufferGetAllText bf hidden = do
+ si <- textBufferGetStartIter bf
+ ei <- textBufferGetEndIter bf
+ textBufferGetText bf si ei hidden
Oops, something went wrong.

0 comments on commit 4e85501

Please sign in to comment.