{-# OPTIONS_HADDOCK ignore-exports #-}

module GUI.Gtk.Gui (startMainWindow) where


import Control.Applicative
  (
    (<$>)
  , (<*>)
  )
import Control.Concurrent
  (
    forkIO
  )
import Control.Concurrent.STM
  (
    TVar
  , newTVarIO
  , readTVarIO
  )
import Control.Exception
  (
    try
  , Exception
  , SomeException
  )
import Control.Monad
  (
    when
  , void
  )
import Control.Monad.IO.Class
  (
    liftIO
  )
import Data.DirTree
import Data.DirTree.Zipper
import Data.Foldable
  (
    for_
  )
import Data.List
  (
    sort
  , isPrefixOf
  )
import Data.Maybe
  (
    fromJust
  , catMaybes
  , fromMaybe
  )
import Data.Traversable
  (
    forM
  )
import Graphics.UI.Gtk
import GUI.Gtk.Icons
import IO.Error
import IO.File
import IO.Utils
import System.Directory
  (
    executable
  , doesFileExist
  , doesDirectoryExist
  )
import System.Environment
  (
    getArgs
  )
import System.FilePath.Posix
  (
    isAbsolute
  )
import System.Glib.UTFString
  (
    glibToString
  )
import System.IO.Unsafe
  (
    unsafePerformIO
  )
import System.Process
  (
    spawnProcess
  )


-- TODO: simplify where we modify the TVars
-- TODO: double check garbage collection/gtk ref counting
-- TODO: file watching, when and what to reread


-- |Monolithic object passed to various GUI functions in order
-- to keep the API stable and not alter the parameters too much.
-- This only holds GUI widgets that are needed to be read during
-- runtime.
data MyGUI = MkMyGUI {
  -- |main Window
    rootWin  :: Window
  , menubarFileQuit :: ImageMenuItem
  , menubarFileOpen :: ImageMenuItem
  , menubarFileCut :: ImageMenuItem
  , menubarFileCopy :: ImageMenuItem
  , menubarFilePaste :: ImageMenuItem
  , menubarFileDelete :: ImageMenuItem
  , menubarHelpAbout :: ImageMenuItem
  , urlBar :: Entry
  , statusBar :: Statusbar
  -- |tree view
  , treeView :: TreeView
  -- |first column
  , cF :: TreeViewColumn
  -- |second column
  , cMD :: TreeViewColumn
  -- |renderer used for the treeView
  , renderTxt :: CellRendererText
  , renderPix :: CellRendererPixbuf
  , settings :: TVar FMSettings
  , folderPix :: Pixbuf
  , filePix :: Pixbuf
  , errorPix :: Pixbuf
}


-- |FM-wide settings.
data FMSettings = MkFMSettings {
    showHidden :: Bool
  , isLazy :: Bool
}


-- |This describes the contents of the treeView and is separated from MyGUI,
-- because we might want to have multiple views.
data MyView = MkMyView {
  -- |raw model with unsorted data
    rawModel :: TVar (ListStore (DTZipper DirTreeInfo DirTreeInfo))
  -- |sorted proxy model
  , sortedModel :: TVar (TypedTreeModelSort
                          (DTZipper DirTreeInfo DirTreeInfo))
  -- |filtered proxy model
  , filteredModel :: TVar (TypedTreeModelFilter
                            (DTZipper DirTreeInfo DirTreeInfo))
  , fsState :: TVar (DTZipper DirTreeInfo DirTreeInfo)
}


-- |Set hotkeys.
setBindings :: MyGUI -> MyView -> IO ()
setBindings mygui myview = do
  _ <- rootWin mygui `on` keyPressEvent $ tryEvent $ do
    [Control] <- eventModifier
    "q"       <- fmap glibToString eventKeyName
    liftIO mainQuit
  _ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
    [Control] <- eventModifier
    "h"       <- fmap glibToString eventKeyName
    liftIO $ modifyTVarIO (settings mygui)
                          (\x -> x { showHidden = not . showHidden $ x})
             >> (refreshTreeView' mygui myview =<< readTVarIO (fsState myview))
  _ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
    [Alt] <- eventModifier
    "Up"  <- fmap glibToString eventKeyName
    liftIO $ upDir mygui myview
  _ <- treeView mygui `on` keyPressEvent $ tryEvent $ do
    "Delete"  <- fmap glibToString eventKeyName
    liftIO $ onRow Delete mygui myview
  _ <- treeView mygui `on` rowActivated $ (\_ _ -> onRow Open mygui myview)
  _ <- menubarFileQuit mygui `on` menuItemActivated $ mainQuit
  _ <- urlBar mygui `on` entryActivated $ urlGoTo mygui myview
  return ()


-- |Go the the url given at the `urlBar` and visualize it in the given
-- treeView.
--
-- This might update the TVar `rawModel`.
urlGoTo :: MyGUI -> MyView -> IO ()
urlGoTo mygui myview = do
  fp <- entryGetText (urlBar mygui)
  let abs = isAbsolute fp
  exists <- (||) <$> doesDirectoryExist fp <*> doesFileExist fp
  -- TODO: more explicit error handling?
  refreshTreeView mygui myview (Just fp)


-- |Gets the currently selected row of the treeView, if any.
getSelectedRow :: MyGUI
               -> MyView
               -> IO (Maybe (DTZipper DirTreeInfo DirTreeInfo))
getSelectedRow mygui myview = do
  (tp, _)        <- treeViewGetCursor $ treeView mygui
  rawModel'      <- readTVarIO $ rawModel myview
  sortedModel'   <- readTVarIO $ sortedModel myview
  filteredModel' <- readTVarIO $ filteredModel myview
  miter          <- treeModelGetIter sortedModel' tp
  forM miter $ \iter -> do
    cIter' <- treeModelSortConvertIterToChildIter sortedModel' iter
    cIter  <- treeModelFilterConvertIterToChildIter filteredModel' cIter'
    treeModelGetRow rawModel' cIter


-- |Callback for file operations on a row, e.g. open, delete, etc.
--
-- This might update the TVar `rawModel`.
onRow :: FileOperation
      -> MyGUI
      -> MyView
      -> IO ()
onRow fo mygui myview = do
  mrow <- getSelectedRow mygui myview
  for_ mrow $ \row ->
    case fo of
      Open   -> open row
      Delete -> del row
      _      -> return ()
  where
    open row = case row of
      (Dir {}, _) ->
        refreshTreeView' mygui myview row
      dz@(File {}, _) ->
        withErrorDialog $ openFile (getFullPath dz)
      _ -> return ()
    del row = case row of
      dz@(Dir {}, _)   -> do
        let fp   = getFullPath dz
            cmsg = "Really delete directory \"" ++ fp ++ "\"?"
        withConfirmationDialog cmsg
          $ withErrorDialog (deleteDir fp
                              >> refreshTreeView mygui myview Nothing)
      dz@(File {}, _) -> do
        let fp   = getFullPath dz
            cmsg = "Really delete file \"" ++ fp ++ "\"?"
        withConfirmationDialog cmsg
          $ withErrorDialog (deleteFile fp
                              >> refreshTreeView mygui myview Nothing)


-- |Go up one directory and visualize it in the treeView.
upDir :: MyGUI -> MyView -> IO ()
upDir mygui myview = do
  rawModel'    <- readTVarIO $ rawModel myview
  sortedModel' <- readTVarIO $ sortedModel myview
  fS           <- readTVarIO $ fsState myview
  refreshTreeView' mygui myview (goUp fS)


-- |Create the `ListStore` of files/directories from the current directory.
-- This is the function which maps the Data.DirTree data structures
-- into the GTK+ data structures.
--
-- This also updates the TVar `fsState` inside the given view.
fileListStore :: DTZipper DirTreeInfo DirTreeInfo  -- ^ current dir
              -> MyView
              -> IO (ListStore (DTZipper DirTreeInfo DirTreeInfo))
fileListStore dtz myview = do
  writeTVarIO (fsState myview) dtz
  listStoreNew (goAllDown dtz)


-- |Re-reads the current directory or the given one and updates the TreeView.
-- This means that the DTZipper is re-initialized.
-- If you can operate on the raw DTZipper directly, use `refreshTreeView'`
-- instead.
--
-- This also updates the TVar `rawModel`.
--
-- This throws exceptions via `dirSanityThrow` if the given/current
-- directory path does not exist.
refreshTreeView :: MyGUI
                -> MyView
                -> Maybe FilePath
                -> IO ()
refreshTreeView mygui myview mfp = do
  fsState <- readTVarIO $ fsState myview
  let cfp = getFullPath fsState
      fp  = fromMaybe cfp mfp

  -- TODO catch exceptions
  dirSanityThrow fp

  newFsState  <- readPath' fp
  newRawModel <- fileListStore newFsState myview
  writeTVarIO (rawModel myview) newRawModel
  constructTreeView mygui myview


-- |Refreshes the TreeView based on the given Zipper.
--
-- This also updates the TVar `rawModel`.
refreshTreeView' :: MyGUI
                 -> MyView
                 -> DTZipper DirTreeInfo DirTreeInfo
                 -> IO ()
refreshTreeView' mygui myview dtz = do
  newRawModel  <- fileListStore dtz myview
  writeTVarIO (rawModel myview) newRawModel
  constructTreeView mygui myview


-- TODO: make this function more slim so only the most necessary parts are
-- called
-- |Constructs the visible TreeView with the current underlying mutable models,
-- which are retrieved from `MyGUI`.
--
-- This also updates the TVars `filteredModel` and `sortedModel` in the process.
constructTreeView :: MyGUI
                  -> MyView
                  -> IO ()
constructTreeView mygui myview = do
  let treeView' = treeView mygui
      cF' = cF mygui
      cMD' = cMD mygui
      render' = renderTxt mygui

  -- update urlBar, this will break laziness slightly, probably
  fsState <- readTVarIO $ fsState myview
  let urlpath = getFullPath fsState
  entrySetText (urlBar mygui) urlpath

  rawModel' <- readTVarIO $ rawModel myview

  -- filtering
  filteredModel' <- treeModelFilterNew rawModel' []
  writeTVarIO (filteredModel myview) filteredModel'
  treeModelFilterSetVisibleFunc filteredModel' $ \iter -> do
     hidden <- showHidden <$> readTVarIO (settings mygui)
     row    <- treeModelGetRow rawModel' iter
     if hidden
       then return True
       else return $ not ("." `isPrefixOf` (name . unZip $ row))

  -- sorting
  sortedModel' <- treeModelSortNewWithModel filteredModel'
  writeTVarIO (sortedModel myview) sortedModel'
  treeSortableSetSortFunc sortedModel' 1 $ \iter1 iter2 -> do
      cIter1 <- treeModelFilterConvertIterToChildIter filteredModel' iter1
      cIter2 <- treeModelFilterConvertIterToChildIter filteredModel' iter2
      row1   <- treeModelGetRow rawModel' cIter1
      row2   <- treeModelGetRow rawModel' cIter2
      return $ compare (unZip row1) (unZip row2)
  treeSortableSetSortColumnId sortedModel' 1 SortAscending

  -- set values
  treeModelSetColumn rawModel' (makeColumnIdPixbuf 0)
                               (dirtreePix . unZip)
  treeModelSetColumn rawModel' (makeColumnIdString 1)
                               (name . unZip)
  treeModelSetColumn rawModel' (makeColumnIdString 2)
                               (packModTime . unZip)
  treeModelSetColumn rawModel' (makeColumnIdString 3)
                               (packPermissions . unZip)

  -- update treeview model
  treeViewSetModel treeView' sortedModel'

  return ()
  where
    dirtreePix (Dir {})    = folderPix mygui
    dirtreePix (File {})   = filePix mygui
    dirtreePix (Failed {}) = errorPix mygui


pushStatusBar :: MyGUI -> String -> IO (ContextId, MessageId)
pushStatusBar mygui str = do
  let sb = statusBar mygui
  cid <- statusbarGetContextId sb "FM Status"
  mid <- statusbarPush sb cid str
  return (cid, mid)


-- |Pops up an error Dialog with the given String.
showErrorDialog :: String -> IO ()
showErrorDialog str = do
  errorDialog <- messageDialogNew Nothing
                                  [DialogDestroyWithParent]
                                  MessageError
                                  ButtonsClose
                                  str
  _ <- dialogRun errorDialog
  widgetDestroy errorDialog


showConfirmationDialog :: String -> IO Bool
showConfirmationDialog str = do
  errorDialog <- messageDialogNew Nothing
                                  [DialogDestroyWithParent]
                                  MessageQuestion
                                  ButtonsYesNo
                                  str
  rID <- dialogRun errorDialog
  widgetDestroy errorDialog
  case rID of
    ResponseYes -> return True
    ResponseNo  -> return False
    _           -> return False


withConfirmationDialog :: String -> IO () -> IO ()
withConfirmationDialog str io = do
  run <- showConfirmationDialog str
  when run io


-- |Execute the given IO action. If the action throws exceptions,
-- visualize them via `showErrorDialog`.
withErrorDialog :: IO a -> IO ()
withErrorDialog io = do
  r <- try io
  either (\e -> showErrorDialog $ show (e :: SomeException))
         (\_ -> return ())
         r


-- |Set up the GUI.
startMainWindow :: IO ()
startMainWindow = do

  settings <- newTVarIO (MkFMSettings False True)

  -- get the icons
  iT        <- iconThemeGetDefault
  folderPix <- getIcon IFolder 24
  filePix   <- getIcon IFile 24
  errorPix  <- getIcon IError 24

  fsState <- readPath' "/" >>= newTVarIO

  builder <- builderNew
  builderAddFromFile builder "data/Gtk/builder.xml"

  -- get the pre-defined gui widgets
  rootWin           <- builderGetObject builder castToWindow
                       "rootWin"
  scroll            <- builderGetObject builder castToScrolledWindow
                       "mainScroll"
  menubarFileQuit   <- builderGetObject builder castToImageMenuItem
                       "menubarFileQuit"
  menubarFileOpen   <- builderGetObject builder castToImageMenuItem
                       "menubarFileOpen"
  menubarFileCut    <- builderGetObject builder castToImageMenuItem
                       "menubarFileCut"
  menubarFileCopy   <- builderGetObject builder castToImageMenuItem
                       "menubarFileCopy"
  menubarFilePaste  <- builderGetObject builder castToImageMenuItem
                       "menubarFilePaste"
  menubarFileDelete <- builderGetObject builder castToImageMenuItem
                      "menubarFileDelete"
  menubarHelpAbout  <- builderGetObject builder castToImageMenuItem
                      "menubarHelpAbout"
  urlBar            <- builderGetObject builder castToEntry
                       "urlBar"
  statusBar         <- builderGetObject builder castToStatusbar
                       "statusBar"

  -- create initial list store model with unsorted data
  rawModel <- newTVarIO =<< listStoreNew . goAllDown =<< readTVarIO fsState

  filteredModel <- newTVarIO =<< (\x -> treeModelFilterNew x [])
                           =<< readTVarIO rawModel

  -- create an initial sorting proxy model
  sortedModel <- newTVarIO =<< treeModelSortNewWithModel
                           =<< readTVarIO filteredModel

  -- create the final view
  treeView <- treeViewNew

  -- create final tree model columns
  renderTxt <- cellRendererTextNew
  renderPix <- cellRendererPixbufNew
  let ct = cellText   :: (CellRendererTextClass cr) => Attr cr String
      cp = cellPixbuf :: (CellRendererPixbufClass self) => Attr self Pixbuf

  -- filename column
  cF <- treeViewColumnNew
  treeViewColumnSetTitle        cF "Filename"
  treeViewColumnSetResizable    cF True
  treeViewColumnSetClickable    cF True
  treeViewColumnSetSortColumnId cF 1
  cellLayoutPackStart cF renderPix False
  cellLayoutPackStart cF renderTxt True
  _ <- treeViewAppendColumn treeView cF
  cellLayoutAddColumnAttribute cF renderPix cp $ makeColumnIdPixbuf 0
  cellLayoutAddColumnAttribute cF renderTxt ct $ makeColumnIdString 1

  -- date column
  cMD <- treeViewColumnNew
  treeViewColumnSetTitle        cMD "Date"
  treeViewColumnSetResizable    cMD True
  treeViewColumnSetClickable    cMD True
  treeViewColumnSetSortColumnId cMD 2
  cellLayoutPackStart cMD renderTxt True
  _ <- treeViewAppendColumn treeView cMD
  cellLayoutAddColumnAttribute cMD renderTxt ct $ makeColumnIdString 2

  -- permissions column
  cP <- treeViewColumnNew
  treeViewColumnSetTitle        cP "Permission"
  treeViewColumnSetResizable    cP True
  treeViewColumnSetClickable    cP True
  treeViewColumnSetSortColumnId cP 3
  cellLayoutPackStart cP renderTxt True
  _ <- treeViewAppendColumn treeView cP
  cellLayoutAddColumnAttribute cP renderTxt ct $ makeColumnIdString 3

  -- construct the gui object
  let mygui  = MkMyGUI {..}
  let myview = MkMyView {..}

  -- create the tree model with its contents
  constructTreeView mygui myview

  -- set the bindings
  setBindings mygui myview

  -- add the treeview to the scroll container
  containerAdd scroll treeView

  widgetShowAll rootWin