From a1e67c63872d8282ef27c9c9e151ad6392e5f423 Mon Sep 17 00:00:00 2001 From: Mats Rauhala Date: Sun, 3 Jan 2021 08:33:44 +0200 Subject: [PATCH] Refactor to use text instead of string --- src/Data/Buuka.hs | 6 ++++-- src/Data/Query.hs | 31 ++++++++++++++++--------------- src/Operations/Format.hs | 17 ++++++++++------- src/Operations/Insert.hs | 5 ++++- src/Operations/List.hs | 8 ++++++-- src/Operations/Query.hs | 10 +++++++--- test/Test/Data/Buuka.hs | 11 ++++++----- 7 files changed, 53 insertions(+), 35 deletions(-) diff --git a/src/Data/Buuka.hs b/src/Data/Buuka.hs index 62d1f62..5a6a578 100644 --- a/src/Data/Buuka.hs +++ b/src/Data/Buuka.hs @@ -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) diff --git a/src/Data/Query.hs b/src/Data/Query.hs index 138ed12..70003ba 100644 --- a/src/Data/Query.hs +++ b/src/Data/Query.hs @@ -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 diff --git a/src/Operations/Format.hs b/src/Operations/Format.hs index b155c77..3c294c9 100644 --- a/src/Operations/Format.hs +++ b/src/Operations/Format.hs @@ -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) diff --git a/src/Operations/Insert.hs b/src/Operations/Insert.hs index 4f840d2..aa97a6b 100644 --- a/src/Operations/Insert.hs +++ b/src/Operations/Insert.hs @@ -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 } diff --git a/src/Operations/List.hs b/src/Operations/List.hs index d786655..7db1f0b 100644 --- a/src/Operations/List.hs +++ b/src/Operations/List.hs @@ -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) diff --git a/src/Operations/Query.hs b/src/Operations/Query.hs index 0ed3a5e..d871181 100644 --- a/src/Operations/Query.hs +++ b/src/Operations/Query.hs @@ -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) diff --git a/test/Test/Data/Buuka.hs b/test/Test/Data/Buuka.hs index 5e65b10..8149767 100644 --- a/test/Test/Data/Buuka.hs +++ b/test/Test/Data/Buuka.hs @@ -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