Compare commits

..

3 Commits

Author SHA1 Message Date
527cc0a34c Add regex to the query language 2021-01-03 00:23:43 +02:00
7bae9ca92e More type safety on string types? 2021-01-03 00:16:36 +02:00
9048581ea1 Do GADT instead 2021-01-03 00:14:52 +02:00
3 changed files with 16 additions and 9 deletions

View File

@ -59,6 +59,7 @@ library
, text , text
, lens , lens
, hashable , hashable
, regex-tdfa
hs-source-dirs: src hs-source-dirs: src
executable buuka executable buuka

View File

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

View File

@ -21,6 +21,9 @@ import Data.Buuka
import Data.List import Data.List
(isPrefixOf, isSuffixOf) (isPrefixOf, isSuffixOf)
import Text.Regex.TDFA
((=~))
import Data.Functor.Foldable import Data.Functor.Foldable
(Fix(..)) (Fix(..))
@ -28,19 +31,20 @@ data Field a where
Url :: Field String Url :: Field String
Title :: Field String Title :: Field String
data QueryF f data QueryF f where
= forall a. StartsWith (Field a) a StartsWith :: Field String -> String -> QueryF f
| forall a. EndsWith (Field a) a EndsWith :: Field String -> String -> QueryF f
| And f f Regex :: Field String -> String -> 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 a -> a -> Query startsWith :: Field String -> String -> Query
startsWith field x = Fix (StartsWith field x) startsWith field x = Fix (StartsWith field x)
endsWith :: Field a -> a -> Query endsWith :: Field String -> String -> Query
endsWith field x = Fix (EndsWith field x) endsWith field x = Fix (EndsWith field x)
(.&&.) :: Query -> Query -> Query (.&&.) :: Query -> Query -> Query
@ -52,4 +56,6 @@ evaluate = \case
EndsWith Url x -> \BuukaEntry{url=URL u} -> x `isSuffixOf` u EndsWith Url x -> \BuukaEntry{url=URL u} -> x `isSuffixOf` u
StartsWith Title x -> \BuukaEntry{title=t} -> maybe False (x `isPrefixOf`) t StartsWith Title x -> \BuukaEntry{title=t} -> maybe False (x `isPrefixOf`) t
EndsWith Title x -> \BuukaEntry{title=t} -> maybe False (x `isSuffixOf`) 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 And a b -> \e -> a e && b e