{-# 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