module Web.Firefox (listPlacesFiles, listHistoryURLs, listAllHistoryURLs) where import Database.HDBC (fromSql, quickQuery') import Database.HDBC.Sqlite3 (connectSqlite3, setBusyTimeout) import Network.URL (importURL, URL) import Data.List (isSuffixOf) import Control.Monad (forM) import Data.Maybe (mapMaybe) import System.Directory (doesDirectoryExist, getDirectoryContents, getHomeDirectory, getTemporaryDirectory, copyFile, removeFile) import System.FilePath (()) firefoxDirs :: [String] firefoxDirs = [ ".mozilla", ".mozilla-firefox", ".firefox" ] placesFile :: String placesFile = "places.sqlite" timeoutFox = 5 listPlacesFiles :: IO [FilePath] listPlacesFiles = do homeDir <- getHomeDirectory xs <- mapM (getRecursiveContents . (homeDir )) firefoxDirs return $ filter (placesFile `isSuffixOf`) (concat xs) listAllHistoryURLs :: IO [URL] listAllHistoryURLs = do putStrLn $ "Please close your Firefox if you see this message longer than "++show timeoutFox++" seconds..." places <- listPlacesFiles xs <- mapM listHistoryURLs places return $ concat xs listHistoryURLs :: FilePath -> IO [URL] listHistoryURLs name = do putStrLn $ "Going to connect on Firefox SQLite DB: " ++ name tmpDir <- getTemporaryDirectory let tmpName = tmpDir "wiki4e_places.sqlite" copyFile name tmpName conn <- connectSqlite3 tmpName setBusyTimeout conn (1000*timeoutFox) xs <- quickQuery' conn "select url from moz_places order by last_visit_date desc" [] let ys = map (fromSql . head) xs :: [String] removeFile tmpName return $ mapMaybe importURL ys getRecursiveContents :: FilePath -> IO [FilePath] getRecursiveContents topdir = do e <- doesDirectoryExist topdir if e then do names <- getDirectoryContents topdir let properNames = filter (`notElem` [".", ".."]) names paths <- forM properNames $ \name -> do let path = topdir name e2 <- doesDirectoryExist path if e2 then getRecursiveContents path else return [path] return (concat paths) else return []