module Hbro.Misc where
import Hbro
import Control.Exception
import Control.Monad.Error
import Control.Monad.Reader
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, MonadIO 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, MonadIO m, MonadReader r m, HasWebView r, MonadError HError m) => [String] -> m URI
goBackList dmenuOptions = do
list <- io . webViewGetBackForwardList =<< asks _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, MonadIO m, MonadReader r m, HasWebView r, MonadError HError m) => [String] -> m URI
goForwardList dmenuOptions = do
list <- io . webViewGetBackForwardList =<< asks _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