{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# Language PackageImports #-}

-- | This is an experimental and unstable interface for
-- generating a GUI for getting/setting options.
module SetHo
       ( runSetter
       ) where

import qualified GHC.Stats

import Accessors.Dynamic ( DTree )
import qualified Control.Concurrent as CC
import Control.Monad.IO.Class ( liftIO )
import qualified Data.ByteString.Lazy as BSL
import Data.IORef ( newIORef, readIORef, writeIORef )
import Data.Serialize ( encodeLazy, decodeLazy )
import "gtk3" Graphics.UI.Gtk ( AttrOp( (:=) ) )
import qualified "gtk3" Graphics.UI.Gtk as Gtk
import Text.Printf ( printf )
import System.Glib.Signals ( on )

import SetHo.LookupTree ( newLookupTreeview )

-- | fire up the the GUI
runSetter :: String -> DTree -> IO (Maybe (Int, DTree)) -> (Int -> IO ()) -> (Int -> DTree -> IO ()) -> IO ()
runSetter rootName initialValue userPollForNewMessage sendRequest userCommit = do
  statsEnabled <- GHC.Stats.getGCStatsEnabled

  counterRef <- newIORef 0
  upstreamCounterRef <- newIORef Nothing

  _ <- Gtk.initGUI
  _ <- Gtk.timeoutAddFull (CC.yield >> return True) Gtk.priorityDefault 50

  -- start the main window
  win <- Gtk.windowNew
  _ <- Gtk.set win [ Gtk.containerBorderWidth := 8
                   , Gtk.windowTitle := "set-ho-matic"
                   ]

  statsLabel <- Gtk.labelNew (Nothing :: Maybe String)
  let makeStatsMessage = do
        statsMsg <- if statsEnabled
               then do
                 stats <- GHC.Stats.getGCStats
                 return $ printf "The current memory usage is %.2f MB"
                   ((realToFrac (GHC.Stats.currentBytesUsed stats) :: Double) /(1024*1024))
               else return "(enable GHC statistics with +RTS -T)"
        counter <- readIORef counterRef
        mupstreamCounter <- readIORef upstreamCounterRef
        let upstreamCount = case mupstreamCounter of
              Nothing -> "?"
              Just r -> show r
            counterMsg = "editing: " ++ show counter ++ " | upstream: " ++ upstreamCount
        return $ "Welcome to set-ho-matic!\n" ++ statsMsg ++ "\n" ++ counterMsg

      statsWorker = do
        CC.threadDelay 500000
        msg <- makeStatsMessage
        Gtk.postGUISync $ Gtk.labelSetText statsLabel msg
        statsWorker

  statsThread <- CC.forkIO statsWorker
  -- on close, kill all the windows and threads
  graphWindowsToBeKilled <- CC.newMVar []

--  channels <- execPlotter plotterMonad
--  let windows = map csMkChanEntry channels
--
--  chanWidgets <- mapM (\x -> x graphWindowsToBeKilled) windows

  let killEverything = do
        CC.killThread statsThread
        _gws <- CC.readMVar graphWindowsToBeKilled
--        mapM_ Gtk.widgetDestroy gws
--        mapM_ csKillThreads channels
        Gtk.mainQuit
  _ <- on win Gtk.deleteEvent $ liftIO (killEverything >> return False)

  --------------- main widget -----------------
  buttonCommit <- Gtk.buttonNewWithLabel "commit"
  buttonAutoCommit <- Gtk.checkButtonNewWithLabel "auto-commit"
  buttonRefresh <- Gtk.buttonNewWithLabel "refresh"
  buttonTakeUpstream <- Gtk.buttonNewWithLabel "take upstream"
  Gtk.widgetSetTooltipText buttonCommit
    (Just "SET ME SET ME GO HEAD DO IT COME ON SET ME")
  Gtk.widgetSetTooltipText buttonAutoCommit
    (Just "Send settings upstream as soon as any value is changed")

  -- the options widget
  options <- Gtk.expanderNew "options"
  Gtk.set options [ Gtk.containerChild := buttonAutoCommit
                  , Gtk.expanderExpanded := True
                  ]


  -- how to commit
  let commit val = do
        counter <- readIORef counterRef
        putStrLn $ "sending settings update " ++ show counter
        writeIORef counterRef (1 + counter)
        makeStatsMessage >>= Gtk.labelSetText statsLabel
        userCommit counter val

  -- the signal selector
  (treeview, getLatestStaged, receiveNewUpstream, takeLatestUpstream, loadFromFile) <-
    newLookupTreeview rootName initialValue (Gtk.toggleButtonGetActive buttonAutoCommit) commit

  treeviewScroll <- Gtk.scrolledWindowNew Nothing Nothing
  Gtk.set treeviewScroll [Gtk.widgetVExpand := True] -- make sure it expands vertically
  Gtk.containerAdd treeviewScroll treeview
  Gtk.set treeviewScroll
    [ Gtk.scrolledWindowHscrollbarPolicy := Gtk.PolicyNever
    , Gtk.scrolledWindowVscrollbarPolicy := Gtk.PolicyAutomatic
    ]

  treeviewExpander <- Gtk.expanderNew "signals"
  Gtk.set treeviewExpander
    [ Gtk.containerChild := treeviewScroll
    , Gtk.expanderExpanded := True
    ]

  let menuBarDescription =
        [ ("_File", [ ("Load", Just (loadFile win loadFromFile))
                    , ("Save", Just (saveFile win getLatestStaged))
                    , ("_Quit", Just Gtk.mainQuit)
                    ]
          )
        , ("Help",  [ ("_Help", Just (help win))
                    ]
          )
        ]

  menuBar <- createMenuBar menuBarDescription

  -- vbox to hold buttons and list of channel
  vbox <- Gtk.vBoxNew False 4
  Gtk.set vbox
    [ Gtk.containerChild := menuBar
    , Gtk.boxChildPacking menuBar := Gtk.PackNatural
    , Gtk.containerChild := statsLabel
    , Gtk.boxChildPacking statsLabel := Gtk.PackNatural
    , Gtk.containerChild := buttonCommit
    , Gtk.boxChildPacking buttonCommit := Gtk.PackNatural
    , Gtk.containerChild := buttonRefresh
    , Gtk.boxChildPacking buttonRefresh := Gtk.PackNatural
    , Gtk.containerChild := buttonTakeUpstream
    , Gtk.boxChildPacking buttonTakeUpstream := Gtk.PackNatural
    , Gtk.containerChild := options
    , Gtk.boxChildPacking options := Gtk.PackNatural
    , Gtk.containerChild := treeviewExpander
    , Gtk.boxChildPacking treeviewExpander := Gtk.PackGrow
    ]

  _ <- on buttonCommit Gtk.buttonActivated $ (getLatestStaged >>= commit)

  _ <- on buttonRefresh Gtk.buttonActivated $ do
    counter <- readIORef counterRef
    putStrLn $ "sending settings request " ++ show counter
    sendRequest counter

  _ <- on buttonTakeUpstream Gtk.buttonActivated takeLatestUpstream

  let pollForNewMessage = do
        mmsg <- userPollForNewMessage
        case mmsg of
          Nothing -> return ()
          Just (upstreamCounter, newVal) -> do
            putStrLn $ "received settings update " ++ show upstreamCounter
            writeIORef upstreamCounterRef (Just upstreamCounter)
            makeStatsMessage >>= Gtk.labelSetText statsLabel
            receiveNewUpstream newVal

  _ <- Gtk.timeoutAddFull (pollForNewMessage >> return True) Gtk.priorityDefault 300

  -- add widget to window and show
  _ <- Gtk.set win [ Gtk.windowTitle := "set-ho-matic 2000"
                   , Gtk.containerChild := vbox
                   ]
  Gtk.widgetShowAll win
  Gtk.mainGUI

createMenuBar :: [( String

                  , [( String
                     , Maybe (IO ())
                     )]
                  )] -> IO Gtk.MenuBar
createMenuBar descr
  = do bar <- Gtk.menuBarNew
       mapM_ (createMenu bar) descr
       return bar
  where
    createMenu bar (name,items)
        = do menu <- Gtk.menuNew
             item <- menuItemNewWithLabelOrMnemonic name
             Gtk.menuItemSetSubmenu item menu
             Gtk.menuShellAppend bar item
             mapM_ (createMenuItem menu) items
    createMenuItem menu (name,action)
        = do item <- menuItemNewWithLabelOrMnemonic name
             Gtk.menuShellAppend menu item
             case action of
               Just act -> on item Gtk.menuItemActivate act
               Nothing  -> on item Gtk.menuItemActivate (return ())
    menuItemNewWithLabelOrMnemonic name
        | elem '_' name = Gtk.menuItemNewWithMnemonic name
        | otherwise     = Gtk.menuItemNewWithLabel name


loadFile :: Gtk.Window -> (DTree -> IO ()) -> IO ()
loadFile win loadData = do
  dialog <- Gtk.fileChooserDialogNew (Just "load settings") (Just win)
            Gtk.FileChooserActionOpen
            [ ("Cancel", Gtk.ResponseCancel)
            , ("Load", Gtk.ResponseAccept)
            ]
  responseId <- Gtk.dialogRun dialog
  case responseId of
    Gtk.ResponseAccept -> do
      mfileName <- Gtk.fileChooserGetFilename dialog
      case mfileName of
        Nothing -> error "fileChooserGetFileName failed on ResponseAccept"
        Just path -> do
          bs <- BSL.readFile path
          case decodeLazy bs of
            Left msg -> errorMsg win ("error decoding " ++ show path ++ "\n" ++ msg)
            Right r -> loadData r >> putStrLn ("loaded " ++ show path)
    _ -> return ()
  Gtk.widgetDestroy dialog


saveFile :: Gtk.Window -> IO DTree -> IO ()
saveFile win getLatestStaged = do
  dialog <- Gtk.fileChooserDialogNew (Just "save settings") (Just win)
            Gtk.FileChooserActionSave
            [ ("Cancel", Gtk.ResponseCancel)
            , ("Save", Gtk.ResponseAccept)
            ]
  Gtk.fileChooserSetDoOverwriteConfirmation dialog True
  responseId <- Gtk.dialogRun dialog
  case responseId of
    Gtk.ResponseAccept -> do
      mfileName <- Gtk.fileChooserGetFilename dialog
      case mfileName of
        Nothing -> error "fileChooserGetFileName failed on ResponseAccept"
        Just fileName -> do
          staged <- getLatestStaged
          BSL.writeFile fileName (encodeLazy staged)
          putStrLn $ "saved settings in " ++ show fileName
    _ -> return ()
  Gtk.widgetDestroy dialog

help :: Gtk.Window -> IO ()
help win = do
  dialog <- Gtk.messageDialogNew (Just win) [Gtk.DialogDestroyWithParent]
            Gtk.MessageInfo Gtk.ButtonsOk
            "There is no help for you here."
  _responseId <- Gtk.dialogRun dialog
  Gtk.widgetDestroy dialog

errorMsg :: Gtk.Window -> String -> IO ()
errorMsg win message = do
  dialog <- Gtk.messageDialogNew (Just win) [Gtk.DialogDestroyWithParent]
            Gtk.MessageError Gtk.ButtonsOk
            message
  _responseId <- Gtk.dialogRun dialog
  Gtk.widgetDestroy dialog