import from firefox #1

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

View File

@ -23,6 +23,8 @@ import Data.Hashable
import GHC.Generics
(Generic)
import Data.Text
import Control.Monad.Reader
import Control.Monad.State
@ -30,13 +32,13 @@ import Data.ByteString
(ByteString)
import qualified Data.ByteString as B
newtype URL = URL String
newtype URL = URL Text
deriving stock (Show, Eq, Generic, Ord)
deriving newtype (ToJSON, FromJSON, FromJSONKey, ToJSONKey, Hashable)
data BuukaEntry
= BuukaEntry { url :: URL
, title :: Maybe String
, title :: Maybe Text
}
deriving stock (Show, Eq, Generic)
deriving anyclass (ToJSON, FromJSON, Hashable)

View File

@ -20,36 +20,37 @@ module Data.Query
import Data.Buuka
(BuukaEntry(..), URL(..))
import Data.List
(isPrefixOf, isSuffixOf)
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 String
Title :: Field String
Url :: Field Text
Title :: Field Text
data QueryF f where
StartsWith :: Field String -> String -> QueryF f
EndsWith :: Field String -> String -> QueryF f
Regex :: Field String -> String -> QueryF f
StartsWith :: Field Text -> Text -> QueryF f
EndsWith :: Field Text -> Text -> QueryF f
Regex :: Field Text -> Text -> QueryF f
And :: f -> f -> QueryF f
deriving instance Functor QueryF
type Query = Fix QueryF
startsWith :: Field String -> String -> Query
startsWith :: Field Text -> Text -> Query
startsWith field x = Fix (StartsWith field x)
endsWith :: Field String -> String -> Query
endsWith :: Field Text -> Text -> Query
endsWith field x = Fix (EndsWith field x)
regex :: Field String -> String -> Query
regex :: Field Text -> Text -> Query
regex field x = Fix (Regex field x)
(.&&.) :: Query -> Query -> Query
@ -57,10 +58,10 @@ a .&&. b = Fix (And a b)
evaluate :: QueryF (BuukaEntry -> Bool) -> (BuukaEntry -> Bool)
evaluate = \case
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
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
And a b -> \e -> a e && b e

View File

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

View File

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

View File

@ -14,10 +14,14 @@ 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 . putStrLn)
buukaQ (asks go) >>= traverse_ (liftIO . T.putStrLn)
where
go :: Buuka -> [String]
go :: Buuka -> [Text]
go b = formatEntries b (B.elements b)

View File

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

View File

@ -1,3 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
module Test.Data.Buuka where
import Hedgehog
@ -8,26 +9,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 . concat <$> sequence go
genUrl = URL . T.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 = intercalate "/" <$> Gen.list (Range.linear 0 10) (Gen.element paths)
genPath = T.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.string (Range.linear 0 10) Gen.unicode)
genTitle = Gen.maybe (Gen.text (Range.linear 0 10) Gen.unicode)
genBuuka :: Gen Buuka
genBuuka = F.foldl' (flip insert) mempty <$> Gen.list (Range.linear 0 10) genBuukaEntry