Refactor to use text instead of string
This commit is contained in:
parent
a921139295
commit
a1e67c6387
@ -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)
|
||||||
|
@ -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
|
||||||
|
@ -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)
|
||||||
|
@ -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 }
|
||||||
|
@ -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)
|
||||||
|
@ -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)
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user