app/Main.hs

@@ -27,7 +27,6 @@ commands = subparser
   (  command "insert" (info (insertOpts Operations.insert <**> helper) (progDesc "Insert a new bookmark"))
   <> command "list" (info (pure Operations.list <**> helper) (progDesc "List all the bookmarks"))
   <> command "query" (info (queryOpts Operations.query <**> helper) (progDesc "Query the bookmarks"))
-  <> command "import" (info (pure Operations.importFirefox <**> helper) (progDesc "Import"))
   )
   where
     insertOpts f =

buuka.cabal

@@ -40,7 +40,6 @@ library
                      , Operations.Insert
                      , Operations.List
                      , Operations.Query
-                     , Operations.Import.Firefox
                      , Operations
                      , Data.Environment
                      , Data.Buuka
@@ -62,9 +61,6 @@ library
                      , lens
                      , hashable
                      , regex-tdfa
-                     , sqlite-simple
-                     , conduit
-                     , conduit-extra
   hs-source-dirs:      src
 
 executable buuka

default.nix

@@ -1,9 +1,8 @@
-{ mkDerivation, aeson, base, bytestring, conduit, conduit-extra
-, containers, deriving-compat, exceptions, filepath, hashable
-, hashids, hedgehog, hedgehog-corpus, lens, mtl
-, optparse-applicative, regex-tdfa, sqlite-simple, stdenv, tasty
-, tasty-hedgehog, tasty-hunit, text, transformers, unliftio, vector
-, yaml
+{ mkDerivation, aeson, base, bytestring, containers
+, deriving-compat, exceptions, filepath, hashable, hashids
+, hedgehog, hedgehog-corpus, lens, mtl, optparse-applicative
+, regex-tdfa, stdenv, tasty, tasty-hedgehog, tasty-hunit, text
+, transformers, unliftio, vector, yaml
 }:
 mkDerivation {
   pname = "buuka";
@@ -12,9 +11,8 @@ mkDerivation {
   isLibrary = true;
   isExecutable = true;
   libraryHaskellDepends = [
-    aeson base bytestring conduit conduit-extra containers exceptions
-    filepath hashable hashids lens mtl regex-tdfa sqlite-simple text
-    transformers unliftio vector yaml
+    aeson base bytestring containers exceptions filepath hashable
+    hashids lens mtl regex-tdfa text transformers unliftio vector yaml
   ];
   executableHaskellDepends = [ base optparse-applicative unliftio ];
   testHaskellDepends = [

src/Data/Buuka.hs

@@ -1,16 +1,11 @@
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeFamilies #-}
 module Data.Buuka
   ( BuukaQ(..)
   , BuukaU(..)
   , BuukaEntry(..)
-  , url
-  , title
   , URL(..)
-  , _URL
   , Buuka
-  , _Buuka
 
   , insert
   , elements
@@ -18,8 +13,6 @@ module Data.Buuka
   )
   where
 
-import Control.Lens (makeLenses, Iso', iso)
-
 import Database.Migrations
 
 import Data.Aeson
@@ -30,8 +23,6 @@ import Data.Hashable
 import GHC.Generics
        (Generic)
 
-import Data.Text
-
 import Control.Monad.Reader
 import Control.Monad.State
 
@@ -39,22 +30,17 @@ import Data.ByteString
        (ByteString)
 import qualified Data.ByteString as B
 
-newtype URL = URL Text
+newtype URL = URL String
   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 String
                }
   deriving stock (Show, Eq, Generic)
   deriving anyclass (ToJSON, FromJSON, Hashable)
 
-makeLenses ''BuukaEntry
-
 instance SafeJSON BuukaEntry where
   type Version BuukaEntry = 0
 
@@ -62,9 +48,6 @@ 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,9 +18,10 @@ module Data.Query
   where
 
 import Data.Buuka
-       (BuukaEntry, title, url, _URL)
+       (BuukaEntry(..), URL(..))
 
-import Control.Lens
+import Data.List
+       (isPrefixOf, isSuffixOf)
 
 import Text.Regex.TDFA
        ((=~))
@@ -28,31 +29,27 @@ import Text.Regex.TDFA
 import Data.Functor.Foldable
        (Fix(..), cata)
 
-import Data.Text
-       (Text)
-import qualified Data.Text as T
-
 data Field a where
-  Url :: Field Text
-  Title :: Field Text
+  Url :: Field String
+  Title :: Field String
 
 data QueryF f where
-  StartsWith :: Field Text -> Text -> QueryF f
-  EndsWith :: Field Text -> Text -> QueryF f
-  Regex :: Field Text -> Text -> QueryF f
+  StartsWith :: Field String -> String -> QueryF f
+  EndsWith :: Field String -> String -> QueryF f
+  Regex :: Field String -> String -> QueryF f
   And :: f -> f -> QueryF f
 
 deriving instance Functor QueryF
 
 type Query = Fix QueryF
 
-startsWith :: Field Text -> Text -> Query
+startsWith :: Field String -> String -> Query
 startsWith field x = Fix (StartsWith field x)
 
-endsWith :: Field Text -> Text -> Query
+endsWith :: Field String -> String -> Query
 endsWith field x = Fix (EndsWith field x)
 
-regex :: Field Text -> Text -> Query
+regex :: Field String -> String -> Query
 regex field x = Fix (Regex field x)
 
 (.&&.) :: Query -> Query -> Query
@@ -60,12 +57,12 @@ a .&&. b = Fix (And a b)
 
 evaluate :: QueryF (BuukaEntry -> Bool) -> (BuukaEntry -> Bool)
 evaluate = \case
-  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
+  StartsWith Url x -> \BuukaEntry{url=URL u} -> x `isPrefixOf` u
+  EndsWith Url x -> \BuukaEntry{url=URL u} -> x `isSuffixOf` u
+  StartsWith Title x -> \BuukaEntry{title=t} -> maybe False (x `isPrefixOf`) t
+  EndsWith Title x -> \BuukaEntry{title=t} -> maybe False (x `isSuffixOf`) t
+  Regex Url x -> \BuukaEntry{url=URL u} -> u =~ x
+  Regex Title x -> \BuukaEntry{title=t} -> maybe False (=~ x) t
   And a b -> \e -> a e && b e
 
 predicate :: Query -> BuukaEntry -> Bool

src/Operations.hs

@@ -2,7 +2,6 @@ module Operations
   ( module Operations.Insert
   , module Operations.List
   , module Operations.Query
-  , module Operations.Import.Firefox
   )
   where
 
@@ -12,5 +11,3 @@ import Operations.List
        (list)
 import Operations.Query
        (query)
-import Operations.Import.Firefox
-       (importFirefox)

src/Operations/Format.hs

@@ -26,26 +26,23 @@ import Web.Hashids
 
 import Control.Lens
 import Data.Text.Strict.Lens
-       (utf8)
+       (unpacked, utf8)
 
-import Data.Text
-       (Text)
-import qualified Data.Text as T
 
 -- | Format the entries
 formatEntries
   :: Buuka -- ^ The full set of entries, for the context
   -> [BuukaEntry] -- ^ The list of entries to be formatted
-  -> [Text]
+  -> [String]
 formatEntries buuka xs =
   let formatted = zipWith formatEntry [1..] xs
-      indexWidth = getMax . foldMap (Max . T.length . fst) $ formatted
-  in fmap (\(idx,x) -> idx <> T.replicate (indexWidth - T.length idx) " " <> ". " <> x) formatted
+      indexWidth = getMax . foldMap (Max . length . fst) $ formatted
+  in fmap (\(idx,x) -> idx <> replicate (indexWidth - length idx) ' ' <> ". " <> x) formatted
   where
     ctx = mkContext buuka
     mkContext :: Buuka -> HashidsContext
     mkContext = hashidsSimple . B.fingerprint
-    formatEntry :: Int -> BuukaEntry -> (Text, Text)
+    formatEntry :: Int -> BuukaEntry -> (String, String)
     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 . unpacked, t)
+      BuukaEntry{url=URL u} -> (encode ctx n ^. utf8 . unpacked, u)

src/Operations/Import/Firefox.hs

@@ -1,132 +0,0 @@
-{-# 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 :: 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 = Just _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

src/Operations/Insert.hs

@@ -7,10 +7,7 @@ import Control.Monad.State
 
 import qualified Data.Buuka as B
 
-import Data.Text
-       (Text)
-
-insert :: Text -> Maybe Text -> BuukaM ()
+insert :: String -> Maybe String -> 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 }

src/Operations/List.hs

@@ -14,14 +14,10 @@ import qualified Data.Buuka as B
 
 import Operations.Format
 
-import Data.Text
-       (Text)
-import qualified Data.Text.IO as T
-
 
 list :: BuukaM ()
 list =
-  buukaQ (asks go) >>= traverse_ (liftIO . T.putStrLn)
+  buukaQ (asks go) >>= traverse_ (liftIO . putStrLn)
   where
-    go :: Buuka -> [Text]
+    go :: Buuka -> [String]
     go b = formatEntries b (B.elements b)

src/Operations/Query.hs

@@ -14,14 +14,10 @@ import qualified Data.Buuka as B
 
 import Operations.Format
 
-import Data.Text
-       (Text)
-import qualified Data.Text.IO as T
-
-query :: Field Text -> Text -> BuukaM ()
+query :: Field String -> String -> BuukaM ()
 query field q =
-  buukaQ (asks go) >>= traverse_ (liftIO . T.putStrLn)
+  buukaQ (asks go) >>= traverse_ (liftIO . putStrLn)
   where
-    go :: Buuka -> [Text]
+    go :: Buuka -> [String]
     go b = formatEntries b (filter (predicate (regex field q)) . B.elements $ b)
 

test/Test/Data/Buuka.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
 module Test.Data.Buuka where
 
 import Hedgehog
@@ -9,26 +8,26 @@ import Test.Tasty.Hedgehog
 
 import qualified Data.Aeson as A
 
+import Data.List
+       (intercalate)
 import qualified Data.Foldable as F
 
-import qualified Data.Text as T
-
 import Data.Buuka
 
 genUrl :: Gen URL
-genUrl = URL . T.concat <$> sequence go
+genUrl = URL . concat <$> sequence go
   where
     go = [ Gen.element protocols, Gen.element domains, Gen.element tlds, pure "/", genPath ]
     protocols = ["http://", "https://"]
     domains = ["example", "foo", "bar"]
     tlds = ["com", "fi", "org", "net", "info"]
-    genPath = T.intercalate "/" <$> Gen.list (Range.linear 0 10) (Gen.element paths)
+    genPath = intercalate "/" <$> Gen.list (Range.linear 0 10) (Gen.element paths)
     paths = ["foo", "bar", "asd", "xyzzy"]
 
 genBuukaEntry :: Gen BuukaEntry
 genBuukaEntry = BuukaEntry <$> genUrl <*> genTitle
   where
-    genTitle = Gen.maybe (Gen.text (Range.linear 0 10) Gen.unicode)
+    genTitle = Gen.maybe (Gen.string (Range.linear 0 10) Gen.unicode)
 
 genBuuka :: Gen Buuka
 genBuuka = F.foldl' (flip insert) mempty <$> Gen.list (Range.linear 0 10) genBuukaEntry