hob-0.0.1.0: src/hob.hs

module Main (main) where

import           Control.Monad.Trans (liftIO)
import qualified Data.ByteString     as BS
import qualified Data.Text.Encoding  as E
import           Graphics.UI.Gtk
import           System.Directory
import           System.Environment  (getArgs)
import           System.IO           (hPutStr, stderr)

import Hob.Context
import Hob.Context.FileContext  (FileLoader, FileTreeLoader, FileWriter,
                                 defaultFileContext)
import Hob.Context.StyleContext (defaultStyleContext)
import Hob.Context.UiContext
import Hob.DirectoryTree
import Hob.Ui

import Paths_hob

main :: IO ()
main = do
    fileCtx <- getFileContext
    styleCtx <- getStyleContext
    ctx <- loadGui fileCtx styleCtx
    let window = mainWindow . uiContext $ ctx
    _ <- window `on` deleteEvent $ liftIO mainQuit >> return False
    widgetShow window
    mainGUI
    where
         getFileContext = do
             projectRoot <- getProjectDirectory
             defaultFileContext loadFile storeFile (fileTreeFromDirectory projectRoot)
         getStyleContext = defaultStyleContext =<< getDataDir
         getProjectDirectory = do
             args <- getArgs
             case args of
                 [] -> getCurrentDirectory
                 [path] -> canonicalizePath path
                 _ -> error "unsupported command options"


fileTreeFromDirectory :: FilePath -> FileTreeLoader
fileTreeFromDirectory = fileTreeGenerator getDirectoryContents doesDirectoryExist

loadFile :: FileLoader
loadFile path = do
        contents <- BS.readFile path
        checkError $ E.decodeUtf8' contents
        where checkError (Left e) = do hPutStr stderr (show e)
                                       return Nothing
              checkError (Right t) = return $ Just t

storeFile :: FileWriter
storeFile path = BS.writeFile path . E.encodeUtf8