module Hbro.Extra.Bookmarks ( addWithTags, addAllWithTags, load, loadWithTag, deleteWithTag, add, ) where -- {{{ Imports import Hbro.Core import Hbro.Gui import Hbro.Types import Hbro.Util import qualified Data.ByteString.Char8 as B import Data.List import qualified Data.Text as T import qualified Data.Text.IO as T import Graphics.UI.Gtk.Entry.Entry import Graphics.UI.Gtk.WebKit.WebView import System.Environment import qualified System.Info as Sys import System.IO import System.Posix.Process import System.Process import System.ZMQ -- }}} -- | Add current URI to bookmarks. -- Prompt for a tags list to apply. addWithTags :: Browser -> IO () addWithTags browser = do uri <- webViewGetUri (mWebView $ mGUI browser) case uri of Just u -> prompt "Bookmark with tags:" "" False browser (\b -> do tags <- entryGetText (mPromptEntry $ mGUI b) add u (words tags)) _ -> return () -- | Add current URIs from all opened windows to bookmarks. addAllWithTags :: Browser -> IO () addAllWithTags browser = prompt "Bookmark all instances with tag:" "" False browser (\b -> do tags <- entryGetText (mPromptEntry $ mGUI b) uri <- webViewGetUri (mWebView $ mGUI browser) case uri of Just u -> add u $ words tags _ -> return () (_, pids, _) <- readProcessWithExitCode "pidof" ["hbro"] [] (_, pids', _) <- readProcessWithExitCode "pidof" ["hbro-" ++ Sys.os ++ "-" ++ Sys.arch] [] myPid <- getProcessID let pidsList = delete (show myPid) . nub . words $ pids ++ " " ++ pids' let bookmarkPID = (\pid -> withContext 1 $ \context -> do withSocket context Req $ \reqSocket -> let socketURI = "ipc://" ++ (mSocketDir $ mConfiguration browser) ++ "/hbro." ++ pid in do connect reqSocket socketURI send reqSocket (B.pack "getUri") [] uri' <- receive reqSocket [] add (B.unpack uri') (words tags) ) _ <- mapM bookmarkPID pidsList return ()) -- | load :: Browser -> IO () load browser = do -- Load bookmarks file configHome <- getEnv "XDG_CONFIG_HOME" file <- T.readFile $ configHome ++ "/hbro/bookmarks" -- Reformat lines let file' = T.unlines . sort . nub $ map reformat (T.lines file) -- Let user select a URI (Just input, Just output, _, _) <- createProcess (proc "dmenu" ["-l", "10"]) { std_in = CreatePipe, std_out = CreatePipe } _ <- T.hPutStr input file' entry <- catch (hGetLine output) (\_error -> return "ERROR" ) case reverse . words $ entry of ["ERROR"] -> return () uri:_ -> loadURI uri browser _ -> return () reformat :: T.Text -> T.Text reformat line = T.unwords $ tags' ++ [uri] where uri:tags = T.words line tags' = sort $ map (\tag -> T.snoc (T.cons '[' tag) ']') tags -- | loadWithTag :: IO () loadWithTag = do -- Read bookmarks file configHome <- getEnv "XDG_CONFIG_HOME" file <- T.readFile $ configHome ++ "/hbro/bookmarks" -- Filter tags list let list = T.unlines . sort . nub . T.words . T.unwords $ map getTags (T.lines file) -- Let user select a tag (Just input, Just output, _, _) <- createProcess (proc "dmenu" ["-l", "10"]) { std_in = CreatePipe, std_out = CreatePipe } _ <- T.hPutStr input list tag <- catch (hGetLine output) (\_error -> return "ERROR" ) case tag of "ERROR" -> return () "" -> return () t -> do _ <- mapM (\uri -> spawn (proc "hbro" ["-u", (T.unpack uri)])) uris return () where file' = filter (tagFilter $ T.pack t) (T.lines file) uris = map getUri file' -- tagFilter :: T.Text -> T.Text -> Bool tagFilter tag line = let _uri:tags = T.words line in case (intersect [tag] tags) of [_tag] -> True _ -> False -- | deleteWithTag :: IO () deleteWithTag = do configHome <- getEnv "XDG_CONFIG_HOME" file <- T.readFile $ configHome ++ "/hbro/bookmarks" let tagsList = T.unlines . sort . nub . T.words . T.unwords $ map getTags (T.lines file) (Just input, Just output, _, _) <- createProcess (proc "dmenu" []) { std_in = CreatePipe, std_out = CreatePipe } _ <- T.hPutStr input tagsList tag <- catch (hGetLine output) (\_error -> return "ERROR" ) case tag of "ERROR" -> return () "" -> return () _ -> do T.writeFile (configHome ++ "/hbro/bookmarks.old") file T.writeFile (configHome ++ "/hbro/bookmarks") file' return () where file' = T.unlines $ filter (not . (tagFilter $ T.pack tag)) (T.lines file) -- | The elementary bookmark action add :: String -> [String] -> IO () add uri tags = do configHome <- getEnv "XDG_CONFIG_HOME" appendFile (configHome ++ "/hbro/bookmarks") $ uri ++ " " ++ (unwords tags) ++ "\n" -- | getTags :: T.Text -> T.Text getTags line = let _:tags = T.words line in T.unwords tags -- | getUri :: T.Text -> T.Text getUri line = let uri:_ = T.words line in uri