{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-| Module : Operations.Import.Firefox Description : Imports from firefox Copyright : (c) Mats Rauhala, 2020 License : BSD-3-Clause Maintainer : mats.rauhala@iki.fi Stability : experimental Portability : POSIX Imports from firefox. Firefox needs to be closed when doing the import -} module Operations.Import.Firefox where import Data.Monoid (Endo(..)) import qualified Data.Foldable as F import qualified Data.Set as S import Control.Monad.State (modify) import Data.Buuka (Buuka) import qualified Data.Buuka as B import Conduit import qualified Data.Conduit.Combinators as C import Data.Text (Text) import System.FilePath (takeFileName, ()) import Control.Exception (Exception) import System.Environment (lookupEnv) import GHC.Stack import Control.Lens (foldMapOf, folded, has, ix, makeLenses, to, (%~), (&), (<>~), (^.)) import qualified Database.SQLite.Simple as SQL import Data.Traversable (for) import Control.Monad.Buuka -- select p.title, p.url from moz_bookmarks b join moz_places p on b.fk = p.id -- -- select keyword from moz_keywords where place_id = ? newtype ImportException = HomeNotFound CallStack deriving stock (Show) deriving anyclass (Exception) data Firefox = Firefox { _url :: Text , _title :: Text , _keywords :: [Text] } deriving stock (Show, Eq) makeLenses ''Firefox stores :: MonadResource m => MonadThrow m => MonadIO m => HasCallStack => ConduitT i FilePath m () stores = liftIO (lookupEnv "HOME") >>= maybe (throwM (HomeNotFound callStack)) listStores where listStores home = sourceDirectoryDeep False (home ".mozilla/firefox") .| C.filter (\p -> takeFileName p == "places.sqlite") bookmarks :: MonadIO m => FilePath -> m [Firefox] bookmarks path = liftIO $ SQL.withConnection path $ \conn -> do elems <- SQL.query_ conn "select p.id, p.title, p.url from moz_bookmarks b join moz_places p on b.fk = p.id" for elems $ \(_id, _title, _url) -> do _keywords <- fmap SQL.fromOnly <$> SQL.query conn "select keyword from moz_keywords where place_id = ?" (SQL.Only @Int _id) pure Firefox{..} data Update = Update { _buuka :: !Buuka , _seen :: !(S.Set Text) } deriving stock (Show) makeLenses ''Update importFirefox :: BuukaM () importFirefox = do fs <- (`appEndo` []) <$> runResourceT (runConduit $ stores .| C.mapM bookmarks .| C.foldMap (\f -> Endo (++ f))) buukaU $ modify $ \oldState -> F.foldl' update (initialState oldState) fs ^. buuka where toEntry Firefox{..} = B.BuukaEntry{ B._url = B.URL _url, B._title = Just _title } update acc f = acc & seen <>~ (f ^. url . to S.singleton) & if has (seen . ix (f ^. url)) acc then id else buuka %~ (B.insert (toEntry f)) initialState oldState = Update oldState (foldMapOf (B._Buuka . folded . B.url . B._URL) S.singleton oldState)