{-
-}
module Main
  ( main )
where

{- Standard Library Modules Imported -}
import Control.Monad
  ( liftM )
import qualified Control.Monad.Trans as Trans
import qualified Data.List as List
import qualified Data.Maybe as Maybe
import System.Console.GetOpt
  ( getOpt
  , usageInfo
  , ArgOrder    ( .. )
  , OptDescr    ( .. )
  , ArgDescr    ( .. )
  )
import qualified System.Directory as Directory
import System.Environment
  ( getArgs
  , getProgName
  )
import System.Exit
  ( exitFailure )
import qualified System.FilePath as FilePath
import qualified Paths_ipclib as Paths -- Automagically generated by cabal
{- External Library Modules Imported -}
import qualified Control.Concurrent as Concurrent
import qualified Graphics.Rendering.Chart as Chart
import qualified Graphics.Rendering.Chart.Renderable as Render
import qualified Graphics.Rendering.Chart.Types as ChartTypes
import qualified Graphics.UI.Gtk as Gtk
import qualified Graphics.UI.Gtk.Glade as Glade
import qualified System.Glib as Glib
import Text.ParserCombinators.Parsec as Parsec
{- Local Modules Imported -}
-- import qualified Language.Pepa.QualifiedName as Qualified
import qualified Language.Pepa.Parser as PepaParser
import qualified Language.Pepa.MainControl as MainControl
import Language.Pepa.MainControl
  ( MainControl
  , MainControlT
  , IOMainControl
  )
import Language.Ptrees.Syntax
  ( Ptree           ( .. )
  , Result          ( .. )
  , ModelTree       ( .. )
  , ModelFile       ( .. )
  , PassageQuery    ( .. )
  , PassageTimes    ( .. )
  , SteadyQuery     ( .. )
  , EventTree       ( .. )
  , Time
  )
import qualified Language.Ptrees.Print as PtreePrint
import qualified Language.Ptrees.Evaluate as PtreeEval
import Language.Ptrees.Evaluate
  ( evaluateRootPtree )
import qualified Language.Pepa.Compile.Uniformise as Uniformise
import Ipc.DrawGraph
  ( SimpleLine      ( .. )
  , Graph
  , makeSimpleGraph
  )
import Gipc.DrawGraph
  ( renderSimpleLineGraph )
{- End of Imports -}

data CliFlag =
    CliHelp
  | CliVersion
  deriving Eq


gipcOptions :: [ OptDescr CliFlag ]
gipcOptions =
  [ Option   "h"     [ "help" ]
    (NoArg CliHelp)
    "Print the help message to standard out and then exit"

  , Option   "v"     [ "version" ]
    (NoArg CliVersion)
    "Print out the version of this program"
  ]

helpMessage :: String -> String
helpMessage progName =
  usageInfo progName gipcOptions

versionMessage :: String -> String
versionMessage progName = 
  progName ++ ": This is version " ++ versionString

versionString :: String
versionString = "0.1"

-- | The main exported function
main :: IO ()
main = getArgs >>= processOptions

processOptions :: [ String ] -> IO ()
processOptions cliArgs =
  case getOpt Permute  gipcOptions cliArgs of
    (flags, args, [])       -> 
      processArgs flags args
    (_flags, _args, errors) -> 
      do progName <- getProgName
         ioError $ userError (concat errors ++ helpMessage progName)

-- We assume all of the arguments are files to process
processArgs :: [ CliFlag ] -> [ String ] -> IO ()
processArgs flags files
  | elem CliHelp flags    = getProgName >>= (putStrLn . helpMessage)
  | elem CliVersion flags = getProgName >>= (putStrLn . versionMessage)
  | otherwise             = startGui files

startGui :: [ FilePath ] -> IO ()
startGui files =
  do Gtk.initGUI                  -- Initialize GTK+ engine

     -- Every so often, we try to run other threads.
     Gtk.timeoutAddFull (Concurrent.yield >> return True)
                               Gtk.priorityDefaultIdle 100

     -- Load the GUI from the Glade file
     gladePath <- getGladeFile
     gui       <- loadGlade gladePath

     -- Set up our events 
     connectGui gui

     -- Load the files given on the command-line into the gui
     mapM_ (loadFileIntoGui gui) files

     -- Create the main start page and prepend it to the notebook.
     let notebook = guiNoteBook gui
     mainPage <- createMainPage gui
     mainIndex <- Gtk.notebookPrependPage notebook mainPage "Welcome"
     Gtk.widgetShowAll notebook
     Gtk.notebookSetCurrentPage notebook mainIndex

     -- However, if there are any files loaded via the command-line
     -- the user probably wants to start at the first one so we
     -- move to the next page, not that nothing happens if we are on
     -- the last page (ie if there are no files loaded)
     Gtk.notebookNextPage notebook 

     -- Run the GTK+ main loop; exits after GUI is done
     Gtk.mainGUI
  where
  getGladeFile :: IO FilePath
  getGladeFile =
    do local <- Directory.doesFileExist "Gipc/gipc.glade"
       -- Bit of hack this, but basically if we look like
       -- we're running things locally in the ipclib source
       -- directory then use the source's glade file.
       -- This means we can run the development version without 
       -- installing each time we update the glade file.
       if local
          then return "Gipc/gipc.glade"
          else Paths.getDataFileName "gipc.glade"

loadGlade :: FilePath -> IO GuiMain
loadGlade gladepath =
  Glade.xmlNew gladepath >>= loadGui

loadGui :: Maybe Glade.GladeXML -> IO GuiMain
loadGui Nothing    =
  do putStrLn "Sorry glade file could not be loaded, serious error"
     exitFailure
loadGui (Just xml) =
  do -- Load main window
     mainWindow   <- getWidget Gtk.castToWindow "mainWindow"

     -- Load the notebook, we will add result pages to this.
     notebook     <- getWidget Gtk.castToNotebook "mainNoteBook"
     
     -- Load the about dialog box.
     aboutDialog  <- getWidget Gtk.castToAboutDialog "ipcAboutDialog"
     Gtk.aboutDialogSetVersion aboutDialog versionString

     -- Load the main menu
     menuOpen     <- getMenuItem "open1"
     menuQuit     <- getMenuItem "quit1"
     menuAbout    <- getMenuItem "ipcMainAbout"
     let mainMenu = GipcMenu { gmenuOpen  = menuOpen
                             , gmenuQuit  = menuQuit
                             , gmenuAbout = menuAbout
                             }

     return GuiMain { guiMainWin      = mainWindow
                    , guiMainMenu     = mainMenu
                    , guiNoteBook     = notebook
                    , guiAboutDialog  = aboutDialog
                    }
  where
  getWidget :: Gtk.WidgetClass widget => 
               (Glib.GObject -> widget) -> String -> IO widget
  getWidget = Glade.xmlGetWidget xml

  getMenuItem :: String -> IO Gtk.MenuItem
  getMenuItem = Glade.xmlGetWidget xml Gtk.castToMenuItem 

connectGui :: GuiMain -> IO ()
connectGui gui =
  do -- When the close button is clicked, terminate GUI loop
     -- by calling GTK mainQuit function
     Gtk.onDestroy mainWindow Gtk.mainQuit

     -- The Main Menu items
     -- Selecting 'Open from the menu'
     Gtk.onActivateLeaf (gmenuOpen gmenu) $ openOpenFileDialog gui
     -- Selecting 'Quit' from the menu
     Gtk.onActivateLeaf (gmenuQuit gmenu) Gtk.mainQuit
     -- Selecting 'About' from the help menu
     Gtk.onActivateLeaf (gmenuAbout gmenu) $ openAboutDialog gui

     -- The notebook set up
     -- Gtk.onSwitchPage (guiNoteBook gui)  (putStrLn . ((++)"Page: ") . show)

     -- We leave the status window buttons for later
     return ()
  where
  mainWindow = guiMainWin  gui
  gmenu      = guiMainMenu gui



-- | Our main GUI type
data GuiMain = 
  GuiMain { guiMainWin      :: Gtk.Window
          , guiMainMenu     :: GipcMenu
          , guiNoteBook     :: Gtk.Notebook

          , guiAboutDialog  :: Gtk.AboutDialog
          }

data GipcMenu =
  GipcMenu { gmenuOpen  :: Gtk.MenuItem
           , gmenuQuit  :: Gtk.MenuItem
           , gmenuAbout :: Gtk.MenuItem
           }



openOpenFileDialog :: GuiMain -> IO ()
openOpenFileDialog gui = 
  do dialog <- Gtk.fileChooserDialogNew
               (Just "Choose a model or ptree file") -- dialog title
               (Just parentWindow)                   -- The parent window
               Gtk.FileChooserActionOpen             -- The kind of dialog
               [ ( "gtk-cancel"                      -- The buttons to display
                 , Gtk.ResponseCancel)
               , ( "gtk-open"                                  
                 , Gtk.ResponseAccept)
               ]
     -- Show and run the dialog to obtain the response from the user.
     Gtk.widgetShow dialog
     response <- Gtk.dialogRun dialog
     -- Hide the dialog box, we do this before we decide what to do
     -- with the response on the basis that whatever we do may take
     -- quite a while.
     Gtk.widgetHide dialog
     -- Finally decide what to do based on the response and do it.
     makeResponse dialog response
  where
  parentWindow = guiMainWin gui

  makeResponse :: Gtk.FileChooserDialog -> Gtk.ResponseId -> IO ()
  makeResponse dialog (Gtk.ResponseAccept)       =
    do mFileName <- Gtk.fileChooserGetFilename dialog
       case mFileName of
         Just fileName -> loadFileIntoGui gui fileName
         Nothing       -> putStrLn "Very strange accept but not filename"
  makeResponse _dialog (Gtk.ResponseCancel)      =
    putStrLn "dialog canceled"
  makeResponse _dialog (Gtk.ResponseDeleteEvent) =
    putStrLn "dialog closed"  
  makeResponse _dialog _unknownReponse           =
    putStrLn "Very strange, and unknown reponse from the file open dialog"


openAboutDialog :: GuiMain -> IO ()
openAboutDialog gui =
  do -- Show and run the dialog to obtain the response from the user.
     Gtk.widgetShow dialog
     _response <- Gtk.dialogRun dialog
     -- Hide the dialog box, we do this before we decide what to do
     -- with the response on the basis that whatever we do may take
     -- quite a while.
     Gtk.widgetHide dialog
     -- Finally decide what to do based on the response and do it.
     -- Except here the response is always the same, just to close
     -- the about dialog.
     return ()
  where
  dialog = guiAboutDialog gui

{-
  Loads a file into the gui, if it is a pepa file then we just load
  that into model view. If it is a ptree file then we should set
  all of the measurement options accordingly (this is not as yet
  implemented).
-}
loadFileIntoGui :: GuiMain -> FilePath -> IO ()
loadFileIntoGui gui file
  | extension == ".pepa"  = loadPepa
  | extension == ".ptree" = loadPtree
  | otherwise             = loadPlainFile
  where
  extension = FilePath.takeExtension file
  filename  = FilePath.takeFileName file
  notebook  = guiNoteBook gui
                 
  -- Currently we don't know how to load a ptree file.
  loadPtree     = return ()

  -- For loading a PEPA model we open it up with a text view
  -- and also have a two buttons, one to open up an analysis
  -- tree for that model and one to quickly perform a steady
  -- state analysis.
  loadPepa :: IO ()
  loadPepa =
    do contents  <- readFile file
       hBox      <- Gtk.hBoxNew False 0

       tView     <- Gtk.textViewNew
       tBuffer   <- Gtk.textViewGetBuffer tView
       Gtk.textBufferSetText tBuffer contents

       -- Create a scrolled window so that the user can scroll
       -- the output. Then of course add the text view which
       -- displays the results to the scrolled window
       scrolled  <- Gtk.scrolledWindowNew Nothing Nothing
       Gtk.containerAdd scrolled tView
       Gtk.scrolledWindowSetPolicy scrolled Gtk.PolicyAutomatic 
                                            Gtk.PolicyAutomatic
       Gtk.scrolledWindowSetShadowType scrolled Gtk.ShadowIn
       -- Add the scrolled window to the hbox
       Gtk.boxPackStart hBox scrolled Gtk.PackGrow 0

       -- We now create a vertical button box
       buttonBox <- Gtk.vButtonBoxNew
       -- Add it to the hbox
       Gtk.boxPackStart hBox buttonBox Gtk.PackNatural 0

       -- Now we add the buttons to the button box
       -- the analyse button which will open a new Ptree
       -- editor with the file as the model.
       analyse   <- Gtk.buttonNewWithLabel "Analyse"
       Gtk.onClicked analyse clickAnalyse
       Gtk.containerAdd buttonBox analyse

       -- A steady-state analysis button to simply perform
       -- steady-state analysis without the need for opening
       -- up a performance tree editing widget.
       steady    <- Gtk.buttonNewWithLabel "Steady"
       Gtk.onClicked steady $ clickSteady tBuffer
       Gtk.containerAdd buttonBox steady

       -- A save button to save the model to the file
       save   <- Gtk.buttonNewWithLabel "Save"
       Gtk.onClicked save $ clickSave tBuffer
       Gtk.containerAdd buttonBox save
       

       -- Insert the new page into the notebook
       pageIndex <- Gtk.notebookAppendPage notebook hBox filename
       -- We must show all the widgets in the notebook for the new
       -- page to appear and furthermore we must do this before we
       -- attempt to set the new current page otherwise doing so
       -- will not work.
       Gtk.widgetShowAll notebook
       Gtk.notebookSetCurrentPage notebook pageIndex

  clickAnalyse :: IO ()
  clickAnalyse =
    do ptreePage  <- createNewPtreePage gui (Just file)
       -- Add the vbox as a new page in the main note book.
       ptreeIndex <- Gtk.notebookAppendPage notebook ptreePage "Ptree"
       Gtk.widgetShowAll notebook
       Gtk.notebookSetCurrentPage notebook ptreeIndex

  clickSteady :: Gtk.TextBuffer -> IO ()
  clickSteady tBuffer =
    do modelText   <- Gtk.get tBuffer Gtk.textBufferText
       let mPtree   = 
             do model <- PepaParser.mainControlParse 
                             PepaParser.pepaFile modelText
                return $ Psteady
                         SteadyQuery { steadyModel = Mmodel NoFile model }
       evaluateAndDisplay gui mPtree

  clickSave :: Gtk.TextBuffer -> IO ()
  clickSave tBuffer =
    Gtk.get tBuffer Gtk.textBufferText >>=
    writeFile file

  loadPlainFile :: IO ()
  loadPlainFile =
    do contents  <- readFile file
       hBox      <- Gtk.hBoxNew False 0

       tView     <- Gtk.textViewNew
       tBuffer   <- Gtk.textViewGetBuffer tView
       Gtk.textBufferSetText tBuffer contents

       -- Create a scrolled window so that the user can scroll
       -- the output. Then of course add the text view which
       -- displays the results to the scrolled window
       scrolled  <- Gtk.scrolledWindowNew Nothing Nothing
       Gtk.containerAdd scrolled tView
       Gtk.scrolledWindowSetPolicy scrolled Gtk.PolicyAutomatic 
                                            Gtk.PolicyAutomatic
       Gtk.scrolledWindowSetShadowType scrolled Gtk.ShadowIn
       -- Add the scrolled window to the hbox
       Gtk.boxPackStart hBox scrolled Gtk.PackGrow 0

       -- We now create a vertical button box
       buttonBox <- Gtk.vButtonBoxNew
       -- Add it to the hbox
       Gtk.boxPackStart hBox buttonBox Gtk.PackNatural 0

       -- Now we add the buttons to the button box
       -- the analyse button which will open a new Ptree
       -- editor with the file as the model.
       save   <- Gtk.buttonNewWithLabel "Save"
       Gtk.onClicked save $ clickSave tBuffer
       Gtk.containerAdd buttonBox save
       


       -- Insert the new page into the notebook
       pageIndex <- Gtk.notebookAppendPage notebook hBox filename
       -- We must show all the widgets in the notebook for the new
       -- page to appear and furthermore we must do this before we
       -- attempt to set the new current page otherwise doing so
       -- will not work.
       Gtk.widgetShowAll notebook
       Gtk.notebookSetCurrentPage notebook pageIndex

{-
  Note that this just create the new main page it does not actually
  add it to the notebook. Maybe it should?
-}
createMainPage :: GuiMain -> IO Gtk.Widget
createMainPage gui =
  do vBox       <- Gtk.vBoxNew False 0

     drawArea   <- Gtk.drawingAreaNew
     -- This is wrong it is causing us to be small in the case that the
     -- window is larger than the requested size.
     Gtk.onSizeRequest drawArea $ return (Gtk.Requisition 300 300)
     Gtk.onExpose drawArea $ drawPepaCombinator drawArea
     Gtk.boxPackStart vBox drawArea Gtk.PackGrow 0

     -- Create the edit file button
     hBox       <- Gtk.hBoxNew True 0
     Gtk.boxPackStart vBox hBox Gtk.PackNatural 0
     editFile   <- Gtk.buttonNewWithLabel "Edit File"
     -- And attach the click event to opening an open file dialog
     Gtk.onClicked editFile $ openOpenFileDialog gui

     -- Create the analyse model button
     Gtk.boxPackStart hBox editFile Gtk.PackNatural 0
     analyse    <- Gtk.buttonNewWithLabel "Analyse Model"
     Gtk.boxPackStart hBox analyse Gtk.PackNatural 0

     -- Now attach the click event to generating a new ptree
     -- viewing page in the notebook.
     Gtk.onClicked analyse clickAnalyse

     return $ Gtk.castToWidget vBox
  where
  notebook = guiNoteBook gui

  clickAnalyse :: IO ()
  clickAnalyse =
    do ptreePage  <- createNewPtreePage gui Nothing
       -- Add the vbox as a new page in the main note book.
       ptreeIndex <- Gtk.notebookAppendPage notebook ptreePage "Ptree"
       Gtk.widgetShowAll notebook
       Gtk.notebookSetCurrentPage notebook ptreeIndex



drawPepaCombinator :: Gtk.DrawingArea -> a -> IO Bool -- Gtk.EventExpose -> IO Bool
drawPepaCombinator canvas _event =
  do win            <- Gtk.widgetGetDrawWindow canvas
     (width,height) <- Gtk.widgetGetSize canvas
     gc             <- Gtk.gcNew win
     let newValues = Gtk.newGCValues { Gtk.foreground = Gtk.Color 65535 0 0
                                     , Gtk.capStyle   = Gtk.CapRound
                                     -- The linewidth should depend on the height
                                     -- and width of the drawing area.
                                     , Gtk.lineWidth  = 10
                                     , Gtk.joinStyle  = Gtk.JoinRound
                                     }
         halfH     = div height 2
         twoThirdW = thirdW * 2
         thirdW    = div width 3
     Gtk.gcSetValues gc newValues
     -- Draw the left hand triangle
     Gtk.drawLines win gc [ (30, 30)
                          , (twoThirdW, halfH)
                          , (30, height - 30 )
                          , (30, 30)
                          ]
     -- Draw the right hand triangle
     Gtk.drawLines win gc [ (width - 30, 30)
                          , (thirdW, halfH)
                          , (width - 30, height - 30)
                          , (width - 30, 30)
                          ] 
     return True


createNewPtreePage :: GuiMain -> Maybe FilePath -> IO Gtk.Widget
createNewPtreePage gui mFileName =
     -- Create a vbox for the button and the ptree
     -- editor to go in.
  do vBox         <- Gtk.vBoxNew False 0
     -- Create a button and scrolled window to hold the
     -- ptree editor pane and add them both to the vbox
     resultButton <- Gtk.buttonNewWithLabel "Get Results"
     scrolled     <- Gtk.scrolledWindowNew Nothing Nothing
     Gtk.scrolledWindowSetPolicy scrolled 
                                 Gtk.PolicyAutomatic -- horizontal policy
                                 Gtk.PolicyAutomatic -- vertical policy
     Gtk.boxPackStart vBox resultButton Gtk.PackNatural 0
     Gtk.boxPackStart vBox scrolled     Gtk.PackGrow    0
     -- Create a view port to be the child of the scrolled window
     horAdjust    <- Gtk.adjustmentNew 0.0   -- default adjustment
                                       0.0   -- minimum
                                       1000  -- maximum
                                       10.0  -- step increment
                                       50.0  -- page increment
                                       100.0 -- page size
     vertAdjust   <- Gtk.adjustmentNew 0.0   -- default adjustment
                                       0.0   -- minimum
                                       10000 -- maximum
                                       10.0  -- step increment
                                       50.0  -- page increment
                                       100.0 -- page size
     vport        <- Gtk.viewportNew horAdjust vertAdjust 
     Gtk.containerAdd scrolled vport

     -- Of course we should create a widget which allows the
     -- user to select what kind of analysis they wish to perform
     -- but for now we will enforce passage-time and create a
     -- passage-time performance tree widget.
     passage      <- createPassageTree mFileName
     
     -- Then we of course must add the passage-tree as a child
     -- of the viewport within the scrolled window.
     Gtk.containerAdd vport passage
    
     -- Connect the pressing of the get result into a function
     -- to get the performance tree and print the results.
     Gtk.onClicked resultButton $ clickResults passage

     return $ Gtk.castToWidget vBox
  where


  -- The function to call if we click 'Get Results'
  -- The argument is the root of the ptree.
  clickResults :: Gtk.Widget -> IO ()
  clickResults ptreeRoot =
    MainControl.runMainControlT iomPtree >>=
    evaluateAndDisplay gui
    where
    iomPtree = getPerformanceTree [ ptreeRoot ]



{-
generateAndDisplay :: GuiMain -> IO ()
generateAndDisplay gui =
  do ptreeResult <- createPerformanceTree gui
     evaluateAndDisplay gui ptreeResult
-}

evaluateAndDisplay :: GuiMain -> MainControl Ptree -> IO ()
evaluateAndDisplay gui ptreeResult =
  output >>= MainControl.closeMainControlWith successFun failureFun
  where
  output :: IO (MainControl Result)
  output   = MainControl.runMainControlT $ 
             (MainControl.liftMC ptreeResult) >>= 
             (PtreeEval.evaluateRootPtree Nothing options)
  options  = []
  notebook = guiNoteBook gui

  successFun ::  Result -> IO ()
  successFun (PassageResult pt) =
    do createNewGraphPage gui "pdf result" pdfGraph
       createNewGraphPage gui "cdf result" cdfGraph
    where
    pdfGraph      = makeSimpleGraph pdfGraphTitle [] pdfGraphLines
    pdfGraphTitle = Just "Probability density function graph"
    pdfGraphLines = [ SimpleLine { simpleLineTitle  = Just "pdf"
                                 , simpleLinePoints = Uniformise.pdfResult pt
                                 , simpleLineWidth  = lineWidth
                                 }
                    ]

    cdfGraph      = makeSimpleGraph cdfGraphTitle [] cdfGraphLines
    cdfGraphTitle = Just "Cumulative distribution function graph"
    cdfGraphLines = [ SimpleLine { simpleLineTitle  = Just "cdf"
                                 , simpleLinePoints = Uniformise.cdfResult pt
                                 , simpleLineWidth  = lineWidth
                                 }
                    ]
    lineWidth     = 2.0

  -- Slight fail here if the filepath is not set to Nothing
  -- then we should output the graph to a file but we of
  -- course just display it in a new window bit.
  successFun (GraphResult graph _nothing) =
    createNewGraphPage gui "graph results" graph
  successFun result =
    do  -- Create the text view which will hold the output.
       tView     <- Gtk.textViewNew
       tBuffer   <- Gtk.textViewGetBuffer tView
       Gtk.textBufferSetText tBuffer outputString

       -- Create a scrolled window so that the user can scroll
       -- the output. Then of course add the text view which
       -- displays the results to the scrolled window
       scrolled <- Gtk.scrolledWindowNew Nothing Nothing
       Gtk.scrolledWindowSetPolicy scrolled Gtk.PolicyAutomatic 
                                            Gtk.PolicyAutomatic
       Gtk.scrolledWindowSetShadowType scrolled Gtk.ShadowIn
       Gtk.containerAdd scrolled tView

       -- Insert the new page into the notebook
       pageIndex <- Gtk.notebookAppendPage notebook scrolled "Results"
       -- We must show all the widgets in the notebook for the new
       -- page to appear and furthermore we must do this before we
       -- attempt to set the new current page otherwise doing so
       -- will not work.
       Gtk.widgetShowAll notebook
       Gtk.notebookSetCurrentPage notebook pageIndex
    where
    outputString = PtreePrint.hprintResult result

  failureFun :: String -> IO ()
  failureFun outputString = 
    do  -- Create the text view which will hold the output.
       tView     <- Gtk.textViewNew
       tBuffer   <- Gtk.textViewGetBuffer tView
       Gtk.textBufferSetText tBuffer outputString

       -- Create a scrolled window so that the user can scroll
       -- the output. Then of course add the text view which
       -- displays the results to the scrolled window
       scrolled <- Gtk.scrolledWindowNew Nothing Nothing
       Gtk.containerAdd scrolled tView
       Gtk.scrolledWindowSetPolicy scrolled Gtk.PolicyAutomatic 
                                            Gtk.PolicyAutomatic
       Gtk.scrolledWindowSetShadowType scrolled Gtk.ShadowIn

       -- Insert the new page into the notebook
       pageIndex <- Gtk.notebookAppendPage notebook scrolled "Errors"
       -- We must show all the widgets in the notebook for the new
       -- page to appear and furthermore we must do this before we
       -- attempt to set the new current page otherwise doing so
       -- will not work.
       Gtk.widgetShowAll notebook
       Gtk.notebookSetCurrentPage notebook pageIndex


{-
  Creates a new page in the main note book showing the given graph.
  The user must supply the graph plus the title of the notebook page.
-}
createNewGraphPage :: GuiMain    -- ^ The main gui
                   -> String     -- ^ The title of the new notebook page
                   -> Graph      -- ^ The graph to render
                   -> IO ()      -- ^ The io action returned
createNewGraphPage gui pagetitle graph =
     -- Create the drawing area on which to draw the pdf graph
  do canvas     <- Gtk.drawingAreaNew
     -- And connect its expose event to updating the canvas with the graph
     _connectID <- Gtk.onExpose canvas $ const (updateCanvas canvas)

     -- Create a view port to be the child of the scrolled window
     -- it is to the view port that we will add the drawingarea
     horAdjust    <- Gtk.adjustmentNew 0.0   -- default adjustment
                                       0.0   -- minimum
                                       1000  -- maximum
                                       10.0  -- step increment
                                       50.0  -- page increment
                                       100.0 -- page size
     vertAdjust   <- Gtk.adjustmentNew 0.0   -- default adjustment
                                       0.0   -- minimum
                                       10000 -- maximum
                                       10.0  -- step increment
                                       50.0  -- page increment
                                       100.0 -- page size
     vport        <- Gtk.viewportNew horAdjust vertAdjust 
     -- so add the canvas to the vport
     Gtk.containerAdd vport canvas


     -- Create a vbox into which to put both the graphs
     -- vBox       <- Gtk.vBoxNew False 0
     -- Gtk.boxPackStart vBox canvas Gtk.PackNatural 0

     -- Create a scrolled window so that the user can scroll
     -- the output. Then of course add the text view which
     -- displays the results to the scrolled window
     scrolled <- Gtk.scrolledWindowNew Nothing Nothing
     Gtk.scrolledWindowSetPolicy scrolled Gtk.PolicyAutomatic 
                                          Gtk.PolicyAutomatic
     Gtk.scrolledWindowSetShadowType scrolled Gtk.ShadowIn
     -- add the viewport containing the canvas to the scrolled window.
     Gtk.containerAdd scrolled vport     

     -- Insert the new page into the notebook
     pageIndex <- Gtk.notebookAppendPage notebook scrolled pagetitle
     -- We must show all the widgets in the notebook for the new
     -- page to appear and furthermore we must do this before we
     -- attempt to set the new current page otherwise doing so
     -- will not work.
     Gtk.widgetShowAll notebook
     Gtk.notebookSetCurrentPage notebook pageIndex
    where
    notebook   = guiNoteBook gui
    renderable = renderSimpleLineGraph graph    

    updateCanvas :: Gtk.DrawingArea  -> IO Bool
    updateCanvas canvas = 
      do win             <- Gtk.widgetGetDrawWindow canvas
         (width, height) <- Gtk.widgetGetSize canvas
         {- 
         let rect = Chart.Rect (Chart.Point 0 0) 
                               (Chart.Point (fromIntegral width) 
                                            (fromIntegral height)
                               )
         -}
         let rectSize =  ((fromIntegral width), (fromIntegral height))
             -- Hmm, the graph that we render is nestled away in here
             -- this somehow seems like questionable code, but there you
             -- have it.
             rendered  = Chart.render renderable rectSize
             runRender = ChartTypes.runCRender rendered Render.bitmapEnv
         Gtk.renderWithDrawable win runRender
         return True

{-
  This acts very much like a parser for performance trees but
  a parser over the gtk widgets. This may be something for which
  the underlying implementation is worthy of a library.
-}
getPerformanceTree :: [ Gtk.Widget ] -> IOMainControl Ptree
getPerformanceTree widgets =
  do names <- Trans.liftIO $ mapM Gtk.widgetGetName widgets
     case (widgets, names) of
       ([ child ], [ "Passage" ])  -> liftM Ppassage $ getPassageTree child
       _                           -> fail ptreeError
  where
  ptreeError     = "Cannot compose performance tree"



{-
  Get the children of a given widget. Be careful we cast this to a
  container widget it, so this may only be called with a widget that
  is, ultimately, a container.
-}
getChildren :: Gtk.Widget -> IOMainControl [ Gtk.Widget ]
getChildren =
  Trans.liftIO . Gtk.containerGetChildren . Gtk.castToContainer

{- This is simply 'lookup' which has been lifted into the IOMainControl
    monad. Given a list of named widgets (that is a list of pairs of names
    and widgets) return the widget that is mapped to the given name.
    Note that there is no IO going on here, we have already named all of
    the widgets, so this is simply a lookup into that pair.
-}
getChildNamed :: String -> [ (String, Gtk.Widget) ] 
              -> IOMainControl Gtk.Widget
getChildNamed name namedChildren =
  case lookup name namedChildren of
    Nothing -> fail ("No child named: " ++ name)
    Just e  -> return e

       
{-
  Given a list of widgets pair each widget with its name.
-}
nameWidgets :: [ Gtk.Widget ] -> IO [ (String, Gtk.Widget) ]
nameWidgets = 
  mapM nameChild
  where
  nameChild :: Gtk.Widget -> IO (String, Gtk.Widget)
  nameChild w = do n <- Gtk.widgetGetName w
                   return (n, w)



-- Get the passage-time query represented by a passage-time
-- query performance tree widget.
getPassageTree :: Gtk.Widget -> IOMainControl PassageQuery
getPassageTree child =
     -- Obviously the pattern matching here is less than desired.
  do [ vBox, _label ] <- getChildren child
     children         <- getChildren vBox
     namedChildren    <- Trans.liftIO $ nameWidgets children

     startWidget      <- getChildNamed "startActs" namedChildren
     sourceEvent      <- getEventsTree startWidget

     stopWidget       <- getChildNamed "stopActs" namedChildren
     targetEvent      <- getEventsTree stopWidget

     modelWidget      <- getChildNamed "passageModel" namedChildren
     modelTree        <- getModelTree modelWidget

     timesWidget      <- getChildNamed "passageTimes" namedChildren
     timesTree        <- getTimesTree timesWidget

     return PassageQuery { passageModel  = modelTree
                         , passageSource = sourceEvent
                         , passageTarget = targetEvent
                         , passageTimes  = timesTree
                         }

  -- Create a passage-time analysis performance tree child.
  -- Clearly this should be elsewhere as we will need it
  -- if the user needs to make a child of say an experimentation
  -- tree.
createPassageTree :: Maybe FilePath -> IO Gtk.Widget
createPassageTree mFileName =
  do -- Create the passage expander
     passageExpand <- Gtk.expanderNew "Passage"
     Gtk.widgetSetName passageExpand "Passage"
     -- Now we will have several children of a passage-time
     -- query tree so we will need a vbox to contain them.
     passageVBox   <- Gtk.vBoxNew False 0 


     -- Create the widget for specifying the source events
     startActs     <- createEventsTreeWidget "source:" "startActs" "start"
     -- And add it to the passage vbox
     Gtk.boxPackStart passageVBox startActs Gtk.PackNatural 0

     -- Create the widget for specifying the target events
     stopActs      <- createEventsTreeWidget "target:" "stopActs" "stop"
     -- And add it to the passage vbox
     Gtk.boxPackStart   passageVBox stopActs  Gtk.PackNatural 0

     -- Create the widget for defining a model tree
     modelTree     <- createModelTreeWidget "passageModel" mFileName
     -- and add it to the passage-vbox
     Gtk.boxPackStart  passageVBox modelTree Gtk.PackNatural 0

     -- Now we create three entry fields for the timing information.
     -- That is the start and stop times and the time step.
     timeTree      <- createTimesTreeWidget "passageTimes"
     -- and add it to the passage-vbox
     Gtk.boxPackStart passageVBox timeTree Gtk.PackNatural 0


     -- All of the children have been added to the passage vbox
     -- so the only thing left to do is to make the passage-vbox
     -- THE child of the expander so we see all the children when
     -- we expand the passage-tree.
     Gtk.containerAdd passageExpand passageVBox

     return $ Gtk.castToWidget passageExpand

getEventsTree :: Gtk.Widget -> IOMainControl EventTree
getEventsTree =
  getTextEntryTree "eventsentry" (MainControl.liftMC . actionListParser)
  where
  actionListParser :: String -> MainControl EventTree
  actionListParser = 
    PepaParser.mainControlParse $
    liftM Eactions
    (Parsec.sepBy PepaParser.pepaActionId PepaParser.comma)


{-
  Create an events tree widget with the given name and default value.
-}
createEventsTreeWidget :: String        -- ^ The label to show the user
                       -> String        -- ^ The name of the widget
                       -> String        -- ^ The default value
                       -> IO Gtk.Widget -- ^ The returned widget
createEventsTreeWidget labelString =
  createTextEntryWidget labelString "eventsentry"


getTimesTree :: Gtk.Widget -> IOMainControl PassageTimes
getTimesTree widget =
     -- Obviously the pattern matching here is less than desired.
     -- I should have a generic function to create and get the child
     -- of an expander.
  do [ vBox, _label ] <- getChildren widget
     children         <- getChildren vBox
     namedChildren    <- Trans.liftIO $ nameWidgets children

     startWidget      <- getChildNamed "start-time" namedChildren
     startTime        <- getSingleTimeTree startWidget

     stopWidget       <- getChildNamed "stop-time" namedChildren
     stopTime         <- getSingleTimeTree stopWidget

     stepWidget       <- getChildNamed "time-step" namedChildren
     timeStep         <- getSingleTimeTree stepWidget
     return PassageTimes { passageStartTime = startTime
                         , passageStopTime  = stopTime
                         , passageTimeStep  = timeStep
                         }

createTimesTreeWidget :: String  -- ^ The name to give the time tree widget
                      -> IO Gtk.Widget
createTimesTreeWidget widgetName =
  do -- Create the times expander
     timesExpand   <- Gtk.expanderNew "Times"
     Gtk.widgetSetName timesExpand widgetName

     -- Now we will have several children of a times
     -- query tree so we will need a vbox to contain them.
     -- The vbox itself of course must be the child of the expander.
     passageVBox   <- Gtk.vBoxNew False 0 
     Gtk.containerAdd timesExpand passageVBox

     startTime     <- createSingleTimeWidget "start time" "start-time" "0.0"
     Gtk.boxPackStart passageVBox startTime Gtk.PackNatural 0
     stopTime      <- createSingleTimeWidget "stop time" "stop-time" "10.0"
     Gtk.boxPackStart passageVBox stopTime Gtk.PackNatural 0
     timeStep      <- createSingleTimeWidget "time step" "time-step" "1.0"
     Gtk.boxPackStart passageVBox timeStep Gtk.PackNatural 0

     -- Finally return the expander as the widget
     return $ Gtk.castToWidget timesExpand
     

getSingleTimeTree :: Gtk.Widget -> IOMainControl (Maybe Time)
getSingleTimeTree =
  getTextEntryTree "timeentry" (MainControl.liftMC . timeParser)
  where
  timeParser :: String -> MainControl (Maybe Time)
  timeParser =
    PepaParser.mainControlParse
      (PepaParser.wholeParser $ Parsec.optionMaybe PepaParser.forgivingFloat)

createSingleTimeWidget :: String    -- ^ Name of the label to show the user
                       -> String    -- ^ Name of the widget
                       -> String    -- ^ default value
                       -> IO Gtk.Widget -- ^ Returned widget
createSingleTimeWidget labelString =
  createTextEntryWidget labelString "timeentry"

{-
  Generic function to obtain the tree from a text entry tree widget.
  Note *NOT* from a text entry widget, but a text entry tree widget
  which have been created by 'createTextEntryWidget'
-}
getTextEntryTree :: String    
                    -- ^ Name of the text entry child
                 -> (String -> IOMainControl a)
                    -- ^ function to interpret the value from the string
                    -- contained within the text entry field
                 -> Gtk.Widget
                    -- ^ The text entry TREE widget
                 -> IOMainControl a
getTextEntryTree textEntryName interpretString wid =
  do children      <- getChildren wid
     namedChildren <- Trans.liftIO $ nameWidgets children
     textEntry     <- getChildNamed textEntryName namedChildren
     dataString    <- Trans.liftIO (Gtk.entryGetText $ Gtk.castToEntry textEntry)
     interpretString dataString

{-
  Creates a text entry widget with a given label, name and
  default value. We also need a name for the text entry widget
-}
createTextEntryWidget :: String        -- ^ The label to show the user
                      -> String        -- ^ Name of the text entry
                      -> String        -- ^ The name of the widget
                      -> String        -- ^ The default value
                      -> IO Gtk.Widget -- ^ The returned widget
createTextEntryWidget labelString textEntryName name dValue =
     -- Create the hbox to hold both the label and the text entry
  do hBox     <- Gtk.hBoxNew False 0

     -- Create the label and add it to the hbox
     labelWid <- Gtk.labelNew $ Just labelString
     Gtk.boxPackStart hBox labelWid  Gtk.PackNatural 0

     -- Create the text entry, fill in the default value
     -- set its name to 'eventsentry' and finally add it
     -- to the hbox.
     entry    <- Gtk.entryNew     
     Gtk.widgetSetName entry textEntryName
     Gtk.entrySetText entry dValue
     Gtk.boxPackStart hBox entry  Gtk.PackNatural 0

     -- Set the name of the events tree widget, that is
     -- the hbox, to the given name so that it may be
     -- retrieved
     Gtk.widgetSetName hBox name


     -- Finally return the hbox as our widget
     return $ Gtk.castToWidget hBox

{-
  Given a widget which we assume to be a model-tree widget
  retrieve the model tree so represented.
-}
getModelTree :: Gtk.Widget -> IOMainControl ModelTree
getModelTree hbox =
  do children      <- getChildren hbox
     namedChildren <- Trans.liftIO $ nameWidgets children
     mFile         <- getChildNamed "modelFile" namedChildren
     file          <- Trans.liftIO (Gtk.entryGetText $ Gtk.castToEntry mFile)
     model         <- PepaParser.parsePepaFile file
     return $ Mmodel (Stored file) model


{-
  The string is the name to give to the model tree widget
-}
createModelTreeWidget :: String -> Maybe FilePath -> IO Gtk.Widget
createModelTreeWidget name mFileName =
  do -- For the model we want to have an hbox with a
     -- text-entry field for the model file and a button
     -- to choose a model file using an open file dialog.
     modelHBox     <- Gtk.hBoxNew False 0
     Gtk.widgetSetName modelHBox name

     -- Create the text-entry box and, if there is a local
     -- pepa model, then automatically put that as the default
     -- file name.
     modelFile     <- Gtk.entryNew
     Gtk.widgetSetName modelFile "modelFile"
     text          <- case mFileName of
                        -- If a model file has been passed into here then
                        -- we do not care if there is a local pepa model file
                        Just file -> return file
                        -- If not then we check if there is a local pepa model
                        -- assuming that to be likely candidate for the user
                        -- to wish to analyse.
                        Nothing   -> liftM (Maybe.fromMaybe "") 
                                           findLocalPepaFile
     Gtk.entrySetText modelFile text
     -- Add the text entry to the model hbox
     Gtk.containerAdd modelHBox modelFile
     
     -- Then also create a button for selecting a file and add
     -- that to the model hbox
     button <- Gtk.buttonNewWithLabel "Choose"
     Gtk.boxPackStart modelHBox button Gtk.PackNatural 0
     -- Set up the handler for the 'choose' button
     Gtk.onClicked button $ openModelFileDialog modelFile

     return $ Gtk.castToWidget modelHBox

  where
  -- The entry widget is the text-entry widget to fill with the
  -- chosen file name.
  openModelFileDialog :: Gtk.Entry -> IO ()
  openModelFileDialog entry = 
    do dialog <- Gtk.fileChooserDialogNew
                 (Just "Choose a PEPA model file") -- dialog title
                 Nothing                           -- The parent window
                 Gtk.FileChooserActionOpen         -- The kind of dialog
                 [ ( "gtk-cancel"                  -- The buttons to display
                   , Gtk.ResponseCancel)
                 , ( "gtk-open"                                  
                   , Gtk.ResponseAccept)
                 ]
       -- Show and run the dialog to obtain the response from the user.
       Gtk.widgetShow dialog
       response <- Gtk.dialogRun dialog
       -- Hide the dialog box, we do this before we decide what to do
       -- with the response on the basis that whatever we do may take
       -- quite a while.
       Gtk.widgetHide dialog
       -- Finally decide what to do based on the response and do it.
       case response of
         (Gtk.ResponseAccept)      -> 
           Gtk.fileChooserGetFilename dialog >>= 
               maybe (putStrLn "Very strange accept but not filename")
                     (Gtk.entrySetText entry)
         (Gtk.ResponseCancel)      ->
            putStrLn "dialog canceled"
         (Gtk.ResponseDeleteEvent) ->
            putStrLn "dialog closed"  
         (_)                       ->
            putStrLn "Very strange, unknown reponse from the file open dialog"


findLocalPepaFile :: IO (Maybe FilePath)
findLocalPepaFile =
  Directory.getCurrentDirectory >>= getAnyFileWithExt ".pepa"

getAnyFileWithExt :: String -> FilePath -> IO (Maybe FilePath)
getAnyFileWithExt ext directory =
  do dirExists <- Directory.doesDirectoryExist directory
     if dirExists
        then do contents <- Directory.getDirectoryContents directory
                return $ List.find (List.isSuffixOf ext) contents
        else return Nothing