{-# LANGUAGE FlexibleContexts #-} module Hbro.Misc where -- {{{ Imports import Hbro import Control.Exception import Control.Monad.Error -- import Control.Monad.IO.Class import Control.Monad.Reader -- import Data.Functor import Data.Maybe -- import Graphics.UI.Gtk.Display.Label 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 -- }}} -- | Open dmenu with given input and return selected entry. dmenu :: (Functor m, MonadIO m, MonadError HError m) => [String] -- ^ dmenu's commandline options -> String -- ^ dmenu's input -> m String -- ^ Selected entry 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 -- | 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 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 -- | 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 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