module Hbro.History (
Entry(..),
log,
add,
parseEntry,
select
) where
import Hbro hiding(log)
import Hbro.Gui
import Hbro.Misc
import Hbro.Network
import Control.Exception
import Control.Monad.Base
import Control.Monad.Error
import Data.Functor
import Data.List
import Data.Time
import Network.URI (URI)
import Prelude hiding(log)
import System.IO
import System.Locale
data Entry = Entry {
mTime :: LocalTime,
mURI :: URI,
mTitle :: String
}
instance Show Entry where
show (Entry time uri title) = unwords [(formatTime defaultTimeLocale dateFormat time), show uri, title]
dateFormat :: String
dateFormat = "%F %T"
log :: (MonadBase IO m, ConfigReader n m, GUIReader n m, MonadError HError m) => FilePath -> m ()
log file = do
uri <- getURI
title <- getTitle
timeZone <- io $ utcToLocalTime <$> getCurrentTimeZone
now <- io $ timeZone <$> getCurrentTime
add file (Entry now uri title)
add :: (MonadBase IO m, ConfigReader n m, MonadError HError m)
=> FilePath
-> Entry
-> m ()
add file newEntry = do
logV $ "Adding new history entry <" ++ show (mURI newEntry) ++ ">"
either (throwError . IOE) return =<< (io . try $ withFile file AppendMode (`hPutStrLn` show newEntry))
parseEntry :: (MonadError HError m) => String -> m Entry
parseEntry [] = throwError $ OtherError "While parsing history entry: empty input."
parseEntry line = (parseEntry' . words) line
parseEntry' :: (MonadError HError m) => [String] -> m Entry
parseEntry' (d:t:u:t') = do
time <- maybe (throwError $ OtherError "While parsing history entry: invalid date.") return $ parseTime defaultTimeLocale dateFormat (unwords [d, t])
uri <- parseURI u
return $ Entry time uri (unwords t')
parseEntry' _ = throwError $ OtherError "While parsing history entry: invalid format."
select :: (Functor m, MonadBase IO m, MonadError HError m)
=> FilePath
-> [String]
-> m Entry
select file dmenuOptions = do
parseEntry =<< dmenu dmenuOptions . unlines . reverse . sort . nub . lines =<< either (throwError . IOE) return =<< (io . try $ readFile file)