Some lenses and incomplete importer

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)
 

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

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)

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)

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 }