import from firefox #1

Merged
MasseR merged 7 commits from import into master 2021-01-03 22:10:36 +02:00
5 changed files with 62 additions and 13 deletions
Showing only changes of commit 01c591434e - Show all commits

View File

@ -1,11 +1,16 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
module Data.Buuka
( BuukaQ(..)
, BuukaU(..)
, BuukaEntry(..)
, url
, title
, URL(..)
, _URL
, Buuka
, _Buuka
, insert
, elements
@ -13,6 +18,8 @@ module Data.Buuka
)
where
import Control.Lens (makeLenses, Iso', iso)
import Database.Migrations
import Data.Aeson
@ -36,13 +43,18 @@ newtype URL = URL Text
deriving stock (Show, Eq, Generic, Ord)
deriving newtype (ToJSON, FromJSON, FromJSONKey, ToJSONKey, Hashable)
_URL :: Iso' URL Text
_URL = iso (\(URL t) -> t) URL
data BuukaEntry
= BuukaEntry { url :: URL
, title :: Maybe Text
= BuukaEntry { _url :: URL
, _title :: Maybe Text
}
deriving stock (Show, Eq, Generic)
deriving anyclass (ToJSON, FromJSON, Hashable)
makeLenses ''BuukaEntry
instance SafeJSON BuukaEntry where
type Version BuukaEntry = 0
@ -50,6 +62,9 @@ newtype Buuka = Buuka [BuukaEntry]
deriving stock (Show, Eq)
deriving newtype (Semigroup, Monoid, FromJSON, ToJSON, Hashable)
_Buuka :: Iso' Buuka [BuukaEntry]
_Buuka = iso (\(Buuka b) -> b) Buuka
insert :: BuukaEntry -> Buuka -> Buuka
insert e (Buuka b) = Buuka (e : b)

View File

@ -18,7 +18,9 @@ module Data.Query
where
import Data.Buuka
(BuukaEntry(..), URL(..))
(BuukaEntry, title, url, _URL)
import Control.Lens
import Text.Regex.TDFA
((=~))
@ -58,12 +60,12 @@ a .&&. b = Fix (And a b)
evaluate :: QueryF (BuukaEntry -> Bool) -> (BuukaEntry -> Bool)
evaluate = \case
StartsWith Url x -> \BuukaEntry{url=URL u} -> x `T.isPrefixOf` u
EndsWith Url x -> \BuukaEntry{url=URL u} -> x `T.isSuffixOf` u
StartsWith Title x -> \BuukaEntry{title=t} -> maybe False (x `T.isPrefixOf`) t
EndsWith Title x -> \BuukaEntry{title=t} -> maybe False (x `T.isSuffixOf`) t
Regex Url x -> \BuukaEntry{url=URL u} -> u =~ x
Regex Title x -> \BuukaEntry{title=t} -> maybe False (=~ x) t
StartsWith Url x -> \e -> x `T.isPrefixOf` (e ^. url . _URL)
EndsWith Url x -> \e -> x `T.isSuffixOf` (e ^. url . _URL)
StartsWith Title x -> \e -> maybe False (x `T.isPrefixOf`) $ e ^. title
EndsWith Title x -> \e -> maybe False (x `T.isSuffixOf`) $ e ^. title
Regex Url x -> \e -> (e ^. url . _URL) =~ x
Regex Title x -> \e -> maybe False (=~ x) $ e ^. title
And a b -> \e -> a e && b e
predicate :: Query -> BuukaEntry -> Bool

View File

@ -47,5 +47,5 @@ formatEntries buuka xs =
mkContext = hashidsSimple . B.fingerprint
formatEntry :: Int -> BuukaEntry -> (Text, Text)
formatEntry n = \case
BuukaEntry{title=Just t} -> (encode ctx n ^. utf8, t)
BuukaEntry{url=URL u} -> (encode ctx n ^. utf8, u)
BuukaEntry{_title=Just t} -> (encode ctx n ^. utf8, t)
BuukaEntry{_url=URL u} -> (encode ctx n ^. utf8, u)

View File

@ -13,6 +13,19 @@ 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
@ -31,13 +44,15 @@ import System.Environment
import GHC.Stack
import Control.Lens
(makeLenses)
(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 = ?
@ -74,3 +89,20 @@ bookmarks path = liftIO $ SQL.withConnection path $ \conn -> do
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)

View File

@ -13,4 +13,4 @@ import Data.Text
insert :: Text -> Maybe Text -> BuukaM ()
insert url title = buukaU (modify (B.insert entry))
where
entry = B.BuukaEntry{ B.url = B.URL url, B.title = title }
entry = B.BuukaEntry{ B._url = B.URL url, B._title = title }