133 lines
3.5 KiB
Haskell
133 lines
3.5 KiB
Haskell
{-# 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
|
|
( importFirefox )
|
|
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
|
|
( Lens'
|
|
, foldMapOf
|
|
, folded
|
|
, has
|
|
, ix
|
|
, lens
|
|
, 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 :: Maybe Text
|
|
, _keywords :: [Text]
|
|
}
|
|
deriving stock (Show, Eq)
|
|
|
|
url :: Lens' Firefox Text
|
|
url = lens _url (\f u -> f{_url = u})
|
|
|
|
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
|
|
-- Collect all the imported bookmarks
|
|
fs <- (`appEndo` []) <$> runResourceT (runConduit $ stores .| C.mapM bookmarks .| C.foldMap (\f -> Endo (++ f)))
|
|
-- Insert to the buuka store iff, the urls don't already exist in the store
|
|
-- The fold keeps track of a set of already seen entries. Every iteration
|
|
-- adds the current url to the known set of urls. Only if the url doesn't
|
|
-- exist in the set, will it be inserted to the store
|
|
buukaU $ modify $ \oldState -> F.foldl' update (initialState oldState) fs ^. buuka
|
|
where
|
|
toEntry Firefox{..} = B.BuukaEntry{ B._url = B.URL _url, B._title = _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 (initialUrls oldState)
|
|
initialUrls = foldMapOf (B._Buuka . folded . B.url . B._URL) S.singleton
|