import from firefox #1
|
@ -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)
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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 }
|
||||
|
|
Loading…
Reference in New Issue