hbro-1.0.0.0: Hbro/Core.hs

{-# LANGUAGE FlexibleContexts, RankNTypes #-}
module Hbro.Core where

-- {{{ Imports
import Hbro.Types
import Hbro.Util as H
import Hbro.Webkit.WebView as WebView

import Control.Monad.Error  hiding(forM_, mapM_)
import Control.Monad.Reader hiding(forM_, mapM_)

import Data.Default
-- import Data.Foldable
-- import Data.Functor

import Graphics.UI.Gtk.General.General
import Graphics.UI.Gtk.WebKit.WebDataSource
import Graphics.UI.Gtk.WebKit.WebFrame
import Graphics.UI.Gtk.WebKit.WebView

import Prelude hiding(concat, mapM_)
-- }}}

-- {{{ Util
{-getState :: (MonadIO m, MonadError HError m, Typeable a) => String -> a -> m a
getState key defaultValue = do
    customMap <- gets _custom
    let result = fromDynamic =<< M.lookup key customMap
    case result of
        Just value -> return value
        _          -> do
            modify $ \s -> s { _custom = M.insert key (toDyn defaultValue) customMap }
            return defaultValue-}
-- }}}

goHome :: (MonadIO m, MonadReader r m, HasConfig r, HasWebView r, MonadError HError m) => m ()
goHome = loadURI =<< asks _homePage

quit :: (MonadIO m) => m ()
quit = io mainQuit

-- {{{ Misc
-- | Execute a javascript file on current webpage.
executeJSFile :: (MonadIO m) => FilePath -> WebView -> m ()
executeJSFile filePath webView = do
    logNormal $ "Executing Javascript file: " ++ filePath
    script <- io $ readFile filePath
    let script' = unwords . map (++ "\n") . lines $ script

    io $ webViewExecuteScript webView script'
-- }}}

-- | Save current web page to a file,
-- along with all its resources in a separated directory.
-- Doesn't work for now, because web_resource_get_data's binding is missing...
_savePage :: String -> WebView -> IO ()
_savePage _path webView = do
    frame        <- webViewGetMainFrame webView
    dataSource   <- webFrameGetDataSource frame
    _mainResource <- webDataSourceGetMainResource dataSource
    _subResources <- webDataSourceGetSubresources dataSource
    return ()