Sidebar.hs

module Hob.Ui.Sidebar (
    newSideBarFileTree,
    reloadSidebarTree,
    activateSidebarPath,
    syncPathToSidebar,
    nameColumn,
    pathColumn
    ) where

import Control.Monad.Reader
import Data.List                 (isPrefixOf)
import Graphics.UI.Gtk
import Graphics.UI.Gtk.ModelView as Mv
import GtkExtras.LargeTreeStore  as LTS

import Hob.Command.NewTab
import Hob.Context
import Hob.Context.FileContext
import Hob.Context.UiContext
import Hob.Control
import Hob.DirectoryTree

newSideBarFileTree :: Context -> TreeView -> NewFileEditorLauncher -> IO ()
newSideBarFileTree ctx treeView launchFile = do
    let treeStore = fileTreeStore ctx
    runApp ctx reloadSidebarTree
    initNameColumn treeStore

    treeViewSetHeadersVisible treeView False
    treeViewSetEnableSearch treeView False
    treeViewSetModel treeView treeStore

    _ <- treeView `on` rowCollapsed $ \ _ _ -> treeViewColumnsAutosize treeView
    _ <- treeView `on` rowActivated $ \ path _ -> activateRow path =<< LTS.treeStoreGetValue treeStore path

    return ()

    where
        initNameColumn treeStore = do
            customStoreSetColumn treeStore nameColumn elementLabel
            customStoreSetColumn treeStore pathColumn elementPath

            col <- treeViewColumnNew

            rend <- Mv.cellRendererTextNew
            Mv.cellLayoutPackStart col rend True
            Mv.cellLayoutSetAttributes col rend treeStore (\v -> [Mv.cellText := elementLabel v])

            _ <- treeViewAppendColumn treeView col
            return ()

        activateRow :: TreePath -> DirectoryTreeElement -> IO ()
        activateRow path el = if isDirectory el then void $ treeViewExpandRow treeView path False
                              else launchFile . elementPath $ el


nameColumn :: ColumnId row String
nameColumn = makeColumnIdString 0

pathColumn :: ColumnId row FilePath
pathColumn = makeColumnIdString 1

reloadSidebarTree :: App ()
reloadSidebarTree = do
    ctx <- ask
    let treeStore = fileTreeStore ctx
    let fileCtx = fileContext ctx
    let fileTreeLoader = contextFileTreeLoader fileCtx
    liftIO $ LTS.treeStoreClear treeStore
    liftIO $ LTS.treeStoreInsertForest treeStore [] 0 =<< fileTreeLoader
    emitEvent $ Event "core.sidebar.reload"


activateSidebarPath :: TreeViewClass tv => tv -> TreePath -> IO ()
activateSidebarPath treeView path = do
    treeViewCollapseAll treeView
    treeViewExpandToPath treeView path
    treeViewSetCursor treeView path Nothing




syncPathToSidebar :: FilePath -> App()
syncPathToSidebar filePath = do
    ctx <- ask
    let treeView = sidebarTree.uiContext $ ctx
    liftIO (maybeDo (syncTreeViewModel treeView) =<< treeViewGetModel treeView)
    where
        syncTreeViewModel treeView model = do
            mStartIter <- treeModelGetIterFirst model
            maybeDo (syncToMatchingPath treeView model) mStartIter
        syncToMatchingPath treeView model startingIter =
            maybeDo (syncToIter treeView model) =<< findFilePath model filePath startingIter
        syncToIter treeView model iter = activateSidebarPath treeView =<< treeModelGetPath model iter

findFilePath :: TreeModelClass self =>
                self -> FilePath -> TreeIter -> IO (Maybe TreeIter)
findFilePath model filePath iter = do
        path <- treeModelGetValue model iter pathColumn
        if path == filePath then return $ Just iter
        else if (path++"/") `isPrefixOf` filePath then matchChildren
        else matchNextSibling
    where matchChildren = recurseToMaybeIter =<< treeModelIterChildren model iter
          matchNextSibling = recurseToMaybeIter =<< treeModelIterNext model iter
          recurseToMaybeIter Nothing = return Nothing
          recurseToMaybeIter (Just it) = findFilePath model filePath it