hbro-contrib 1.0.0.0 → 1.1.0.0
raw patch · 8 files changed
+156/−258 lines, 8 filesdep +transformers-basedep −transformersdep ~hbro
Dependencies added: transformers-base
Dependencies removed: transformers
Dependency ranges changed: hbro
Files
- Hbro/Bookmarks.hs +23/−23
- Hbro/Download.hs +6/−5
- Hbro/History.hs +14/−13
- Hbro/Misc.hs +9/−7
- Hbro/Session.hs +0/−60
- Hbro/StatusBar.hs +45/−56
- examples/hbro.hs +57/−91
- hbro-contrib.cabal +2/−3
Hbro/Bookmarks.hs view
@@ -11,12 +11,15 @@ -- {{{ Imports import Hbro+-- import Hbro.Error+import Hbro.Gui import Hbro.Misc+import Hbro.Network import Control.Exception import Control.Monad hiding(forM_, mapM_)+import Control.Monad.Base import Control.Monad.Error hiding(forM_, mapM_)-import Control.Monad.Reader hiding(forM_, mapM_) --import qualified Data.ByteString.Char8 as B -- import Data.Foldable hiding(find, foldr)@@ -30,7 +33,7 @@ import Network.URI (URI) -import Prelude hiding(catch, mapM_)+import Prelude hiding(mapM_) import System.IO -- }}}@@ -40,7 +43,7 @@ mURI :: URI, mTags :: [String] }- + instance Show Entry where show (Entry uri tags) = unwords $ (show uri):tags -- }}}@@ -57,28 +60,27 @@ hasTag tag = isJust . (find $ (==) tag) . mTags -- | Add current webpage to bookmarks with given tags-add :: (Functor m, MonadIO m, MonadReader r m, HasWebView r, MonadError HError m) => IO FilePath -> [String] -> m ()+add :: (Functor m, MonadBase IO m, GUIReader n m, MonadError HError m) => FilePath -> [String] -> m () add file tags = do uri <- getURI void . addCustom file $ Entry uri tags -- | Add a custom entry to bookmarks-addCustom :: (MonadIO m, MonadError HError m)- => IO FilePath -- ^ Bookmarks' database file+addCustom :: (MonadBase IO m, MonadError HError m)+ => FilePath -- ^ Bookmarks' database file -> Entry -- ^ New bookmarks entry -> m () addCustom file newEntry = do- file' <- io file- either (throwError . IOE) return =<< (io . try $ withFile file' AppendMode (`hPutStrLn` show newEntry))+ either (throwError . IOE) return =<< (io . try $ withFile file AppendMode (`hPutStrLn` show newEntry)) --either (\e -> errorHandler file' e >> return False) (const $ return True) result -- | Open a dmenu with all (sorted alphabetically) bookmarks entries, and return the user's selection, if any.-select :: (Functor m, MonadIO m, MonadError HError m)- => IO FilePath -- ^ Bookmarks' database file+select :: (Functor m, MonadBase IO m, MonadError HError m)+ => FilePath -- ^ Bookmarks' database file -> [String] -- ^ dmenu's commandline options -> m URI select file dmenuOptions = do- result <- either (throwError . IOE) return =<< (io . try $ readFile =<< file)+ result <- either (throwError . IOE) return =<< (io . try $ readFile file) --either (\e -> errorHandler file' e >> return Nothing) (\x -> return $ Just x) result parseURIReference . last . words =<< (dmenu dmenuOptions . unlines . sort . nub . (map reformat) . lines $ result)@@ -90,14 +92,13 @@ tags' = sort $ map (\tag -> '[':(tag ++ "]")) tags -- | Open a dmenu with all (sorted alphabetically) bookmarks tags, and return the user's selection, if any.-selectTag :: (Functor m, MonadIO m, MonadError HError m)- => IO FilePath -- ^ Bookmarks' database file+selectTag :: (Functor m, MonadBase IO m, MonadError HError m)+ => FilePath -- ^ Bookmarks' database file -> [String] -- ^ dmenu's commandline options -> m [URI] selectTag file dmenuOptions = do -- Read bookmarks file- file' <- io file- result <- either (throwError . IOE) return =<< (io . try $ readFile file')+ result <- either (throwError . IOE) return =<< (io . try $ readFile file) --file'' <- either (\e -> errorHandler file' e >> return Nothing) (\x -> return $ Just x) result entries <- mapM parseEntry . lines $ result@@ -106,11 +107,11 @@ -- Let user select a tag (map mURI) . (\t -> filter (hasTag t) entries) <$> dmenu dmenuOptions tags --- |+-- --popOldest :: PortableFilePath -> String -> IO (Maybe URI) --popOldest file tags = do --- | Return a random Bookmark entry with a given tag, while removing it from bookmarks.+-- Return a random Bookmark entry with a given tag, while removing it from bookmarks. -- popRandom :: PortableFilePath -- -> String -- -> IO (Maybe URI)@@ -131,18 +132,17 @@ -- | Remove all bookmarks entries matching the given tag.-deleteWithTag :: (Functor m, MonadIO m, MonadError HError m)- => IO FilePath -- ^ Bookmarks' database file+deleteWithTag :: (Functor m, MonadBase IO m, MonadError HError m)+ => FilePath -- ^ Bookmarks' database file -> [String] -- ^ dmenu's commandline options -> m () deleteWithTag file dmenuOptions = do- file' <- io file- result <- either (throwError . IOE) return =<< (io . try $ readFile file')+ result <- either (throwError . IOE) return =<< (io . try $ readFile file) --file'' <- either (\e -> errorHandler file' e >> return Nothing) (\x -> return $ Just x) result entries <- mapM parseEntry . lines $ result let tags = (unlines . sort . nub . words . unwords . (foldr (union . mTags) [])) entries tag <- dmenu dmenuOptions tags- io $ writeFile (file' ++ ".old") $ unlines (map show entries)- io $ writeFile file' $ (unlines . (map show) . (filter (not . (hasTag tag)))) entries+ io $ writeFile (file ++ ".old") $ unlines (map show entries)+ io $ writeFile file $ (unlines . (map show) . (filter (not . (hasTag tag)))) entries
Hbro/Download.hs view
@@ -1,9 +1,10 @@+{-# LANGUAGE FlexibleContexts #-} module Hbro.Download where -- {{{ Imports import Hbro.Util -import Control.Monad.IO.Class+import Control.Monad.Base import Network.URI @@ -11,7 +12,7 @@ -- }}} -aria, wget, axel :: (MonadIO m) => IO FilePath -> URI -> String -> m ()-aria path' uri filename = io $ path' >>= \destination -> spawn "aria2c" [show uri, "-d", destination, "-o", filename]-wget path' uri filename = io $ path' >>= \destination -> spawn "wget" [show uri, "-O", destination </> filename]-axel path' uri filename = io $ path' >>= \destination -> spawn "axel" [show uri, "-o", destination </> filename]+aria, wget, axel :: (MonadBase IO m) => FilePath -> URI -> String -> m ()+aria destination uri filename = spawn "aria2c" [show uri, "-d", destination, "-o", filename]+wget destination uri filename = spawn "wget" [show uri, "-O", destination </> filename]+axel destination uri filename = spawn "axel" [show uri, "-o", destination </> filename]
Hbro/History.hs view
@@ -9,13 +9,15 @@ ) where -- {{{ Imports-import Hbro+import Hbro hiding(log)+-- import Hbro.Error+import Hbro.Gui import Hbro.Misc+import Hbro.Network import Control.Exception+import Control.Monad.Base import Control.Monad.Error--- import Control.Monad.IO.Class-import Control.Monad.Reader import Data.Functor import Data.List@@ -33,7 +35,7 @@ -- {{{ Type definitions data Entry = Entry { mTime :: LocalTime,- mURI :: URI, + mURI :: URI, mTitle :: String } @@ -45,7 +47,7 @@ -- }}} -- | Log current visited page to history file-log :: (MonadIO m, MonadReader r m, HasWebView r, MonadError HError m) => IO FilePath -> m ()+log :: (MonadBase IO m, ConfigReader n m, GUIReader n m, MonadError HError m) => FilePath -> m () log file = do uri <- getURI title <- getTitle@@ -55,13 +57,13 @@ add file (Entry now uri title) -- | Add a new entry to history file-add :: (MonadIO m, MonadError HError m)- => IO FilePath -- ^ History file+add :: (MonadBase IO m, ConfigReader n m, MonadError HError m)+ => FilePath -- ^ History file -> Entry -- ^ History entry to add -> m () add file newEntry = do- file' <- io file- either (throwError . IOE) return =<< (io . try $ withFile file' AppendMode (`hPutStrLn` show newEntry))+ logV $ "Adding new history entry <" ++ show (mURI newEntry) ++ ">"+ either (throwError . IOE) return =<< (io . try $ withFile file AppendMode (`hPutStrLn` show newEntry)) --either (\e -> errorHandler file' e >> return False) (const $ return True) result -- | Try to parse a String into a history Entry.@@ -78,11 +80,10 @@ parseEntry' _ = throwError $ OtherError "While parsing history entry: invalid format." -- | Open a dmenu with all (sorted alphabetically) history entries, and return the user's selection, if any-select :: (Functor m, MonadIO m, MonadError HError m)- => IO FilePath -- ^ Path to history file+select :: (Functor m, MonadBase IO m, MonadError HError m)+ => FilePath -- ^ Path to history file -> [String] -- ^ dmenu's commandline options -> m Entry -- ^ Selected history entry, if any select file dmenuOptions = do- --either (\e -> errorHandler file' e >> return Nothing) (return . return) result- parseEntry =<< dmenu dmenuOptions . unlines . reverse . sort . nub . lines =<< either (throwError . IOE) return =<< (io . try $ readFile =<< file)+ parseEntry =<< dmenu dmenuOptions . unlines . reverse . sort . nub . lines =<< either (throwError . IOE) return =<< (io . try $ readFile file)
Hbro/Misc.hs view
@@ -3,11 +3,13 @@ -- {{{ Imports import Hbro+-- import Hbro.Error+import Hbro.Gui+import Hbro.Network import Control.Exception+import Control.Monad.Base import Control.Monad.Error--- import Control.Monad.IO.Class-import Control.Monad.Reader -- import Data.Functor import Data.Maybe@@ -25,7 +27,7 @@ -- | Open dmenu with given input and return selected entry.-dmenu :: (Functor m, MonadIO m, MonadError HError m)+dmenu :: (Functor m, MonadBase IO m, MonadError HError m) => [String] -- ^ dmenu's commandline options -> String -- ^ dmenu's input -> m String -- ^ Selected entry@@ -41,9 +43,9 @@ -- | List preceding URIs in dmenu and let the user select which one to load.-goBackList :: (Functor m, MonadIO m, MonadReader r m, HasWebView r, MonadError HError m) => [String] -> m URI+goBackList :: (Functor m, MonadBase IO m, GUIReader n m, MonadError HError m) => [String] -> m URI goBackList dmenuOptions = do- list <- io . webViewGetBackForwardList =<< asks _webview+ list <- io . webViewGetBackForwardList =<< readGUI webView n <- io $ webBackForwardListGetBackLength list backList <- io $ webBackForwardListGetBackListWithLimit list n dmenuList <- io $ mapM itemToEntry backList@@ -52,9 +54,9 @@ -- | List succeeding URIs in dmenu and let the user select which one to load.-goForwardList :: (Functor m, MonadIO m, MonadReader r m, HasWebView r, MonadError HError m) => [String] -> m URI+goForwardList :: (Functor m, MonadBase IO m, GUIReader n m, MonadError HError m) => [String] -> m URI goForwardList dmenuOptions = do- list <- io . webViewGetBackForwardList =<< asks _webview+ list <- io . webViewGetBackForwardList =<< readGUI webView n <- io $ webBackForwardListGetForwardLength list forwardList <- io $ webBackForwardListGetForwardListWithLimit list n dmenuList <- io $ mapM itemToEntry forwardList
− Hbro/Session.hs
@@ -1,60 +0,0 @@-module Hbro.Session where---- {{{ Imports---import Hbro.Types--- import Hbro.Util---- import Data.Foldable--- import qualified Data.Text as T--- import qualified Data.Text.IO as T---- import Graphics.UI.Gtk.General.General--- import Graphics.UI.Gtk.WebKit.WebView hiding(webViewGetUri)---- import Prelude hiding(mapM_)---- import System.Directory--- import System.Environment--- import System.Glib.Signals--- import System.IO--- import System.Posix.Process--- import System.Process --- }}}----setupSession :: WebView -> String -> IO ()---setupSession webView sessionDirectory = do--- pid <- getProcessID--- previousSession <- getDirectoryContents sessionDirectory--- --- let sessionFile = sessionDirectory ++ show pid--- --- _ <- on webView loadFinished $ \_ -> do--- webViewGetUri webView >>= mapM_ ((writeFile sessionFile) . show)--- --- _ <- quitAdd 0 $ do--- removeFile sessionFile--- return False--- --- return ()-----loadFromSession :: [String] -> String -> IO ()---loadFromSession dmenuOptions sessionDirectory = do--- previousSession <- getDirectoryContents sessionDirectory--- sessionURIs <- mapM getSessionURI previousSession --- --- selection <- dmenu dmenuOptions (T.unlines sessionURIs)--- --- case selection of--- "" -> return ()--- u -> do--- _ <- spawn "hbro" ["-u", u]--- return ()--- ---getSessionURI :: String -> IO T.Text---getSessionURI fileName = do--- configHome <- getEnv "XDG_CONFIG_HOME"--- file <- T.readFile $ configHome ++ "/hbro/sessions/" ++ fileName--- --- return $ (head . T.lines) file-
Hbro/StatusBar.hs view
@@ -1,15 +1,15 @@+{-# LANGUAGE FlexibleContexts #-} module Hbro.StatusBar where -- {{{ Imports--- import Hbro.Core---import Hbro.Keys+import Hbro.Config+import Hbro.Keys as Key import Hbro.Gui-import Hbro.Types-import Hbro.Util +import Hbro.Util import Control.Monad hiding(forM_, mapM_)-import Control.Monad.IO.Class-import Control.Monad.Reader hiding(forM_, mapM_)+import Control.Monad.Base+-- import Control.Monad.Reader hiding(forM_, mapM_) import Data.Foldable import Data.List@@ -32,104 +32,93 @@ -- }}} --- notify :: Environment -> String -> Color -> IO ()--- notify env text color = do--- widget <- builderGetObject ((_builder . _UI) env) castToLabel "feedback"--- labelSetAttributes widget [Attrforeground{ paStart = 0, paEnd = -1, paColor = color }]--- labelSetMarkupTemporary widget text 5000-- -- | Write current scroll position in the given Label.-setupScrollWidget :: (MonadIO m, MonadReader r m, HasScrollWindow r) => Label -> m ()+setupScrollWidget :: (MonadBase IO m, GUIReader n m) => Label -> m () setupScrollWidget widget = do- adjustment <- io . scrolledWindowGetVAdjustment =<< asks _scrollwindow+ adjustment <- io . scrolledWindowGetVAdjustment =<< readGUI scrollWindow io $ labelSetAttributes widget [AttrForeground {paStart = 0, paEnd = -1, paColor = Color 32767 32767 32767}]- - _ <- io $ onValueChanged adjustment $ do++ io . void . onValueChanged adjustment $ do current <- adjustmentGetValue adjustment lower <- adjustmentGetLower adjustment upper <- adjustmentGetUpper adjustment page <- adjustmentGetPageSize adjustment- + case upper-lower-page of 0 -> labelSetText widget "ALL" x -> labelSetText widget $ show (round $ current/x*100) ++ "%"- + io $ labelSetText widget "0%" --- | /!\ Doesn't work for now.+-- | /!\\ Doesn't work for now. -- Write current zoom level in the given Label.-setupZoomWidget :: (MonadIO m, MonadReader r m, HasWebView r) => Label -> m ()+setupZoomWidget :: (MonadBase IO m, GUIReader n m) => Label -> m () setupZoomWidget widget = do- io $ labelSetAttributes widget [AttrForeground {paStart = 0, paEnd = -1, paColor = Color 65535 65535 65535}] - asks _webview >>= io . webViewGetZoomLevel >>= io . labelSetMarkup widget . escapeMarkup . show - --- | -printInLabel :: (MonadIO m, MonadReader r m, HasGUI r) => String -> (String, Bool) -> m (String, Bool)-printInLabel label (keystrokes, match) = do - widget <- getObject castToLabel label+ io $ labelSetAttributes widget [AttrForeground {paStart = 0, paEnd = -1, paColor = Color 65535 65535 65535}]+ readGUI webView >>= io . webViewGetZoomLevel >>= io . labelSetMarkup widget . escapeMarkup . show++-- | Write current keystrokes state in the given 'Label'+setupKeyStrokesWidget :: (MonadBase IO m, ConfigWriter m m, GUIReader m m) => Label -> m ()+setupKeyStrokesWidget widget = do io $ labelSetAttributes widget [AttrForeground {paStart = 0, paEnd = -1, paColor = Color 65535 65535 0}]- io $ case match of- True -> labelSetText widget []- _ -> labelSetText widget keystrokes- - return (keystrokes, match) --- | Write current load progress in the given Label.-setupProgressWidget :: (MonadIO m, MonadReader r m, HasWebView r) => Label -> m ()+ writeConfig onKeyStroke $ io . labelSetText widget . intercalate " " . map Key.serialize++-- | Write current load progress in the given 'Label'.+setupProgressWidget :: (MonadBase IO m, GUIReader n m) => Label -> m () setupProgressWidget widget = do- webView <- asks _webview+ wv <- readGUI webView -- Load started- _ <- io $ on webView loadStarted $ \_ -> do+ io . void . on wv loadStarted $ \_ -> do labelSetAttributes widget [AttrForeground {paStart = 0, paEnd = -1, paColor = Color 65535 0 0}] labelSetText widget "0%"--- Progress changed - _ <- io $ on webView progressChanged $ \progress' -> do+-- Progress changed+ io . void . on wv progressChanged $ \progress' -> do labelSetAttributes widget [AttrForeground {paStart = 0, paEnd = -1, paColor = Color 65535 65535 0}] labelSetText widget $ show progress' ++ "%" -- Load finished- _ <- io $ on webView loadFinished $ \_ -> do+ io . void . on wv loadFinished $ \_ -> do labelSetAttributes widget [AttrForeground {paStart = 0, paEnd = -1, paColor = Color 0 65535 0}] labelSetText widget "100%" -- Error- _ <- io $ on webView loadError $ \_ _ _ -> do+ io . void . on wv loadError $ \_ _ _ -> do labelSetAttributes widget [AttrForeground {paStart = 0, paEnd = -1, paColor = Color 65535 0 0}] labelSetText widget "ERROR" return False- + return () -- | Write current URI, or the destination of a hovered link, in the given Label.-setupURIWidget :: (MonadIO m, MonadReader r m, HasWebView r) => URIColors -> URIColors -> Label -> m ()+setupURIWidget :: (MonadBase IO m, GUIReader n m) => URIColors -> URIColors -> Label -> m () setupURIWidget normalColors secureColors widget = do- webView <- asks _webview+ wv <- readGUI webView -- URI changed- _ <- io $ on webView loadCommitted $ \_ ->- (mapM_ (labelSetURI normalColors secureColors widget)) =<< ((>>= N.parseURIReference) `fmap` (webViewGetUri webView))+ _ <- io $ on wv loadCommitted $ \_ ->+ (mapM_ (labelSetURI normalColors secureColors widget)) =<< ((>>= N.parseURIReference) `fmap` (webViewGetUri wv)) -- Link (un)hovered- _ <- io $ on webView hoveringOverLink $ \_title hoveredURI -> do- uri <- webViewGetUri webView- + _ <- io $ on wv hoveringOverLink $ \_title hoveredURI -> do+ uri <- webViewGetUri wv+ forM_ (hoveredURI >>= N.parseURIReference) $ labelSetURI normalColors secureColors widget unless (isJust hoveredURI) $ forM_ (uri >>= N.parseURIReference) (labelSetURI normalColors secureColors widget)- + return () --- | +-- | labelSetURI :: URIColors -> URIColors -> Label -> URI -> IO () labelSetURI normalColors secureColors widget uri = do let colors = case uriScheme uri of "https:" -> secureColors _ -> normalColors- + let i:j:k:l:_ = map length [ uriScheme uri, maybe [] uriRegName (uriAuthority uri), uriPath uri, uriQuery uri]- + labelSetAttributes widget $ [ AttrWeight{ paStart = 0, paEnd = -1, paWeight = WeightBold }, AttrForeground{ paStart = 0, paEnd = i+2, paColor = mScheme colors },@@ -137,10 +126,10 @@ AttrForeground{ paStart = i+2+j, paEnd = i+2+j+k, paColor = mPath colors }, AttrForeground{ paStart = i+2+j+k, paEnd = i+2+j+k+l, paColor = mQuery colors }, AttrForeground{ paStart = i+2+j+k+l, paEnd = -1, paColor = mFragment colors }]- + labelSetText widget (show uri)- - ++ data URIColors = URIColors { mScheme :: Color, mHost :: Color,
examples/hbro.hs view
@@ -6,150 +6,101 @@ import qualified Hbro.Bookmarks as Bookmarks import qualified Hbro.Clipboard as Clipboard import qualified Hbro.Download as Download+import qualified Hbro.Gui as GUI import qualified Hbro.History as History+import Hbro.Keys as Key import Hbro.Misc+import Hbro.Network+import Hbro.Notification import qualified Hbro.Prompt as Prompt-import Hbro.Session+-- import Hbro.Session import Hbro.Settings import Hbro.StatusBar import qualified Hbro.Webkit.WebSettings as WS import Control.Conditional+import Control.Lens hiding((??)) import Control.Monad hiding(forM_, mapM_)-import Control.Monad.Error hiding(forM_, mapM_)-import Control.Monad.IO.Class -import Data.Default-import Data.Foldable-import Data.Functor-import Data.Monoid-import Data.Time--import Graphics.UI.Gtk.Abstract.Widget-import Graphics.UI.Gtk.Builder import Graphics.UI.Gtk.Display.Label-import Graphics.UI.Gtk.Entry.Entry-import Graphics.UI.Gtk.Gdk.EventM-import Graphics.UI.Gtk.Gdk.GC-import Graphics.UI.Gtk.General.General-import Graphics.UI.Gtk.WebKit.Download-import Graphics.UI.Gtk.WebKit.NetworkRequest-import Graphics.UI.Gtk.WebKit.WebNavigationAction import Graphics.UI.Gtk.WebKit.WebSettings-import Graphics.UI.Gtk.Windows.Window import Network.URI hiding(parseURI, parseURIReference) import Prelude hiding(mapM_) import System.Directory-import System.Environment import System.Environment.XDG.BaseDir import System.FilePath-import System.Glib.Attributes-import System.Glib.Signals--- import System.Posix.Process-import System.Process -- }}} --- {{{ Configuration structures--- Any field you don't override will use the defaults defined in Hbro.Types.Config.-myConfig :: Config-myConfig = def {- __UIFile = myUIFile,- __homePage = myHomePage}--- }}} --- {{{ Constant parameters-myHomePage = URI "https:" (Just $ URIAuth "" "//duckduckgo.com" "") "" "" ""+myHomePage = URI "http:" (Just $ URIAuth "" "//www.google.com" "") "" "" "" -- Seriously ? -myUIFile, myHistoryFile, myBookmarksFile, myDownloadDirectory :: IO FilePath-myUIFile = getUserConfigDir "hbro" >/> "ui.xml"-myHistoryFile = getUserDataDir "hbro" >/> "history"-myBookmarksFile = getUserDataDir "hbro" >/> "bookmarks"-myDownloadDirectory = getHomeDirectory--- }}}+-- Download to $HOME+myDownloadHook :: URI -> String -> Int -> K ()+myDownloadHook uri filename _size = do+ destination <- io getHomeDirectory+ Download.aria destination uri filename --- {{{ Keys--- Note that this example is suited for an azerty keyboard.-myKeys :: KeysList-myKeys = def <> KeysList [+myLoadFinishedHook :: K ()+myLoadFinishedHook = History.log =<< getUserDataDir "hbro" >/> "history"++-- Setup (run at start-up)+-- Note that keybindings are suited for an azerty keyboard.+mySetup :: K ()+mySetup = do+ myHistoryFile <- getUserDataDir "hbro" >/> "history"+ myBookmarksFile <- getUserDataDir "hbro" >/> "bookmarks"+ -- Browse- ("C-<Left>", goBackList ["-l", "10"] >>= loadURI),- ("C-<Right>", goForwardList ["-l", "10"] >>= loadURI),- ("C-g", Prompt.read "DuckDuckGo search" "" (loadURI <=< parseURIReference . ("https://duckduckgo.com/html?q=" ++) . escapeURIString isAllowedInURI)),+ bind Key.Normal "C-<Left>" $ goBackList ["-l", "10"] >>= load+ bind Key.Normal "C-<Right>" $ goForwardList ["-l", "10"] >>= load+ bind Key.Normal "C-g" $ Prompt.read "DuckDuckGo search" "" (load <=< parseURIReference . ("http://duckduckgo.com/html?q=" ++) . escapeURIString isAllowedInURI) -- Bookmarks- ("C-d", Prompt.read "Bookmark with tags:" "" $ Bookmarks.add myBookmarksFile . words),- ("C-D", Prompt.read "Bookmark all instances with tag:" "" $ \tags -> do+ bind Key.Normal "C-d" $ Prompt.read "Bookmark with tags:" "" $ Bookmarks.add myBookmarksFile . words+{- bind Key.Normal "C-D" $ Prompt.read "Bookmark all instances with tag:" "" $ \tags -> do uris <- mapM parseURI =<< sendCommandToAll "GET_URI" forM uris $ Bookmarks.addCustom myBookmarksFile . (`Bookmarks.Entry` words tags)- void . Bookmarks.addCustom myBookmarksFile . (`Bookmarks.Entry` words tags) =<< getURI- ),- ("M-d", Bookmarks.deleteWithTag myBookmarksFile ["-l", "10"]),- ("C-l", Bookmarks.select myBookmarksFile ["-l", "10"] >>= loadURI),- ("C-L", Bookmarks.selectTag myBookmarksFile ["-l", "10"] >>= void . mapM (\uri -> io $ spawn "hbro" ["-u", (show uri)])),+ void . Bookmarks.addCustom myBookmarksFile . (`Bookmarks.Entry` words tags) =<< getURI-}+ bind Key.Normal "M-d" $ Bookmarks.deleteWithTag myBookmarksFile ["-l", "10"]+ bind Key.Normal "C-l" $ Bookmarks.select myBookmarksFile ["-l", "10"] >>= load+ bind Key.Normal "C-L" $ Bookmarks.selectTag myBookmarksFile ["-l", "10"] >>= void . mapM (\uri -> io $ spawn "hbro" ["-u", (show uri)]) -- ("C-q"), webViewGetUri webView >>= maybe (return ()) (Queue.append), -- ("M-q"), \b -> do -- uri <- Queue.popFront--- loadURI uri b),+-- load uri b), -- History- ("C-h", History.select myHistoryFile ["-l", "10"] >>= loadURI . History.mURI),-+ bind Key.Normal "C-h" $ History.select myHistoryFile ["-l", "10"] >>= load . History.mURI -- Session --("M-l"), loadFromSession ["-l", "10"]) -- Settings- ("M-j", WS.toggle webSettingsEnableScripts >>= ((notify 5000 "Javascript disabled") ?? (notify 5000 "Javascript enabled"))),- ("M-p", WS.toggle webSettingsEnablePlugins >>= ((notify 5000 "Plugins disabled") ?? (notify 5000 "Plugins enabled")))- ]--- }}}--myDownloadHook :: DownloadHook-myDownloadHook = DownloadHook $ \uri filename _size -> Download.aria myDownloadDirectory uri filename--myKeyHook :: KeyHook-myKeyHook = emacsKeyHandler myKeys ["M-x"]-- >=> void . (printInLabel "keys")--myLoadFinishedHook = LoadFinishedHook $ History.log myHistoryFile---- Main function, expected to call launchHbro.-main :: IO ()-main = hbro myConfig $ Setup $ do--- Hooks- afterKeyPressed myKeyHook- onDownload myDownloadHook- onLoadFinished myLoadFinishedHook- onNavigationRequest def- onNewWebView def- onNewWindow def- onResourceOpened def- onTitleChanged def+ bind Key.Normal "M-j" $ WS.toggle webSettingsEnableScripts >>= ((notify 5000 "Javascript disabled") ?? (notify 5000 "Javascript enabled"))+ bind Key.Normal "M-p" $ WS.toggle webSettingsEnablePlugins >>= ((notify 5000 "Plugins disabled") ?? (notify 5000 "Plugins enabled")) -- Web settings (cf Graphic.Gtk.WebKit.WebSettings)- WS.modify webSettingsMonospaceFontFamily $ const "consolas"- WS.modify webSettingsEnableDeveloperExtras $ const True WS.modify webSettingsEnablePlugins $ const False- WS.modify webSettingsEnablePrivateBrowsing $ const False WS.modify webSettingsEnableScripts $ const False- WS.modify webSettingsEnableUniversalAccessFromFileUris $ const True- WS.modify webSettingsEnableXssAuditor $ const True WS.modify webSettingsEnablePageCache $ const True WS.modify webSettingsJSCanOpenWindowAuto $ const True- WS.modify webSettingsSpellCheckingLang $ const $ Just "en_US" WS.modify webSettingsUserAgent $ const firefoxUserAgent -- Scroll position in status bar- setupScrollWidget =<< getObject castToLabel "scroll"+ setupScrollWidget =<< GUI.getObject castToLabel "scroll" -- Zoom level in status bar- setupZoomWidget =<< getObject castToLabel "zoom"+ setupZoomWidget =<< GUI.getObject castToLabel "zoom" -- Load progress in status bar- setupProgressWidget =<< getObject castToLabel "progress"+ setupProgressWidget =<< GUI.getObject castToLabel "progress" -- Current URI in status bar- setupURIWidget defaultURIColors defaultSecureURIColors =<< getObject castToLabel "uri"+ setupURIWidget defaultURIColors defaultSecureURIColors =<< GUI.getObject castToLabel "uri" +-- Keystrokes in status bar+ setupKeyStrokesWidget =<< GUI.getObject castToLabel "keys"+ -- Session manager --setupSession browser @@ -157,3 +108,18 @@ --_ <- on webView iconLoaded $ \uri -> do something return ()+++myConfig :: FilePath -> Config K -> Config K+myConfig myUIFile = id+ . set uIFile myUIFile+ . set homePage myHomePage+ . set onDownload myDownloadHook+ . set onLoadFinished myLoadFinishedHook+++-- Main function, expected to call 'hbro'+main :: IO ()+main = do+ myUIFile <- getUserConfigDir "hbro" >/> "ui.xml"+ hbro mySetup $ myConfig myUIFile
hbro-contrib.cabal view
@@ -1,5 +1,5 @@ Name: hbro-contrib-Version: 1.0.0.0+Version: 1.1.0.0 Synopsis: Third-party extensions to hbro. -- Description: Homepage: https://github.com/k0ral/hbro-contrib/@@ -38,7 +38,7 @@ -- random-fu, text, time,- transformers,+ transformers-base, unix, webkit Exposed-modules:@@ -46,7 +46,6 @@ Hbro.Download, Hbro.History, Hbro.Misc,- Hbro.Session, Hbro.Settings, Hbro.StatusBar Ghc-options: -Wall