buuka/src/Operations/Import/Firefox.hs

112 lines
3.0 KiB
Haskell
Raw Normal View History

{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
2021-01-03 20:44:06 +02:00
{-# LANGUAGE TypeApplications #-}
2021-01-03 09:00:40 +02:00
{-|
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
2021-01-03 09:52:38 +02:00
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
2021-01-03 09:00:40 +02:00
import Conduit
import qualified Data.Conduit.Combinators as C
import Data.Text
(Text)
2021-01-03 09:00:40 +02:00
import System.FilePath
(takeFileName, (</>))
import Control.Exception
(Exception)
import System.Environment
(lookupEnv)
import GHC.Stack
import Control.Lens
2021-01-03 20:44:06 +02:00
(foldMapOf, folded, has, ix, makeLenses, to, (%~), (&), (<>~), (^.))
import qualified Database.SQLite.Simple as SQL
import Data.Traversable
(for)
2021-01-03 09:52:38 +02:00
import Control.Monad.Buuka
2021-01-03 09:00:40 +02:00
-- 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
2021-01-03 09:00:40 +02:00
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{..}
2021-01-03 09:52:38 +02:00
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
2021-01-03 20:44:06 +02:00
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))
2021-01-03 09:52:38 +02:00
initialState oldState = Update oldState (foldMapOf (B._Buuka . folded . B.url . B._URL) S.singleton oldState)