[Gtk2hs-commit] gtk2hs/demo/profileviewer ProfileViewer.hs,NONE,1.1 ParseProfile.hs,NONE,1.1 ProfileViewer.glade,NONE,1.1 ProfileViewer.gladep,NONE,1.1 Makefile,NONE,1.1

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/demo/profileviewer
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26828/demo/profileviewer

Added Files:
	ProfileViewer.hs ParseProfile.hs ProfileViewer.glade 
	ProfileViewer.gladep Makefile 
Log Message:
new demo, a viewer for ghc's time-profile log files


--- NEW FILE: ProfileViewer.gladep ---
<?xml version="1.0" standalone="no"?> <!--*- mode: xml -*-->
<!DOCTYPE glade-project SYSTEM "http://glade.gnome.org/glade-project-2.0.dtd">

<glade-project>
  <name>ProfileViewer</name>
  <program_name>profileviewer</program_name>
  <gnome_support>FALSE</gnome_support>
</glade-project>

--- NEW FILE: ParseProfile.hs ---
-- Copyright (c) 2004 Duncan Coutts
-- This library is liscenced under the GNU General Public License version 2
-- or (at your option) any later version.

-- This is a not-terribly-clever parser for ghc's time profile log files.

module ParseProfile (
  Profile(..),
  ProfileNode(..),
  parseProfileFile,
  pruneOnThreshold
) where

import Char
import Maybe (catMaybes)

data Profile = Profile {
    title :: String,
    command :: String,
    totalTime :: Float,
    totalAlloc :: Integer,   --can be several GB
    breakdown :: ProfileNode
  }

data ProfileNode = ProfileNode {
    costCentre :: String,
    moduleName :: String,
    entries :: !Int,
    individualTime  :: !Int, --scaled by 10
    individualAlloc :: !Int, --scaled by 10
    inheritedTime   :: !Int, --scaled by 10
    inheritedAlloc  :: !Int, --scaled by 10
    children :: [ProfileNode]
  }

pruneOnThreshold :: Int -> ProfileNode -> Maybe ProfileNode
pruneOnThreshold threshold node
  | inheritedTime node >= threshold
 || inheritedAlloc node >= threshold =
    let children' = catMaybes $ map (pruneOnThreshold threshold) (children node)
     in Just $ node { children = children' }
  | otherwise = Nothing


parseProfileFile :: String -> IO Profile
parseProfileFile filename = do
  content <- readFile filename
  let (titleLine:_:commandLine:_:timeLine:allocLine:theRest) = lines content
      profileDetail = dropWhile (\line -> take 4 line /= "MAIN") theRest
  return $ Profile {
      title = dropWhile isSpace titleLine,
      command = dropWhile isSpace commandLine,
      totalTime = read $ words timeLine !! 3,
      totalAlloc = read $ filter (/=',') $ words allocLine !! 3,
      breakdown = parseProfile profileDetail
    }

-- intermediate form
data ProfileEntry = ProfileEntry {
    depth :: !Int,
    ecostCentre :: String,
    emoduleName :: String,
    eentries :: !Int,
    eindividualTime  :: !Int, --scaled by 10
    eindividualAlloc :: !Int, --scaled by 10
    einheritedTime   :: !Int, --scaled by 10
    einheritedAlloc  :: !Int  --scaled by 10
  }

parseProfile :: [String] -> ProfileNode
parseProfile file =
  case (profileEntriesToProfile [] 0 . map parseProfileEntry) file of
    ([profile],[]) -> profile
    _ -> error "multiple top level entries"

parseProfileEntry :: String -> ProfileEntry
parseProfileEntry line =
  let depth = length (takeWhile (==' ') line)
   in case words line of
        [costCentre, moduleName, _, entries,
         individualTime, individualAlloc,
         inheritedTime, inheritedAlloc] ->
          ProfileEntry {
            depth = depth,
            ecostCentre = costCentre,
            emoduleName = moduleName,
            eentries = read entries,
            eindividualTime  = floor $ (read individualTime) * 10,
            eindividualAlloc = floor $ (read individualAlloc) * 10,
            einheritedTime  = floor $ (read inheritedTime) * 10,
            einheritedAlloc = floor $ (read inheritedAlloc) * 10 
          }
        _ -> error $ "bad profile line:\n\t" ++ line

profileEntriesToProfile :: [ProfileNode] -> Int -> [ProfileEntry] -> ([ProfileNode], [ProfileEntry])
profileEntriesToProfile acum curDepth [] = (acum, [])
profileEntriesToProfile acum curDepth (entry:entries)
  | depth entry == curDepth =
     let (children, remaining) = profileEntriesToProfile
                                   [] (depth entry + 1) entries
         curNode = ProfileNode {
             costCentre = ecostCentre entry,
             moduleName = emoduleName entry,
             entries    = eentries entry,
             individualTime  = eindividualTime entry,
             individualAlloc = eindividualAlloc entry,
             inheritedTime  = einheritedTime entry,
             inheritedAlloc = einheritedAlloc entry,
             children = children
           }
      in profileEntriesToProfile (curNode:acum) (depth entry) remaining
  | depth entry < curDepth = (acum, entry:entries)  --we're done for this level
  | otherwise = error "bad indentation in file"

--- NEW FILE: ProfileViewer.glade ---
<?xml version="1.0" standalone="no"?> <!--*- mode: xml -*-->
<!DOCTYPE glade-interface SYSTEM "http://glade.gnome.org/glade-2.0.dtd">

<glade-interface>

<widget class="GtkWindow" id="mainWindow">
  <property name="visible">True</property>
  <property name="title" translatable="yes">GHC timing profile viewer</property>
  <property name="type">GTK_WINDOW_TOPLEVEL</property>
  <property name="window_position">GTK_WIN_POS_NONE</property>
  <property name="modal">False</property>
  <property name="default_width">650</property>
  <property name="default_height">400</property>
  <property name="resizable">True</property>
  <property name="destroy_with_parent">False</property>

  <child>
    <widget class="GtkVBox" id="vbox1">
      <property name="visible">True</property>
      <property name="homogeneous">False</property>
      <property name="spacing">0</property>

      <child>
	<widget class="GtkMenuBar" id="menubar1">
	  <property name="visible">True</property>

	  <child>
	    <widget class="GtkMenuItem" id="menuitem1">
	      <property name="visible">True</property>
	      <property name="label" translatable="yes">_File</property>
	      <property name="use_underline">True</property>

	      <child>
		<widget class="GtkMenu" id="menuitem1_menu">

		  <child>
		    <widget class="GtkImageMenuItem" id="openMenuItem">
		      <property name="visible">True</property>
		      <property name="label">gtk-open</property>
		      <property name="use_stock">True</property>
		    </widget>
		  </child>

		  <child>
		    <widget class="GtkMenuItem" id="separatormenuitem1">
		      <property name="visible">True</property>
		    </widget>
		  </child>

		  <child>
		    <widget class="GtkImageMenuItem" id="quitMenuItem">
		      <property name="visible">True</property>
		      <property name="label">gtk-quit</property>
		      <property name="use_stock">True</property>
		    </widget>
		  </child>
		</widget>
	      </child>
	    </widget>
	  </child>

	  <child>
	    <widget class="GtkMenuItem" id="view1">
	      <property name="visible">True</property>
	      <property name="label" translatable="yes">_View</property>
	      <property name="use_underline">True</property>

	      <child>
		<widget class="GtkMenu" id="view1_menu">

		  <child>
		    <widget class="GtkRadioMenuItem" id="allEntries">
		      <property name="visible">True</property>
		      <property name="label" translatable="yes">All entries</property>
		      <property name="use_underline">True</property>
		      <property name="active">True</property>
		    </widget>
		  </child>

		  <child>
		    <widget class="GtkRadioMenuItem" id="0.1%Entries">
		      <property name="visible">True</property>
		      <property name="label" translatable="yes">Only entries with 0.1% or more</property>
		      <property name="use_underline">True</property>
		      <property name="active">False</property>
		      <property name="group">allEntries</property>
		    </widget>
		  </child>

		  <child>
		    <widget class="GtkRadioMenuItem" id="0.5%Entries">
		      <property name="visible">True</property>
		      <property name="label" translatable="yes">Only entries with 0.5% or more</property>
		      <property name="use_underline">True</property>
		      <property name="active">False</property>
		      <property name="group">allEntries</property>
		    </widget>
		  </child>

		  <child>
		    <widget class="GtkRadioMenuItem" id="1%Entries">
		      <property name="visible">True</property>
		      <property name="label" translatable="yes">Only entries with 1% or more</property>
		      <property name="use_underline">True</property>
		      <property name="active">False</property>
		      <property name="group">allEntries</property>
		    </widget>
		  </child>

		  <child>
		    <widget class="GtkRadioMenuItem" id="5%Entries">
		      <property name="visible">True</property>
		      <property name="label" translatable="yes">Only entries with 5% or more</property>
		      <property name="use_underline">True</property>
		      <property name="active">False</property>
		      <property name="group">allEntries</property>
		    </widget>
		  </child>

		  <child>
		    <widget class="GtkRadioMenuItem" id="10%Entries">
		      <property name="visible">True</property>
		      <property name="label" translatable="yes">Only entries with 10% or more</property>
		      <property name="use_underline">True</property>
		      <property name="active">False</property>
		      <property name="group">allEntries</property>
		    </widget>
		  </child>

		  <child>
		    <widget class="GtkRadioMenuItem" id="50%Entries">
		      <property name="visible">True</property>
		      <property name="label" translatable="yes">Only entries with 50% or more</property>
		      <property name="use_underline">True</property>
		      <property name="active">False</property>
		      <property name="group">allEntries</property>
		    </widget>
		  </child>
		</widget>
	      </child>
	    </widget>
	  </child>

	  <child>
	    <widget class="GtkMenuItem" id="menuitem4">
	      <property name="visible">True</property>
	      <property name="label" translatable="yes">_Help</property>
	      <property name="use_underline">True</property>

	      <child>
		<widget class="GtkMenu" id="menuitem4_menu">

		  <child>
		    <widget class="GtkMenuItem" id="aboutMenuItem">
		      <property name="visible">True</property>
		      <property name="label" translatable="yes">_About</property>
		      <property name="use_underline">True</property>
		    </widget>
		  </child>
		</widget>
	      </child>
	    </widget>
	  </child>
	</widget>
	<packing>
	  <property name="padding">0</property>
	  <property name="expand">False</property>
	  <property name="fill">False</property>
	</packing>
      </child>

      <child>
	<widget class="GtkTable" id="table1">
	  <property name="border_width">5</property>
	  <property name="visible">True</property>
	  <property name="n_rows">4</property>
	  <property name="n_columns">2</property>
	  <property name="homogeneous">False</property>
	  <property name="row_spacing">2</property>
	  <property name="column_spacing">10</property>

	  <child>
	    <widget class="GtkLabel" id="label4">
	      <property name="visible">True</property>
	      <property name="label" translatable="yes">&lt;b&gt;Total time&lt;/b&gt;</property>
	      <property name="use_underline">False</property>
	      <property name="use_markup">True</property>
	      <property name="justify">GTK_JUSTIFY_RIGHT</property>
	      <property name="wrap">False</property>
	      <property name="selectable">False</property>
	      <property name="xalign">1</property>
	      <property name="yalign">0.5</property>
	      <property name="xpad">0</property>
	      <property name="ypad">0</property>
	    </widget>
	    <packing>
	      <property name="left_attach">0</property>
	      <property name="right_attach">1</property>
	      <property name="top_attach">2</property>
	      <property name="bottom_attach">3</property>
	      <property name="x_options">fill</property>
	      <property name="y_options"></property>
	    </packing>
	  </child>

	  <child>
	    <widget class="GtkLabel" id="label4">
	      <property name="visible">True</property>
	      <property name="label" translatable="yes">&lt;b&gt;Total alloc&lt;/b&gt;</property>
	      <property name="use_underline">False</property>
	      <property name="use_markup">True</property>
	      <property name="justify">GTK_JUSTIFY_LEFT</property>
	      <property name="wrap">False</property>
	      <property name="selectable">False</property>
	      <property name="xalign">1</property>
	      <property name="yalign">0.5</property>
	      <property name="xpad">0</property>
	      <property name="ypad">0</property>
	    </widget>
	    <packing>
	      <property name="left_attach">0</property>
	      <property name="right_attach">1</property>
	      <property name="top_attach">3</property>
	      <property name="bottom_attach">4</property>
	      <property name="x_options">fill</property>
	      <property name="y_options"></property>
	    </packing>
	  </child>

	  <child>
	    <widget class="GtkLabel" id="titleLabel">
	      <property name="visible">True</property>
	      <property name="can_focus">True</property>
	      <property name="label" translatable="yes"></property>
	      <property name="use_underline">False</property>
	      <property name="use_markup">False</property>
	      <property name="justify">GTK_JUSTIFY_LEFT</property>
	      <property name="wrap">False</property>
	      <property name="selectable">True</property>
	      <property name="xalign">0</property>
	      <property name="yalign">0.5</property>
	      <property name="xpad">0</property>
	      <property name="ypad">0</property>
	    </widget>
	    <packing>
	      <property name="left_attach">1</property>
	      <property name="right_attach">2</property>
	      <property name="top_attach">0</property>
	      <property name="bottom_attach">1</property>
	      <property name="x_options">expand|shrink|fill</property>
	      <property name="y_options"></property>
	    </packing>
	  </child>

	  <child>
	    <widget class="GtkLabel" id="totalTimeLabel">
	      <property name="visible">True</property>
	      <property name="can_focus">True</property>
	      <property name="label" translatable="yes"></property>
	      <property name="use_underline">False</property>
	      <property name="use_markup">False</property>
	      <property name="justify">GTK_JUSTIFY_LEFT</property>
	      <property name="wrap">False</property>
	      <property name="selectable">True</property>
	      <property name="xalign">0</property>
	      <property name="yalign">0.5</property>
	      <property name="xpad">0</property>
	      <property name="ypad">0</property>
	    </widget>
	    <packing>
	      <property name="left_attach">1</property>
	      <property name="right_attach">2</property>
	      <property name="top_attach">2</property>
	      <property name="bottom_attach">3</property>
	      <property name="x_options">fill</property>
	      <property name="y_options"></property>
	    </packing>
	  </child>

	  <child>
	    <widget class="GtkLabel" id="totalAllocLabel">
	      <property name="visible">True</property>
	      <property name="can_focus">True</property>
	      <property name="label" translatable="yes"></property>
	      <property name="use_underline">False</property>
	      <property name="use_markup">False</property>
	      <property name="justify">GTK_JUSTIFY_LEFT</property>
	      <property name="wrap">False</property>
	      <property name="selectable">True</property>
	      <property name="xalign">0</property>
	      <property name="yalign">0.5</property>
	      <property name="xpad">0</property>
	      <property name="ypad">0</property>
	    </widget>
	    <packing>
	      <property name="left_attach">1</property>
	      <property name="right_attach">2</property>
	      <property name="top_attach">3</property>
	      <property name="bottom_attach">4</property>
	      <property name="x_options">fill</property>
	      <property name="y_options"></property>
	    </packing>
	  </child>

	  <child>
	    <widget class="GtkLabel" id="label11">
	      <property name="visible">True</property>
	      <property name="label" translatable="yes">&lt;b&gt;Report&lt;/b&gt;</property>
	      <property name="use_underline">False</property>
	      <property name="use_markup">True</property>
	      <property name="justify">GTK_JUSTIFY_RIGHT</property>
	      <property name="wrap">False</property>
	      <property name="selectable">False</property>
	      <property name="xalign">1</property>
	      <property name="yalign">0.5</property>
	      <property name="xpad">0</property>
	      <property name="ypad">0</property>
	    </widget>
	    <packing>
	      <property name="left_attach">0</property>
	      <property name="right_attach">1</property>
	      <property name="top_attach">0</property>
	      <property name="bottom_attach">1</property>
	      <property name="x_options">fill</property>
	      <property name="y_options"></property>
	    </packing>
	  </child>

	  <child>
	    <widget class="GtkLabel" id="label12">
	      <property name="visible">True</property>
	      <property name="label" translatable="yes">&lt;b&gt;Command&lt;/b&gt;</property>
	      <property name="use_underline">False</property>
	      <property name="use_markup">True</property>
	      <property name="justify">GTK_JUSTIFY_RIGHT</property>
	      <property name="wrap">False</property>
	      <property name="selectable">False</property>
	      <property name="xalign">1</property>
	      <property name="yalign">0.5</property>
	      <property name="xpad">0</property>
	      <property name="ypad">0</property>
	    </widget>
	    <packing>
	      <property name="left_attach">0</property>
	      <property name="right_attach">1</property>
	      <property name="top_attach">1</property>
	      <property name="bottom_attach">2</property>
	      <property name="x_options">fill</property>
	      <property name="y_options"></property>
	    </packing>
	  </child>

	  <child>
	    <widget class="GtkLabel" id="commandLabel">
	      <property name="visible">True</property>
	      <property name="label" translatable="yes"></property>
	      <property name="use_underline">False</property>
	      <property name="use_markup">False</property>
	      <property name="justify">GTK_JUSTIFY_LEFT</property>
	      <property name="wrap">True</property>
	      <property name="selectable">False</property>
	      <property name="xalign">0</property>
	      <property name="yalign">0</property>
	      <property name="xpad">0</property>
	      <property name="ypad">0</property>
	    </widget>
	    <packing>
	      <property name="left_attach">1</property>
	      <property name="right_attach">2</property>
	      <property name="top_attach">1</property>
	      <property name="bottom_attach">2</property>
	      <property name="x_options">fill</property>
	      <property name="y_options"></property>
	    </packing>
	  </child>
	</widget>
	<packing>
	  <property name="padding">0</property>
	  <property name="expand">False</property>
	  <property name="fill">False</property>
	</packing>
      </child>

      <child>
	<widget class="GtkScrolledWindow" id="scrolledwindow1">
	  <property name="visible">True</property>
	  <property name="can_focus">True</property>
	  <property name="hscrollbar_policy">GTK_POLICY_AUTOMATIC</property>
	  <property name="vscrollbar_policy">GTK_POLICY_AUTOMATIC</property>
	  <property name="shadow_type">GTK_SHADOW_NONE</property>
	  <property name="window_placement">GTK_CORNER_TOP_LEFT</property>

	  <child>
	    <widget class="GtkTreeView" id="mainView">
	      <property name="visible">True</property>
	      <property name="can_focus">True</property>
	      <property name="headers_visible">True</property>
	      <property name="rules_hint">True</property>
	      <property name="reorderable">False</property>
	      <property name="enable_search">True</property>
	    </widget>
	  </child>
	</widget>
	<packing>
	  <property name="padding">0</property>
	  <property name="expand">True</property>
	  <property name="fill">True</property>
	</packing>
      </child>

      <child>
	<widget class="GtkStatusbar" id="statusbar">
	  <property name="visible">True</property>
	  <property name="has_resize_grip">True</property>
	</widget>
	<packing>
	  <property name="padding">0</property>
	  <property name="expand">False</property>
	  <property name="fill">False</property>
	</packing>
      </child>
    </widget>
  </child>
</widget>

</glade-interface>

--- NEW FILE: Makefile ---
TOP = ../..

include $(TOP)/mk/config.mk

MAIN = ProfileViewer.hs

APPNAME = viewProfile

NEEDPACKAGES = gtk2 mogul glade

include $(TOP)/mk/common.mk

--- NEW FILE: ProfileViewer.hs ---
-- Copyright (c) 2004 Duncan Coutts
-- This program is liscenced under the GNU General Public License version 2
-- or (at your option) any later version.

-- This is a slightly larger demo that combines use of glade, the file chooser
-- dialog, program state (IORefs) and use of the mogul tree view wrapper
-- interface. 

-- The program is a simple viewer for the log files that ghc produces when you
-- do time profiling. The parser is not very clever so loading large files can
-- take several seconds.

-- TODO: The gui will appear to hang when loading files. We should use threads
-- to keep the gui responsive.

module Main where

import Gtk
import Mogul
import Glade

import ParseProfile

import Maybe (isJust, fromJust)
import Monad (when)
import List  (unfoldr, intersperse)
import Data.IORef

main :: IO ()
main = do
  -- our global state
  thresholdVar <- newIORef 0        --current cuttoff/threshhold value
  profileVar <- newIORef Nothing    --holds the current profile data structure
  
  -- initialisation stuff
  initGUI

  dialogXmlM <- xmlNew "ProfileViewer.glade"
  let dialogXml = case dialogXmlM of
        (Just dialogXml) -> dialogXml
        Nothing -> error $ "can't find the glade file \"ProfileViewer.glade\""
                        ++ "in the current directory"

  -- get a handle on a various objects from the glade file
  mainWindow <- xmlGetWidget dialogXml castToWindow "mainWindow"
  mainWindow `onDestroy` mainQuit

  mainView <- xmlGetWidget dialogXml castToTreeView "mainView"

  titleLabel <- xmlGetWidget dialogXml castToLabel "titleLabel"
  commandLabel <- xmlGetWidget dialogXml castToLabel "commandLabel"
  totalTimeLabel <- xmlGetWidget dialogXml castToLabel "totalTimeLabel"
  totalAllocLabel <- xmlGetWidget dialogXml castToLabel "totalAllocLabel"
  
  -- create the tree model
  skel <- emptyTreeSkel
  
  let createTextColumn name = do
        (attr, _, set) <- treeSkelAddAttribute skel cellText
        column <- newTreeViewColumn
        column `treeViewColumnSetTitle` name
        mainView `treeViewAppendColumn` column
        renderer <- treeViewColumnNewText column True True
        renderer `treeViewColumnAssociate` [attr]
        return set

  -- create the various columns in both the model and view
  setCostCentre <- createTextColumn "Cost Centre"
  setModule     <- createTextColumn "Module"
  setEntries    <- createTextColumn "Entries"
  setIndiTime   <- createTextColumn "Individual %time"
  setIndiAlloc  <- createTextColumn "Individual %alloc"
  setInhTime    <- createTextColumn "Inherited %time"
  setInhAlloc   <- createTextColumn "Inherited %alloc"

  store <- newTreeStore skel
  mainView `treeViewSetModel` store

  -- this action clears the tree model and then populates it with the
  -- profile contained in the profileVar, taking into account the current
  -- threshold value kept in the thresholdVar 
  let repopulateTreeStore = do
        profile <- readIORef profileVar
        when (isJust profile)
             (repopulateTreeStore' $ fromJust profile)
      repopulateTreeStore' profile = do
        treeStoreClear store
        titleLabel `labelSetText` (title profile)
        commandLabel `labelSetText` (command profile)
        totalTimeLabel `labelSetText` (show (totalTime profile) ++ " sec")
        totalAllocLabel `labelSetText` (formatNumber (totalAlloc profile) ++ " bytes")
        
	threshold <- readIORef thresholdVar
        let node = if threshold > 0
                     then pruneOnThreshold threshold (breakdown profile)
                     else Just (breakdown profile)
        when (isJust node)
             (addProfileNode Nothing (fromJust node))

      addProfileNode :: Maybe TreeIter -> ProfileNode -> IO ()
      addProfileNode parentNode profile = do
        iter <- treeStoreAppend store parentNode
        setCostCentre iter (costCentre profile)
        setModule     iter (moduleName profile)
        setEntries    iter (show $ entries profile)
        setIndiTime   iter (show $ fromIntegral (individualTime profile) / 10)
        setIndiAlloc  iter (show $ fromIntegral (individualAlloc profile)/ 10)
        setInhTime    iter (show $ fromIntegral (inheritedTime profile)  / 10)
        setInhAlloc   iter (show $ fromIntegral (inheritedAlloc profile) / 10)
	return iter
        mapM_ (addProfileNode (Just iter)) (children profile)

  -- associate actions with the menus
  
  -- the open menu item, opens a file dialog and then loads and displays
  -- the the profile (unless the user cancleled the dialog)
  openMenuItem <- xmlGetWidget dialogXml castToMenuItem "openMenuItem"
  openMenuItem `onActivateLeaf` do
    filename <- openFileDialog mainWindow
    when (isJust filename)
         (do profile <- parseProfileFile (fromJust filename)
	     writeIORef profileVar (Just profile)
             repopulateTreeStore)

  quitMenuItem <- xmlGetWidget dialogXml castToMenuItem "quitMenuItem"
  quitMenuItem `onActivateLeaf` mainQuit
  
  -- each menu item in the "View" menu sets the thresholdVar and re-displays
  -- the current profile
  let doThresholdMenuItem threshold itemName = do
        menuItem <- xmlGetWidget dialogXml castToMenuItem itemName
        menuItem `onActivateLeaf` do writeIORef thresholdVar threshold
	                             repopulateTreeStore
  mapM_ (uncurry doThresholdMenuItem)
    [(0, "allEntries"), (1, "0.1%Entries"), (5, "0.5%Entries"), (10, "1%Entries"),
     (50, "5%Entries"), (100, "10%Entries"), (500, "50%Entries")]

  -- The final step is to display the main window and run the main loop
  widgetShowAll mainWindow
  mainGUI


-- display a standard file open dialog
openFileDialog :: Window -> IO (Maybe String)
openFileDialog parentWindow = do
  dialog <- fileChooserDialogNew
              (Just "Open Profile... ")
              (Just parentWindow)
	      FileChooserActionOpen
	      [("gtk-cancel", ResponseCancel)
	      ,("gtk-open", ResponseAccept)]
  widgetShow dialog
  dialogRun dialog
  widgetHide dialog
  fileChooserGetFilename dialog
 
-- just to display a number using thousand seperators
-- eg "3,456,235,596"
formatNumber :: Integer -> String
formatNumber =
  reverse . concat . intersperse ","
  . unfoldr (\l -> case splitAt 3 l of
                     ([], _) -> Nothing
                     p       -> Just p)
  . reverse . show