module Hbro.Core where
import Hbro.Gui
import Hbro.Socket
import Hbro.Util
import qualified Config.Dyre as Dyre
import Control.Concurrent
import Control.Monad.Trans(liftIO)
import qualified Data.Map as Map
import qualified Data.Set as Set
import Graphics.UI.Gtk
import Graphics.UI.Gtk.WebKit.WebView
import Graphics.UI.Gtk.WebKit.WebFrame
import Graphics.UI.Gtk.WebKit.WebInspector
import Graphics.UI.Gtk.WebKit.WebSettings
import Network.URL
import Prelude
import System.Environment
import System.Posix.Process
data Browser = Browser {
mGUI :: GUI
}
type KeyBindingsList = [(([Modifier], String), (GUI -> IO ()))]
data Configuration = Configuration {
mHomePage :: String,
mSocketDir :: String,
mKeyBindings :: KeyBindingsList,
mWebSettings :: IO WebSettings,
mCustomizations :: GUI -> IO (),
mError :: Maybe String
}
realMain :: Configuration -> IO ()
realMain configuration = do
args <- getArgs
case args of
["--help"] -> putStrLn "Usage: browser [url]"
_ -> initBrowser configuration
initBrowser :: Configuration -> IO ()
initBrowser configuration = do
args <- initGUI
gui <- loadGUI ""
pid <- getProcessID
_ <- forkIO $ createReplySocket ("ipc://" ++ (mSocketDir configuration) ++ "/hbro." ++ (show pid)) gui
settings <- mWebSettings configuration
webViewSetWebSettings (mWebView gui) settings
(mCustomizations configuration) gui
let url = case args of
[arg] -> arg
_ -> mHomePage configuration
loadURL url gui
let keyBindings = importKeyBindings (mKeyBindings configuration)
_ <- on (mWebView gui) createWebView $ \frame -> do
newUri <- webFrameGetUri frame
case newUri of
Just uri -> webViewLoadUri (mWebView gui) uri
Nothing -> return ()
return (mWebView gui)
inspector <- webViewGetInspector (mWebView gui)
_ <- on inspector inspectWebView $ \_ -> do
webView <- webViewNew
containerAdd (mInspectorWindow gui) webView
return webView
_ <- on inspector showWindow $ do
widgetShowAll (mInspectorWindow gui)
return True
_ <- on inspector attachWindow $ do
getWebView <- webInspectorGetWebView inspector
case getWebView of
Just webView -> do widgetHide (mInspectorWindow gui)
containerRemove (mInspectorWindow gui) webView
widgetSetSizeRequest webView (1) 250
boxPackEnd (mWindowBox gui) webView PackNatural 0
widgetShow webView
return True
_ -> return False
_ <- on inspector detachWindow $ do
getWebView <- webInspectorGetWebView inspector
_ <- case getWebView of
Just webView -> do containerRemove (mWindowBox gui) webView
containerAdd (mInspectorWindow gui) webView
widgetShowAll (mInspectorWindow gui)
return True
_ -> return False
widgetShowAll (mInspectorWindow gui)
return True
_ <- after (mWebView gui) keyPressEvent $ do
keyVal <- eventKeyVal
modifiers <- eventModifier
let keyString = keyToString keyVal
case keyString of
Just string -> do
case Map.lookup (Set.fromList modifiers, string) keyBindings of
Just callback -> liftIO $ callback gui
_ -> liftIO $ putStrLn string
_ -> return ()
return False
_ <- onDestroy (mWindow gui) mainQuit
widgetShowAll (mWindow gui)
widgetHide (mPromptLabel gui)
widgetHide (mPrompt gui)
mainGUI
showWebInspector :: GUI -> IO ()
showWebInspector gui = do
inspector <- webViewGetInspector (mWebView gui)
webInspectorInspectCoordinates inspector 0 0
loadURL :: String -> GUI -> IO ()
loadURL url gui =
case importURL url of
Just url' -> loadURL' url' gui
_ -> return ()
loadURL' :: URL -> GUI -> IO ()
loadURL' url@URL {url_type = Absolute _} gui =
webViewLoadUri (mWebView gui) (exportURL url)
loadURL' url@URL {url_type = HostRelative} gui =
webViewLoadUri (mWebView gui) ("file://" ++ exportURL url) >> putStrLn (show url)
loadURL' url@URL {url_type = _} gui =
webViewLoadUri (mWebView gui) ("http://" ++ exportURL url) >> print url
showError :: Configuration -> String -> Configuration
showError configuration message = configuration { mError = Just message }
browser :: Configuration -> IO ()
browser = Dyre.wrapMain Dyre.defaultParams {
Dyre.projectName = "hbro",
Dyre.showError = showError,
Dyre.realMain = realMain
}