buuka/src/Operations/Import/Firefox.hs

{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-|
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, 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
    -- incomplete update
    update acc f = acc & seen <>~ (f ^. url . to S.singleton)
    initialState oldState = Update oldState (foldMapOf (B._Buuka . folded . B.url . B._URL) S.singleton oldState)