hbro-contrib-0.9.0.0: Hbro/Bookmarks.hs

module Hbro.Bookmarks (
    Entry(..),
    add,
    addCustom,
    select,
    selectTag,
    deleteWithTag
) where

-- {{{ Imports
import Hbro.Core
--import Hbro.Gui
import Hbro.Types hiding(mURI)
import Hbro.Util

import Control.Exception
import Control.Monad hiding(forM_, mapM_)

--import qualified Data.ByteString.Char8 as B
import Data.Foldable hiding(find, foldr)
import Data.Functor
import Data.List
import Data.Maybe
-- import Data.Random.Extras
-- import Data.Random.RVar
-- import Data.Random.Source.DevRandom


import Network.URI

import Prelude hiding(catch, mapM_)

import System.IO
-- }}}

-- {{{ Type definitions
data Entry = Entry {
    mURI  :: URI,
    mTags :: [String]
}
 
instance Show Entry where
    show (Entry uri tags) = unwords $ (show uri):tags
-- }}}

-- | Try to parse a String into a bookmark Entry.
parseEntry :: String -> Maybe Entry
parseEntry [] = Nothing
parseEntry line = return (words line) 
    >>= (\(h:t) -> parseURI h
    >>= (\uri -> listToMaybe t 
    >> (return $ Entry uri t)))

-- | Check if the given bookmark Entry is tagged with the given tag.
hasTag :: String -> Entry -> Bool
hasTag tag = isJust . (find $ (==) tag) . mTags

-- | Add current webpage to bookmarks with given tags
add :: PortableFilePath -> [String] -> K ()        
add file tags = withURI $ \uri -> io . void . addCustom file $ Entry uri tags

-- | Add a custom entry to bookmarks
addCustom :: PortableFilePath   -- ^ Bookmarks' database file
          -> Entry              -- ^ New bookmarks entry
          -> IO Bool
addCustom file newEntry = do
    file'  <- resolve file
    result <- try $ withFile file' AppendMode (`hPutStrLn` show newEntry)
    either (\e -> errorHandler file' e >> return False) (const $ return True) result
          
-- | Open a dmenu with all (sorted alphabetically) bookmarks entries, and return the user's selection, if any.
select :: PortableFilePath -- ^ Bookmarks' database file
       -> [String]         -- ^ dmenu's commandline options
       -> IO (Maybe URI)
select file dmenuOptions = do
    file'  <- resolve file
    result <- try $ readFile file' 
    
    either (\e -> errorHandler file' e >> return Nothing) (\x -> return $ Just x) result
    >>= (return . ((return . unlines . sort . nub . (map reformat) . lines) =<<))
    >>= (maybe (return Nothing) (dmenu dmenuOptions))
    >>= (return . ((parseURIReference . last . words) =<<))

reformat :: String -> String
reformat line = unwords $ tags' ++ [uri]
  where
    uri:tags = words line 
    tags'    = sort $ map (\tag -> '[':(tag ++ "]")) tags

-- | Open a dmenu with all (sorted alphabetically) bookmarks tags, and return the user's selection, if any.
selectTag :: PortableFilePath  -- ^ Bookmarks' database file
          -> [String]          -- ^ dmenu's commandline options
          -> IO (Maybe [URI])
selectTag file dmenuOptions = do
-- Read bookmarks file
    file'  <- resolve file
    result <- try $ readFile file'
    file'' <- either (\e -> errorHandler file' e >> return Nothing) (\x -> return $ Just x) result
    
    let entries = (catMaybes . map parseEntry . lines) <$> file''
    let tags    = (unlines . sort . nub . words . unwords . (foldr (union . mTags) [])) <$> entries

-- Let user select a tag
    tag <- (maybe (return Nothing) (dmenu dmenuOptions) tags)
    return $ (return . (map mURI) . (\t -> filter (hasTag t) (maybe [] id entries))) =<< tag

-- |
--popOldest :: PortableFilePath -> String -> IO (Maybe URI)
--popOldest file tags = do
  
-- | Return a random Bookmark entry with a given tag, while removing it from bookmarks.
-- popRandom :: PortableFilePath
--           -> String  
--           -> IO (Maybe URI)
-- popRandom file tags = do
--     file'  <- resolve file
--     result <- try . readFile $ file'
--     file'' <- either (\e -> errorHandler file' e >> return Nothing) (\x -> return $ Just x) result
    
--     forM_ file'' $ \f -> do
--         let selection = choiceExtract . lines $ f
--         forM_ selection $ \s -> do 
--             (newLines, value) <- runRVar s DevURandom
            
--             renameFile file' (file' ++ ".old")
--             writeFile file' . unlines . nub $ newLines

--             return . parseURIReference . last . words $ value


-- | Remove all bookmarks entries matching the given tag.
deleteWithTag :: PortableFilePath  -- ^ Bookmarks' database file
              -> [String]          -- ^ dmenu's commandline options
              -> IO ()
deleteWithTag file dmenuOptions = do
    file'  <- resolve file
    result <- try $ readFile file'
    file''   <- either (\e -> errorHandler file' e >> return Nothing) (\x -> return $ Just x) result
    
    forM_ file'' $ \f -> do
        let entries = (catMaybes . (map parseEntry) . lines) f    
        let tags = (unlines . sort . nub . words . unwords . (foldr (union . mTags) [])) entries

        tag <- (dmenu dmenuOptions tags) 
        forM_ tag (\t -> do
            writeFile (file' ++ ".old") $ unlines (map show entries)
            writeFile file' $ (unlines . (map show) . (filter (not . (hasTag t)))) entries
            return ())