hbro 0.6.6 → 0.6.7
raw patch · 9 files changed
+154/−87 lines, 9 files
Files
- Hbro/Core.hs +29/−19
- Hbro/Extra/Bookmarks.hs +1/−41
- Hbro/Extra/BookmarksQueue.hs +96/−0
- Hbro/Extra/Clipboard.hs +1/−1
- Hbro/Extra/History.hs +1/−1
- Hbro/Extra/Prompt.hs +3/−3
- Hbro/Socket.hs +15/−18
- examples/hbro.hs +6/−3
- hbro.cabal +2/−1
Hbro/Core.hs view
@@ -10,6 +10,7 @@ import Control.Concurrent import Control.Monad.Trans(liftIO) +import Data.ByteString.Char8 (pack) import qualified Data.Map as Map import qualified Data.Set as Set @@ -26,6 +27,7 @@ import System.Console.CmdArgs import System.Glib.Signals import System.Posix.Process+import qualified System.ZMQ as ZMQ -- }}} @@ -72,18 +74,11 @@ let browser = Browser options configuration gui let webView = mWebView gui - -- Load addtionnal settings from configuration+ -- Load additionnal settings from configuration settings <- mWebSettings configuration webViewSetWebSettings webView settings (mSetup configuration) browser - -- Initialize IPC socket- pid <- getProcessID- let socketURI = "ipc://" ++ (mSocketDir configuration) ++ "/hbro." ++ show pid- putStrLn $ "Listening socket " ++ socketURI-- _ <- forkIO $ createRepSocket socketURI browser- -- Load homepage goHome browser @@ -120,7 +115,22 @@ widgetShowAll (mWindow gui) showPrompt False browser - mainGUI++ -- Initialize IPC socket+ pid <- getProcessID+ let socketURI = "ipc://" ++ (mSocketDir configuration) ++ "/hbro." ++ show pid+ putStrLn $ "Listening socket " ++ socketURI++ ZMQ.withContext 1 $ \context -> do+ _ <- forkIO $ createRepSocket context socketURI browser+ + mainGUI++ ZMQ.withSocket context ZMQ.Req $ \reqSocket -> do+ ZMQ.connect reqSocket socketURI+ ZMQ.send reqSocket (pack "Quit") []+ reply <- ZMQ.receive reqSocket []+ return () -- }}} @@ -128,8 +138,8 @@ -- | Load homepage (retrieved from commandline options or configuration file) goHome :: Browser -> IO () goHome browser = case (mURI $ mOptions browser) of- Just uri -> loadURL uri browser- _ -> loadURL (mHomePage $ mConfiguration browser) browser+ Just uri -> loadURI uri browser+ _ -> loadURI (mHomePage $ mConfiguration browser) browser -- | Wrapper around webViewGoBack function goBack :: Browser -> IO ()@@ -150,19 +160,19 @@ reload _ browser = webViewReloadBypassCache (mWebView $ mGUI browser) -- | Load given URL in the browser.-loadURL :: String -> Browser -> IO ()-loadURL url browser =+loadURI :: String -> Browser -> IO ()+loadURI url browser = case importURL url of- Just url' -> loadURL' url' browser+ Just url' -> loadURI' url' browser _ -> return () --- | Backend function for loadURL.-loadURL' :: URL -> Browser -> IO ()-loadURL' url@URL {url_type = Absolute _} browser =+-- | Backend function for loadURI.+loadURI' :: URL -> Browser -> IO ()+loadURI' url@URL {url_type = Absolute _} browser = webViewLoadUri (mWebView $ mGUI browser) (exportURL url)-loadURL' url@URL {url_type = HostRelative} browser = +loadURI' url@URL {url_type = HostRelative} browser = webViewLoadUri (mWebView $ mGUI browser) ("file://" ++ exportURL url) >> putStrLn (show url)-loadURL' url@URL {url_type = _} browser = +loadURI' url@URL {url_type = _} browser = webViewLoadUri (mWebView $ mGUI browser) ("http://" ++ exportURL url) >> print url -- }}}
Hbro/Extra/Bookmarks.hs view
@@ -5,9 +5,6 @@ loadWithTag, deleteWithTag, add,- appendQueue,- popQueue,- popAndLoadQueue ) where -- {{{ Imports@@ -95,7 +92,7 @@ entry <- catch (hGetLine output) (\e -> return "ERROR" ) case reverse . words $ entry of ["ERROR"] -> return ()- uri:_ -> loadURL uri browser+ uri:_ -> loadURI uri browser _ -> return () @@ -178,40 +175,3 @@ -- | getUri :: T.Text -> T.Text getUri line = let uri:_ = T.words line in uri----- {{{ Queueing system--- | -appendQueue :: Browser -> IO ()-appendQueue browser = do- uri <- webViewGetUri (mWebView $ mGUI browser)- configHome <- getEnv "XDG_CONFIG_HOME"-- case uri of- Just u -> appendFile (configHome ++ "/hbro/queue") (u ++ "\n")- _ -> return ()---- | -popQueue :: Browser -> IO String-popQueue browser = do- configHome <- getEnv "XDG_CONFIG_HOME"- file <- catch (T.readFile $ configHome ++ "/hbro/queue") (\e -> return T.empty)-- if file == T.empty- then return ""- else do- let fileLines = T.lines file- let file' = T.unlines . tail . nub $ fileLines- - T.writeFile (configHome ++ "/hbro/queue.old") file- T.writeFile (configHome ++ "/hbro/queue") file'-- return $ T.unpack (head fileLines)--popAndLoadQueue :: Browser -> IO ()-popAndLoadQueue browser = do- uri <- popQueue browser- case uri of- "" -> return ()- _ -> loadURL uri browser --- }}}
+ Hbro/Extra/BookmarksQueue.hs view
@@ -0,0 +1,96 @@+module Hbro.Extra.BookmarksQueue where++-- {{{ Imports+import Hbro.Types++import Data.List+import qualified Data.Text as T+import qualified Data.Text.IO as T++import Graphics.UI.Gtk.WebKit.WebView++import System.Environment+-- }}}+++-- | Add current URI to the end of the queue.+append :: Browser -> IO ()+append browser = do+ uri <- webViewGetUri (mWebView $ mGUI browser)+ configHome <- getEnv "XDG_CONFIG_HOME"++ case uri of+ Just u -> appendFile (configHome ++ "/hbro/queue") (u ++ "\n")+ _ -> return ()++-- | Add current URI to the beginning of the queue.+push :: Browser -> IO ()+push browser = do+ uri <- webViewGetUri (mWebView $ mGUI browser)+ configHome <- getEnv "XDG_CONFIG_HOME"+ file <- catch (T.readFile $ configHome ++ "/hbro/queue") (\e -> return T.empty)++ case uri of + Just u ->+ if (file == T.empty)+ then return ()+ else do+ let fileLines = T.lines file+ let file' = T.unlines . nub $ (T.pack u):fileLines+ + T.writeFile (configHome ++ "/hbro/queue") file'++ return ()+ _ -> return ()++-- | Return the first URI from the queue, while removing it.+popFront :: Browser -> IO String+popFront browser = do+ configHome <- getEnv "XDG_CONFIG_HOME"+ file <- catch (T.readFile $ configHome ++ "/hbro/queue") (\e -> return T.empty)++ if file == T.empty+ then return ""+ else do+ let fileLines = T.lines file+ let file' = T.unlines . tail . nub $ fileLines+ + T.writeFile (configHome ++ "/hbro/queue.old") file+ T.writeFile (configHome ++ "/hbro/queue") file'++ return $ T.unpack (head fileLines)++-- | Return the last URI from the queue, while removing it.+popBack :: Browser -> IO String+popBack browser = do+ configHome <- getEnv "XDG_CONFIG_HOME"+ file <- catch (T.readFile $ configHome ++ "/hbro/queue") (\e -> return T.empty)++ if file == T.empty+ then return ""+ else do+ let fileLines = T.lines file+ let file' = T.unlines . reverse . tail . reverse. nub $ fileLines+ + T.writeFile (configHome ++ "/hbro/queue.old") file+ T.writeFile (configHome ++ "/hbro/queue") file'++ return $ T.unpack (head $ reverse fileLines)++-- | Return a random URI from the queue, while removing it.+-- popRandom :: Browser -> IO String+-- popRandom browser = do+-- configHome <- getEnv "XDG_CONFIG_HOME"+-- file <- catch (T.readFile $ configHome ++ "/hbro/queue") (\e -> return T.empty)++-- if file == T.empty+-- then return ""+-- else do+-- let fileLines = T.lines file+-- let file' = T.unlines . reverse . tail . reverse. nub $ fileLines+-- +-- T.writeFile (configHome ++ "/hbro/queue.old") file+-- T.writeFile (configHome ++ "/hbro/queue") file'++-- return $ T.unpack (head $ reverse fileLines)+
Hbro/Extra/Clipboard.hs view
@@ -36,6 +36,6 @@ primaryClip <- widgetGetClipboard (mWindow $ mGUI browser) selectionPrimary _ <- clipboardRequestText primaryClip $ \x -> case x of- Just uri -> putStrLn ("Loading URI from clipboard: " ++ uri) >> loadURL uri browser+ Just uri -> putStrLn ("Loading URI from clipboard: " ++ uri) >> loadURI uri browser _ -> putStrLn "Loading URI from clipboard: empty clipboard." return ()
Hbro/Extra/History.hs view
@@ -37,7 +37,7 @@ let uri:_ = words $ r in- loadURL uri browser+ loadURI uri browser _ -> putStrLn e where
Hbro/Extra/Prompt.hs view
@@ -26,15 +26,15 @@ return () -- | Prompt for URI to open in current window.-promptURL :: Bool -> Browser -> IO() +promptURL :: Bool -> Browser -> IO () promptURL False browser = prompt "Open URL" "" False browser (\b -> do uri <- entryGetText (mPromptEntry $ mGUI b)- loadURL uri b)+ loadURI uri b) promptURL _ browser = do uri <- webViewGetUri (mWebView $ mGUI browser) case uri of Just url -> prompt "Open URL" url False browser (\b -> do u <- entryGetText (mPromptEntry $ mGUI b)- loadURL u b)+ loadURI u b) _ -> return ()
Hbro/Socket.hs view
@@ -3,8 +3,6 @@ -- {{{ Imports import Hbro.Types -import Control.Monad- import Data.ByteString.Char8 (pack, unpack) import qualified Data.Map as Map @@ -15,31 +13,30 @@ -- }}} -- | Create a response socket to listen for commands.--- Loops on listenToSocket forever.-createRepSocket :: String -> Browser -> IO a-createRepSocket socketURI browser = withContext 1 $ \context -> do+-- Loops on listenToSocket until "Quit" command is received.+createRepSocket :: Context -> String -> Browser -> IO ()+createRepSocket context socketURI browser = withSocket context Rep $ \repSocket -> do- bind repSocket socketURI- setOption repSocket (Linger 0)+ bind repSocket socketURI+ listenToSocket repSocket commandsList browser+ where+ commandsList = Map.fromList (defaultCommandsList ++ (mCommands $ mConfiguration browser)) - _ <- quitAdd 0 $ do- close repSocket- return False - let commandsList = Map.fromList (defaultCommandsList ++ (mCommands $ mConfiguration browser))- - forever $ listenToSocket repSocket commandsList browser- -- | Listen for incoming requests from response socket. -- Parse received commands and feed the corresponding callback, if any. listenToSocket :: Socket Rep -> CommandsMap -> Browser -> IO () listenToSocket repSocket commands browser = do message <- receive repSocket []- let command:arguments = words $ unpack message+ case words (unpack message) of+ [] -> send repSocket (pack "ERROR Unknown command") []+ ["Quit"] -> send repSocket (pack "OK") []+ command:arguments -> do+ case Map.lookup command commands of+ Just callback -> callback arguments repSocket browser+ _ -> send repSocket (pack "ERROR Unknown command") [] - case Map.lookup command commands of- Just callback -> callback arguments repSocket browser- _ -> send repSocket (pack "ERROR Unknown command") []+ listenToSocket repSocket commands browser -- | List of default supported requests. defaultCommandsList :: CommandsList
examples/hbro.hs view
@@ -4,6 +4,7 @@ import Hbro.Config import Hbro.Core import qualified Hbro.Extra.Bookmarks as Bookmarks+import qualified Hbro.Extra.BookmarksQueue as Queue import Hbro.Extra.Clipboard import Hbro.Extra.History import Hbro.Extra.Misc@@ -111,8 +112,10 @@ (([Alt], "d"), Bookmarks.deleteWithTag), (([Control], "l"), Bookmarks.load), (([Control, Shift], "L"), Bookmarks.loadWithTag),- (([Control], "q"), Bookmarks.appendQueue),- (([Alt], "q"), Bookmarks.popAndLoadQueue)+ (([Control], "q"), Queue.append),+ (([Alt], "q"), \b -> do+ uri <- Queue.popFront b+ loadURI uri b) ] historyKeys :: KeysList@@ -271,6 +274,6 @@ promptGoogle browser = prompt "Google search" "" False browser (\browser' -> do keyWords <- entryGetText (mPromptEntry $ mGUI browser')- loadURL ("https://www.google.com/search?q=" ++ keyWords) browser'+ loadURI ("https://www.google.com/search?q=" ++ keyWords) browser' return ())
hbro.cabal view
@@ -1,5 +1,5 @@ Name: hbro-Version: 0.6.6+Version: 0.6.7 Synopsis: A suckless minimal KISSy browser -- Description: Homepage: http://projects.haskell.org/hbro/@@ -44,6 +44,7 @@ Hbro.Config, Hbro.Core, Hbro.Extra.Bookmarks,+ Hbro.Extra.BookmarksQueue, Hbro.Extra.Clipboard, Hbro.Extra.History, Hbro.Extra.Misc,