module Hbro.Misc where
import Hbro
import Hbro.Gui
import Hbro.Network
import Control.Exception
import Control.Monad.Base
import Control.Monad.Error
import Data.Maybe
import Graphics.UI.Gtk.WebKit.WebBackForwardList
import Graphics.UI.Gtk.WebKit.WebHistoryItem
import Graphics.UI.Gtk.WebKit.WebView
import Network.URI (URI)
import System.IO
import System.Process
dmenu :: (Functor m, MonadBase IO m, MonadError HError m)
=> [String]
-> String
-> m String
dmenu options input = do
(in_, out, err, pid) <- io $ runInteractiveProcess "dmenu" options Nothing Nothing
io $ hPutStr in_ input
io $ hClose in_
output <- either (throwError . IOE) return =<< (io . try $ hGetLine out)
io (hClose out) >> io (hClose err) >> (void . io $ waitForProcess pid)
return output
goBackList :: (Functor m, MonadBase IO m, GUIReader n m, MonadError HError m) => [String] -> m URI
goBackList dmenuOptions = do
list <- io . webViewGetBackForwardList =<< readGUI webView
n <- io $ webBackForwardListGetBackLength list
backList <- io $ webBackForwardListGetBackListWithLimit list n
dmenuList <- io $ mapM itemToEntry backList
parseURIReference . head . words =<< (dmenu dmenuOptions . unlines . catMaybes) dmenuList
goForwardList :: (Functor m, MonadBase IO m, GUIReader n m, MonadError HError m) => [String] -> m URI
goForwardList dmenuOptions = do
list <- io . webViewGetBackForwardList =<< readGUI webView
n <- io $ webBackForwardListGetForwardLength list
forwardList <- io $ webBackForwardListGetForwardListWithLimit list n
dmenuList <- io $ mapM itemToEntry forwardList
parseURIReference . head . words =<< (dmenu dmenuOptions . unlines . catMaybes) dmenuList
itemToEntry :: WebHistoryItem -> IO (Maybe String)
itemToEntry item = do
title <- webHistoryItemGetTitle item
uri <- webHistoryItemGetUri item
case uri of
Just u -> return $ Just (u ++ " | " ++ (maybe "Untitled" id title))
_ -> return Nothing