{-# OPTIONS -fglasgow-exts #-}

module Main where

import IO
import HNM.WLAN
import Data.List
import Data.Tree
import System.IO
import Data.IORef
import GHC.IOBase
import Data.Maybe
import System.Exit
import System.Process
import Graphics.UI.Gtk hiding (disconnect)
import System.Directory
import System.IO.Unsafe
import Text.Regex.Posix
import System.Posix.User
import System.Environment
import Control.Concurrent
import Control.Monad.State
import System.Glib.Signals (on)
import Graphics.UI.Gtk.ModelView
import Graphics.UI.Gtk.ModelView.TreeStore
import qualified Graphics.UI.Gtk.Display.StatusIcon as I

--import HNM.Settings

main :: IO Int
main = start =<< getArgs --assu (start =<< getArgs) warn


errorVisual :: String → IO Int
errorVisual msg = do
  warnVisual MessageError ButtonsOk appName msg
  return 1

warn :: IO Int
warn = errorVisual $ "You have to be root to run " ++ appName ++ "!"

warnVisual :: MessageType → ButtonsType → String → String → IO ResponseId
warnVisual mt bt tt msg = do
  putStrLn msg
  initGUI
  windowSetDefaultIconName "gtk-network"
  dlg ← messageDialogNewWithMarkup Nothing [] mt bt msg
  windowSetTitle dlg tt
  onResponse dlg (\_ → widgetDestroy dlg)
  dialogRun dlg


start :: [String] → IO Int
start ["--version"] = do
  printVersion
start ["-V"] = do
  printVersion
start ["--license"] = do
  printLicense
start [] = do
  is ← getInterfaces
  case is of
    [] → errorVisual "No wireless network interfaces."
    _  → withArgs is $ start is
start [interface] = assu (do
  putStrLn interface
  initGUI
  windowSetDefaultIconName "gtk-network"
  icn ← statusIcon
  win ← mainWindowNew
  mainWindow =: win
  taskbarIcon =: icn
  statusIconSetVisible icn True
  mainGUI
  return 0) warn
start [interface,driver] = assu (do
  putStrLn driver
  initHardware driver interface
  start [interface]) warn


interfaceArg :: IO Interface
interfaceArg = return . (\(i:_) → i) =<< getArgs

{-# NOINLINE mainWindow #-}
mainWindow :: IORef Window
mainWindow = unsafePerformIO $ newIORef $ unsafePerformIO mainWindowNew

{-# NOINLINE mainBox #-}
mainBox :: IORef VBox
mainBox = unsafePerformIO $ newIORef undefined

{-# NOINLINE mainView #-}
mainView :: IORef TreeView
mainView = unsafePerformIO $ newIORef undefined

{-# NOINLINE taskbarIcon #-}
taskbarIcon :: IORef StatusIcon
taskbarIcon = unsafePerformIO $ newIORef undefined

{-# NOINLINE mainWindowVisibility #-}
mainWindowVisibility :: IORef Bool
mainWindowVisibility = unsafePerformIO $ newIORef True


(=:) :: IORef a → a → IO a
r =: v = writeIORef r v >> return v

alternateMainWindowVisibility :: IO ()
alternateMainWindowVisibility = do
  vis ← mutateUsing not mainWindowVisibility
  (if vis then widgetShow
          else widgetHide) =<< readIORef mainWindow

mutateUsing :: (a → a) → IORef a → IO a
mutateUsing f r = (r =:) . f =<< x r
  where x = readIORef

(⇆) :: a → a → IO a
c ⇆ d = do
  it ← interfaceArg
  cs ← getConnectionStatus it
  case cs of
    Connected _ _ → return d
    _             → return c

statusIcon :: IO StatusIcon
statusIcon = do
  stc ← stockConnect ⇆ stockDisconnect
  icn ← statusIconNewFromStock stc
  statusIconSetVisible icn True
  statusIconSetTooltip icn appName
  mnu ← mkmenu icn
  I.onPopupMenu icn $ \b a → do
    widgetShowAll mnu
    print (b,a)
    menuPopup mnu $ maybe Nothing (\b' -> Just (b',a)) b
  I.onActivate icn $
    alternateMainWindowVisibility
  return icn
  where
    mkmenu s = do
      m ← menuNew
      i ← interfaceArg
      mapM_ (mkitem m) [("gtk-refresh", refresh)               ,
                        ("gtk-disconnect", disconnectHandler i),
                        ("---", undefined)                     ,
                        ("gtk-about", showAbout)               ,
                        ("---", undefined)                     ,
                        ("gtk-quit", mainQuit)                  ]
      return m
      where
        mkitem menu ("---",_) = do
          menuShellAppend menu =<< separatorMenuItemNew
        mkitem menu (label,act) = do
          i ← imageMenuItemNewFromStock label
          menuShellAppend menu i
          onActivateLeaf i act
          return ()


refresh :: IO ()
refresh = do
  vbx ← readIORef mainBox
  vio ← readIORef mainView
  containerRemove vbx vio
  vin ← wlanTreeViewNew
  mainView =: vin
  containerAdd vbx vin


mainWindowNew :: IO Window
mainWindowNew = do
  win ← windowNew
  vbx ← vBoxNew False 0

  mnu ← createMenu
  boxPackStart vbx mnu PackNatural 0

  view ← wlanTreeViewNew
  containerAdd vbx view

  sbr ← statusbarNew
  boxPackEnd vbx sbr PackNatural 0

{-txt ← textViewNew
  textViewSetEditable txt False
  widgetSetSizeRequest txt 0 160
  boxPackEnd vbx txt PackGrow 0-}
  
  containerAdd win vbx
  
  mainBox =: vbx
  mainView =: view

  windowSetTitle win appName

  onDestroy win mainQuit
  widgetShowAll win

--  forkIO autorefresh

  return win

autorefresh :: IO ()
autorefresh = do
  refresh
  putStrLn "refreshed"
  system "sleep 1"
  autorefresh

wlanTreeViewNew :: IO TreeView
wlanTreeViewNew = do
  model ← wlanTreeModelNew
  view ← treeViewNewWithModel model
  cs@[c1,c2,c3,c4] ← replicateM 4 treeViewColumnNew
  mapM_ (\(c,t) → treeViewColumnSetTitle c t) $ zip cs
    ["", "essid", "quality", "encryption"]
  [r2,r4] ← replicateM 2 cellRendererTextNew
  r3 ← cellRendererProgressNew
  r1 ← cellRendererToggleNew

  mapM_ (\(c,pc) → pc c) $
    zip cs ([pack r1,
             pack r2,
             pack r3,
             pack r4])
  
  treeViewColumnSetSizing     c3 TreeViewColumnFixed
  treeViewColumnSetFixedWidth c3 150

  s ← getConnectionStatus =<< interfaceArg

  cellLayoutSetAttributes c2 r2 model $ \r → [ cellText := idof r            ]
  cellLayoutSetAttributes c3 r3 model $ \r → [ cellProgressValue := qual r,
                                               cellProgressText  := Just ""  ]
  cellLayoutSetAttributes c4 r4 model $ \r → [ cellText := show (cencrypt r) ]
  cellLayoutSetAttributes c1 r1 model $ \r → [ cellToggleActive := conn s r,
                                               cellToggleRadio := True       ]

  on r1 cellToggled (connect model)

  mapM_ (treeViewAppendColumn view) cs
  widgetShowAll view
  return view
  where
    idof r = if id == "" && ln == 1 then mac else id
      where
        id             = cessid r
        cs@((mac,_):_) = ccell r
        ln             = length cs
    qual = meanQuality . map snd . ccell
    pack r c = cellLayoutPackStart c r True -- continuation
    conn NotConnected      _ = False
    conn (Connected _ cid) r = cid == cessid r
    connect model pathStr = do
      r ← treeStoreGetValue model path
      case cencrypt r of
        None → ((flip connectFree) (cessid r) =<< interfaceArg) >> refresh
        _    → connectUsingSettings (cessid r)
      where
        path = stringToTreePath pathStr

connectUsingSettings :: SSID → IO ()
connectUsingSettings id = do
  it ← interfaceArg
  ms ← return . find (settingEq id) =<< readSettings
  case ms of
    Just s → connect it s >> refresh
    _      → (warnVisual MessageError ButtonsOk appName $
              "No configuration for encrypted network " ++ id ++
              " found in: " ++ settingsFile) >> return ()
  where
    settingEq id (Wireless sid _) = id == sid 

settingsFile :: FilePath
settingsFile = "/etc/hnm.conf"

readSettings :: IO [ConnectionSetting]
readSettings = do
  mc ← tryReadFile settingsFile
  case mc of
    Just contents → return . read $ contents
    _             → create settingsFile >> return []
  where
    create f = writeFile f "[]"

tryReadFile :: FilePath → IO (Maybe String)
tryReadFile file = do
  exists ← doesFileExist file
  case exists of
    True  → return . Just =<< readFile file
    False → return Nothing


wlanTreeModelNew :: IO (TreeStore CWLAN)
wlanTreeModelNew = do
  treeStoreNew . (map cwlanToNode) . compact =<< getWLANs =<< interfaceArg


cwlanToNode :: CWLAN → Tree CWLAN
cwlanToNode w = Node w s
  where
    s       = if ln > 1 then map (c2w w) cs else []
      where
        cs  = ccell w
        ln  = length cs
    c2w w c = Node (CWLAN (fst c) (cencrypt w) [([],snd c)]) []


disconnectHandler :: Interface → IO ()
disconnectHandler interface = do
  disconnect interface
  ifconfig [interface, "up"]
  refresh


doif :: Monad m ⇒ Bool → m () → m ()
doif True act = act
doif False _  = return ()


createMenu :: IO Widget
createMenu = do
  fma ← actionNew "FMA" "_File" Nothing Nothing
  hma ← actionNew "HMA" "_Help" Nothing Nothing

  refa ← actionNew "REFA" "_Refresh"  (Just "stub") (Just stockRefresh)
  exia ← actionNew "EXIA" "_Quit"  (Just "stub") (Just stockQuit)

  aboa ← actionNew "ABOA" "_About" (Just "stub") (Just stockAbout)

  agr ← actionGroupNew "AGR"
  mapM_ (actionGroupAddAction agr) [fma,hma]
  mapM_ (\act → actionGroupAddActionWithAccel agr act Nothing) [refa,exia,aboa]

  onActionActivate refa refresh
  onActionActivate exia mainQuit
  onActionActivate aboa showAbout
  
  ui ← uiManagerNew
  uiManagerAddUiFromString ui menuDecl
  uiManagerInsertActionGroup ui agr 0
  
  maybeMenubar ← uiManagerGetWidget ui "/ui/menubar"
  return $ fromJust maybeMenubar
  where
    menuDecl = "<ui>\
\            <menubar>\
\             <menu action=\"FMA\">\
\               <menuitem action=\"REFA\" />\
\               <menuitem action=\"EXIA\" />\
\             </menu>\
\             <menu action=\"HMA\">\
\               <menuitem action=\"ABOA\" />\
\             </menu>\
\            </menubar>\
\           </ui>"


appName :: String
appName = "Happy Network Manager"

appNameShort :: String
appNameShort = "HNM"

appVersion :: String
appVersion = "0.1.2"


showAbout :: IO ()
showAbout = do
  dlg ← aboutDialogNew
  lcs ← return license
  set dlg [
            aboutDialogName := appName,
            aboutDialogVersion := appVersion,
            aboutDialogComments := "A quick and dirty applet to help you connect to wireless networks.",
            aboutDialogCopyright := "Copyright © 2008 Cetin Sert",
            aboutDialogWebsite := "http://sert.homedns.org/hs/hnm/",
            aboutDialogLicense := (Just lcs),
            aboutDialogAuthors := ["cs ^.^", "CS *^o^*"],
            aboutDialogLogoIconName := (Just "gtk-network")
          ]
  onResponse dlg (\_ → widgetDestroy dlg)
  dialogRun dlg
  return ()


printVersion :: IO Int
printVersion = do
  putStrLn $ appName ++ " " ++ appVersion
  putStrLn ""
  return 0

printLicense :: IO Int
printLicense = do
  printVersion
  putStrLn license
  putStrLn ""
  return 0

license :: String
license = "Copyright (c) 2008, Cetin Sert\n\
\\n\
\All rights reserved.\n\
\\n\
\Redistribution and use in source and binary forms, with or without\n\
\modification, are permitted provided that the following conditions are\n\
\met:\n\
\\n\
\    1. Redistributions of source code must retain the above copyright\n\
\       notice, this list of conditions and the following disclaimer.\n\
\\n\
\    2. Redistributions in binary form must reproduce the above\n\
\       copyright notice, this list of conditions and the following\n\
\       disclaimer in the documentation and/or other materials provided\n\
\       with the distribution.\n\
\\n\
\    3. The names of contributors may not be used to endorse or promote\n\
\       products derived from this software without specific prior\n\
\       written permission.\n\
\\n\
\THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS\n\
\\"AS IS\" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT\n\
\LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR\n\
\A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT\n\
\OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,\n\
\SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT\n\
\LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,\n\
\DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY\n\
\THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n\
\(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\n\
\OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."