From 01c591434ef19464d2b84a131dff37d93b554d4f Mon Sep 17 00:00:00 2001 From: Mats Rauhala Date: Sun, 3 Jan 2021 09:52:38 +0200 Subject: [PATCH] Some lenses and incomplete importer --- src/Data/Buuka.hs | 19 ++++++++++++++++-- src/Data/Query.hs | 16 ++++++++------- src/Operations/Format.hs | 4 ++-- src/Operations/Import/Firefox.hs | 34 +++++++++++++++++++++++++++++++- src/Operations/Insert.hs | 2 +- 5 files changed, 62 insertions(+), 13 deletions(-) diff --git a/src/Data/Buuka.hs b/src/Data/Buuka.hs index 5a6a578..fc1d9c2 100644 --- a/src/Data/Buuka.hs +++ b/src/Data/Buuka.hs @@ -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) diff --git a/src/Data/Query.hs b/src/Data/Query.hs index 70003ba..4425caa 100644 --- a/src/Data/Query.hs +++ b/src/Data/Query.hs @@ -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 diff --git a/src/Operations/Format.hs b/src/Operations/Format.hs index 3c294c9..f4524c4 100644 --- a/src/Operations/Format.hs +++ b/src/Operations/Format.hs @@ -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) diff --git a/src/Operations/Import/Firefox.hs b/src/Operations/Import/Firefox.hs index b36b970..c938b73 100644 --- a/src/Operations/Import/Firefox.hs +++ b/src/Operations/Import/Firefox.hs @@ -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) diff --git a/src/Operations/Insert.hs b/src/Operations/Insert.hs index aa97a6b..84561d3 100644 --- a/src/Operations/Insert.hs +++ b/src/Operations/Insert.hs @@ -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 }