module Hbro.Config (
defaultConfig,
defaultHooks,
defaultKeyHandler,
defaultKeyBindings,
defaultLinkClickedHook,
defaultMIMEDisposition,
defaultTitleChangedHook,
defaultCommandsList
) where
import Hbro.Core
import Hbro.Gui
import qualified Hbro.Prompt as Prompt
import Hbro.Types
import Hbro.Util
import Control.Monad.Reader hiding(mapM_)
import Data.Foldable
import Data.Functor
import qualified Data.Map as M
import Graphics.UI.Gtk.Abstract.Widget
import Graphics.UI.Gtk.General.General
import Graphics.UI.Gtk.Entry.Entry
import Graphics.UI.Gtk.WebKit.WebPolicyDecision
import Graphics.UI.Gtk.WebKit.WebView
import Graphics.UI.Gtk.Windows.Window
import Prelude hiding(mapM_)
import Network.URI
import System.Console.CmdArgs (whenLoud)
import System.FilePath
import System.Glib.Attributes
defaultConfig :: Config
defaultConfig = Config {
mHomePage = "https://duckduckgo.com/",
mSocketDir = mTemporary,
mUIFile = (</> "ui.xml") . mConfiguration,
mWebSettings = [],
mCommands = defaultCommandsList,
mHooks = defaultHooks
}
defaultHooks :: Hooks
defaultHooks = Hooks {
mBackForward = (\_ decision -> io $ webPolicyDecisionUse decision),
mDownload = defaultDownloadHook,
mFormResubmitted = (\_ decision -> io $ webPolicyDecisionUse decision),
mFormSubmitted = (\_ decision -> io $ webPolicyDecisionUse decision),
mKeyPressed = void . (defaultKeyHandler defaultKeyBindings),
mLinkClicked = defaultLinkClickedHook,
mLoadFinished = return (),
mMIMEDisposition = defaultMIMEDisposition,
mNewWindow = const $ return (), --defaultNewWindowHook,
mOtherNavigation = (\_ decision -> io $ webPolicyDecisionUse decision),
mReload = (\_ decision -> io $ webPolicyDecisionUse decision),
mStartUp = return (),
mTitleChanged = defaultTitleChangedHook
}
defaultDownloadHook :: URI -> String -> Int -> K ()
defaultDownloadHook _ _ _ = notify 5000 "No download hook defined."
defaultKeyHandler :: KeysList -> String -> K (String, Bool)
defaultKeyHandler keysList keystrokes = do
io . whenLoud . putStr $ "Key pressed: " ++ keystrokes
(log', isMapped) <- case M.lookup keystrokes (M.fromList keysList) of
Just callback -> callback >> return (" (mapped)", True)
_ -> return (" (unmapped)", False)
io . whenLoud . putStrLn $ log'
return (keystrokes, isMapped)
defaultKeyBindings :: KeysList
defaultKeyBindings = [
("M-<Left>", goBack),
("M-<Right>", goForward),
("C-<Escape>", stopLoading),
("<F5>", reload),
("C-r", reload),
("C-<F5>", reloadBypassCache),
("M-r", reloadBypassCache),
("C-^", scroll Horizontal (Absolute 0)),
("C-$", scroll Horizontal (Absolute 100)),
("C-<Home>", scroll Vertical (Absolute 0)),
("C-<End>", scroll Vertical (Absolute 100)),
("M-<Home>", goHome),
("C-+", zoomIn),
("C--", zoomOut),
("C-b", with (mStatusBar . mGUI) toggleVisibility),
("C-u", toggleSourceMode),
("C-o", Prompt.readURI "Open URI" [] loadURI),
("M-o", withURI $ \uri -> Prompt.readURI "Open URI " (show uri) loadURI),
("/", Prompt.iread "Search " [] $ void . searchText CaseInsensitive Forward Wrap),
("C-f", Prompt.iread "Search " [] $ void . searchText CaseInsensitive Forward Wrap),
("?", Prompt.iread "Search " [] $ void . searchText CaseInsensitive Backward Wrap),
("C-n", withK (mEntry . mPromptBar . mGUI) $ (io . entryGetText) >=> void . searchText CaseInsensitive Forward Wrap),
("C-N", withK (mEntry . mPromptBar . mGUI) $ (io . entryGetText) >=> void . searchText CaseInsensitive Backward Wrap),
("<Escape>", with (mBox . mPromptBar . mGUI) widgetHide),
("C-i", showWebInspector),
("C-p", printPage),
("C-t", io $ spawn "hbro" []),
("C-w", io mainQuit)
]
defaultLinkClickedHook :: Button -> URI -> WebPolicyDecision -> K ()
defaultLinkClickedHook ButtonL _uri decision = io $ webPolicyDecisionUse decision
defaultLinkClickedHook ButtonM uri decision = io $ webPolicyDecisionIgnore decision >> spawn "hbro" ["-u", show uri]
defaultLinkClickedHook _ _uri decision = io $ webPolicyDecisionIgnore decision
defaultMIMEDisposition :: URI -> String -> WebPolicyDecision -> K ()
defaultMIMEDisposition _uri mimetype decision = with (mWebView . mGUI) $ \view -> do
canShow <- webViewCanShowMimeType view mimetype
case canShow of
True -> webPolicyDecisionUse decision
_ -> webPolicyDecisionDownload decision
defaultTitleChangedHook :: String -> K ()
defaultTitleChangedHook title = with (mWindow . mGUI) (`set` [ windowTitle := ("hbro | " ++ title)])
defaultCommandsList :: CommandsList
defaultCommandsList = [
("GET_URI", \_arguments -> (maybe "ERROR" show) <$> mapK postGUISync getURI),
("GET_TITLE", \_arguments -> (maybe "ERROR" show) <$> mapK postGUISync getTitle),
("GET_FAVICON_URI", \_arguments -> (maybe "ERROR" show) <$> mapK postGUISync getFaviconURI),
("GET_LOAD_PROGRESS", \_arguments -> show <$> mapK postGUISync getLoadProgress),
("LOAD_URI", \arguments -> case arguments of
uri:_ -> ((mapK postGUIAsync) . (mapM_ loadURI)) (parseURIReference uri) >> return "OK"
_ -> return "ERROR Argument needed."),
("STOP_LOADING", \_arguments -> mapK postGUIAsync stopLoading >> return "OK"),
("RELOAD", \_arguments -> mapK postGUIAsync reload >> return "OK"),
("GO_BACK", \_arguments -> mapK postGUIAsync goBack >> return "OK"),
("GO_FORWARD", \_arguments -> mapK postGUIAsync goForward >> return "OK"),
("ZOOM_IN", \_arguments -> mapK postGUIAsync zoomIn >> return "OK"),
("ZOOM_OUT", \_arguments -> mapK postGUIAsync zoomOut >> return "OK")]