module Hbro.History (
Entry(..),
log,
add,
parseEntry,
select
) where
import Hbro
import Hbro.Misc
import Control.Exception
import Control.Monad.Error
import Control.Monad.Reader
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 :: (MonadIO m, MonadReader r m, HasWebView r, MonadError HError m) => IO FilePath -> m ()
log file = do
uri <- getURI
title <- getTitle
timeZone <- io $ utcToLocalTime <$> getCurrentTimeZone
now <- io $ timeZone <$> getCurrentTime
add file (Entry now uri title)
add :: (MonadIO m, MonadError HError m)
=> IO FilePath
-> Entry
-> m ()
add file newEntry = do
file' <- io file
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, MonadIO m, MonadError HError m)
=> IO FilePath
-> [String]
-> m Entry
select file dmenuOptions = do
parseEntry =<< dmenu dmenuOptions . unlines . reverse . sort . nub . lines =<< either (throwError . IOE) return =<< (io . try $ readFile =<< file)