module Hbro.Bookmarks (
Entry(..),
add,
addCustom,
select,
selectTag,
deleteWithTag
) where
import Hbro
import Hbro.Gui
import Hbro.Misc
import Hbro.Network
import Control.Exception
import Control.Monad hiding(forM_, mapM_)
import Control.Monad.Base
import Control.Monad.Error hiding(forM_, mapM_)
import Data.Functor
import Data.List
import Data.Maybe
import Network.URI (URI)
import Prelude hiding(mapM_)
import System.IO
data Entry = Entry {
mURI :: URI,
mTags :: [String]
}
instance Show Entry where
show (Entry uri tags) = unwords $ (show uri):tags
parseEntry :: (MonadError HError m) => String -> m Entry
parseEntry [] = throwError $ OtherError "While parsing bookmarks: empty entry."
parseEntry line = return (words line)
>>= (\(h:t) -> parseURI h
>>= (\uri -> return $ Entry uri t))
hasTag :: String -> Entry -> Bool
hasTag tag = isJust . (find $ (==) tag) . mTags
add :: (Functor m, MonadBase IO m, GUIReader n m, MonadError HError m) => FilePath -> [String] -> m ()
add file tags = do
uri <- getURI
void . addCustom file $ Entry uri tags
addCustom :: (MonadBase IO m, MonadError HError m)
=> FilePath
-> Entry
-> m ()
addCustom file newEntry = do
either (throwError . IOE) return =<< (io . try $ withFile file AppendMode (`hPutStrLn` show newEntry))
select :: (Functor m, MonadBase IO m, MonadError HError m)
=> FilePath
-> [String]
-> m URI
select file dmenuOptions = do
result <- either (throwError . IOE) return =<< (io . try $ readFile file)
parseURIReference . last . words =<< (dmenu dmenuOptions . unlines . sort . nub . (map reformat) . lines $ result)
reformat :: String -> String
reformat line = unwords $ tags' ++ [uri]
where
uri:tags = words line
tags' = sort $ map (\tag -> '[':(tag ++ "]")) tags
selectTag :: (Functor m, MonadBase IO m, MonadError HError m)
=> FilePath
-> [String]
-> m [URI]
selectTag file dmenuOptions = do
result <- either (throwError . IOE) return =<< (io . try $ readFile file)
entries <- mapM parseEntry . lines $ result
let tags = unlines . sort . nub . words . unwords . foldr (union . mTags) [] $ entries
(map mURI) . (\t -> filter (hasTag t) entries) <$> dmenu dmenuOptions tags
deleteWithTag :: (Functor m, MonadBase IO m, MonadError HError m)
=> FilePath
-> [String]
-> m ()
deleteWithTag file dmenuOptions = do
result <- either (throwError . IOE) return =<< (io . try $ readFile file)
entries <- mapM parseEntry . lines $ result
let tags = (unlines . sort . nub . words . unwords . (foldr (union . mTags) [])) entries
tag <- dmenu dmenuOptions tags
io $ writeFile (file ++ ".old") $ unlines (map show entries)
io $ writeFile file $ (unlines . (map show) . (filter (not . (hasTag tag)))) entries