Refactor to use text instead of string

This commit is contained in:
Mats Rauhala 2021-01-03 08:33:44 +02:00
parent a921139295
commit a1e67c6387
7 changed files with 53 additions and 35 deletions

View File

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

View File

@ -20,36 +20,37 @@ module Data.Query
import Data.Buuka import Data.Buuka
(BuukaEntry(..), URL(..)) (BuukaEntry(..), URL(..))
import Data.List
(isPrefixOf, isSuffixOf)
import Text.Regex.TDFA import Text.Regex.TDFA
((=~)) ((=~))
import Data.Functor.Foldable import Data.Functor.Foldable
(Fix(..), cata) (Fix(..), cata)
import Data.Text
(Text)
import qualified Data.Text as T
data Field a where data Field a where
Url :: Field String Url :: Field Text
Title :: Field String Title :: Field Text
data QueryF f where data QueryF f where
StartsWith :: Field String -> String -> QueryF f StartsWith :: Field Text -> Text -> QueryF f
EndsWith :: Field String -> String -> QueryF f EndsWith :: Field Text -> Text -> QueryF f
Regex :: Field String -> String -> QueryF f Regex :: Field Text -> Text -> QueryF f
And :: f -> f -> QueryF f And :: f -> f -> QueryF f
deriving instance Functor QueryF deriving instance Functor QueryF
type Query = Fix QueryF type Query = Fix QueryF
startsWith :: Field String -> String -> Query startsWith :: Field Text -> Text -> Query
startsWith field x = Fix (StartsWith field x) startsWith field x = Fix (StartsWith field x)
endsWith :: Field String -> String -> Query endsWith :: Field Text -> Text -> Query
endsWith field x = Fix (EndsWith field x) endsWith field x = Fix (EndsWith field x)
regex :: Field String -> String -> Query regex :: Field Text -> Text -> Query
regex field x = Fix (Regex field x) regex field x = Fix (Regex field x)
(.&&.) :: Query -> Query -> Query (.&&.) :: Query -> Query -> Query
@ -57,10 +58,10 @@ a .&&. b = Fix (And a b)
evaluate :: QueryF (BuukaEntry -> Bool) -> (BuukaEntry -> Bool) evaluate :: QueryF (BuukaEntry -> Bool) -> (BuukaEntry -> Bool)
evaluate = \case evaluate = \case
StartsWith Url x -> \BuukaEntry{url=URL u} -> x `isPrefixOf` u StartsWith Url x -> \BuukaEntry{url=URL u} -> x `T.isPrefixOf` u
EndsWith Url x -> \BuukaEntry{url=URL u} -> x `isSuffixOf` u EndsWith Url x -> \BuukaEntry{url=URL u} -> x `T.isSuffixOf` u
StartsWith Title x -> \BuukaEntry{title=t} -> maybe False (x `isPrefixOf`) t StartsWith Title x -> \BuukaEntry{title=t} -> maybe False (x `T.isPrefixOf`) t
EndsWith Title x -> \BuukaEntry{title=t} -> maybe False (x `isSuffixOf`) t EndsWith Title x -> \BuukaEntry{title=t} -> maybe False (x `T.isSuffixOf`) t
Regex Url x -> \BuukaEntry{url=URL u} -> u =~ x Regex Url x -> \BuukaEntry{url=URL u} -> u =~ x
Regex Title x -> \BuukaEntry{title=t} -> maybe False (=~ x) t Regex Title x -> \BuukaEntry{title=t} -> maybe False (=~ x) t
And a b -> \e -> a e && b e And a b -> \e -> a e && b e

View File

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

View File

@ -14,10 +14,14 @@ import qualified Data.Buuka as B
import Operations.Format 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 = query field q =
buukaQ (asks go) >>= traverse_ (liftIO . putStrLn) buukaQ (asks go) >>= traverse_ (liftIO . T.putStrLn)
where where
go :: Buuka -> [String] go :: Buuka -> [Text]
go b = formatEntries b (filter (predicate (regex field q)) . B.elements $ b) 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 module Test.Data.Buuka where
import Hedgehog import Hedgehog
@ -8,26 +9,26 @@ import Test.Tasty.Hedgehog
import qualified Data.Aeson as A import qualified Data.Aeson as A
import Data.List
(intercalate)
import qualified Data.Foldable as F import qualified Data.Foldable as F
import qualified Data.Text as T
import Data.Buuka import Data.Buuka
genUrl :: Gen URL genUrl :: Gen URL
genUrl = URL . concat <$> sequence go genUrl = URL . T.concat <$> sequence go
where where
go = [ Gen.element protocols, Gen.element domains, Gen.element tlds, pure "/", genPath ] go = [ Gen.element protocols, Gen.element domains, Gen.element tlds, pure "/", genPath ]
protocols = ["http://", "https://"] protocols = ["http://", "https://"]
domains = ["example", "foo", "bar"] domains = ["example", "foo", "bar"]
tlds = ["com", "fi", "org", "net", "info"] 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"] paths = ["foo", "bar", "asd", "xyzzy"]
genBuukaEntry :: Gen BuukaEntry genBuukaEntry :: Gen BuukaEntry
genBuukaEntry = BuukaEntry <$> genUrl <*> genTitle genBuukaEntry = BuukaEntry <$> genUrl <*> genTitle
where 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 :: Gen Buuka
genBuuka = F.foldl' (flip insert) mempty <$> Gen.list (Range.linear 0 10) genBuukaEntry genBuuka = F.foldl' (flip insert) mempty <$> Gen.list (Range.linear 0 10) genBuukaEntry