app/Main.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE TupleSections #-}
 module Main where
 
 import Options.Applicative
@@ -11,30 +10,20 @@ import Data.Environment
 import UnliftIO.Directory
        (XdgDirectory(XdgData), getXdgDirectory)
 
-import Data.Foldable
-       (asum)
-
 import System.Environment
        (lookupEnv)
 
 import qualified Operations
 
-import Data.Query
-       (Field(..))
-
 commands :: Parser (BuukaM ())
 commands = subparser
-  (  command "insert" (info (insertOpts Operations.insert <**> helper) (progDesc "Insert a new bookmark"))
+  (  command "insert" (info (insertOpts Operations.insert) (progDesc "Insert a new bookmark"))
-  <> command "list" (info (pure Operations.list <**> helper) (progDesc "List all the bookmarks"))
+  <> command "list" (info (pure Operations.list) (progDesc "List all the bookmarks"))
-  <> command "query" (info (queryOpts Operations.query <**> helper) (progDesc "Query the bookmarks"))
   )
   where
     insertOpts f =
         f <$> strOption (long "url" <> short 'u' <> metavar "URL")
           <*> optional (strOption (long "title"))
-    queryOpts f =
-      uncurry f <$> asum [tagged Title "title", tagged Url "url"]
-    tagged t x = (t, ) <$> strOption (long x <> metavar "REGEX")
 
 main :: IO ()
 main = do

buuka.cabal

@@ -36,15 +36,12 @@ library
   exposed-modules:     MyLib
                      , Database.Migrations
                      , Control.Monad.Buuka
-                     , Operations.Format
                      , Operations.Insert
                      , Operations.List
-                     , Operations.Query
+                     , Operations.Format
                      , Operations
                      , Data.Environment
                      , Data.Buuka
-                     , Data.Query
-                     , Data.Functor.Foldable
   -- other-modules:
   build-depends:       aeson
                      , yaml
@@ -60,7 +57,6 @@ library
                      , text
                      , lens
                      , hashable
-                     , regex-tdfa
   hs-source-dirs:      src
 
 executable buuka
@@ -77,8 +73,6 @@ test-suite buuka-test
   import:              common-stanza
   other-modules:       Test.Database.Migrations
                        Test.Data.Buuka
-                       Test.Data.Query
-                       Test.Data.Functor.Foldable
   type:                exitcode-stdio-1.0
   hs-source-dirs:      test
   main-is:             MyLibTest.hs
@@ -86,8 +80,6 @@ test-suite buuka-test
                      , hedgehog
                      , hedgehog-corpus
                      , tasty-hedgehog
-                     , tasty-hunit
                      , tasty
                      , text
                      , aeson
-                     , deriving-compat

default.nix

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

src/Data/Functor/Foldable.hs

@@ -1,44 +0,0 @@
-{-|
-Module      : Data.Functor.Foldable
-Description : Simplified recursion schemes
-Copyright   : (c) Mats Rauhala, 2020
-License     : BSD-3-Clause
-Maintainer  : mats.rauhala@iki.fi
-Stability   : experimental
-Portability : POSIX
-
-Simplified recursion schemes, providing only the minimal schemes
--}
-module Data.Functor.Foldable
-  ( Fix(..)
-  , cata
-  , ana
-  , hylo
-  )
-  where
-
-import Data.Functor.Classes
-
-newtype Fix f = Fix { getFix :: f (Fix f) }
-
-instance Show1 f => Show (Fix f) where
-  showsPrec d (Fix f) = showString "Fix " . showsPrec1 d f
-
-instance Eq1 f => Eq (Fix f) where
-  (Fix a) == (Fix b) = liftEq (==) a b
-
--- | Catamorphism or the fold
---
--- Fold a recursive structure into a value
-cata :: Functor f => (f a -> a) -> Fix f -> a
-cata f = a where a = f . fmap a . getFix
-
--- | Anamorphism or the unfold
---
--- Unfold a seed into a recursive structure
-ana :: Functor f => (a -> f a) -> a -> Fix f
-ana f = a where a = Fix . fmap a . f
-
--- | Combined fold and unfold
-hylo :: (Functor f) => (f a -> a) -> (b -> f b) -> b -> a
-hylo f u = a where a = f . fmap a . u

src/Data/Query.hs

@@ -1,69 +0,0 @@
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
-module Data.Query
-  (
-    -- * AST
-    Field(..)
-
-    -- * Combinators
-  , startsWith
-  , endsWith
-  , regex
-  , (.&&.)
-
-    -- * Evaluating queries
-  , evaluate
-  , predicate
-  )
-  where
-
-import Data.Buuka
-       (BuukaEntry(..), URL(..))
-
-import Data.List
-       (isPrefixOf, isSuffixOf)
-
-import Text.Regex.TDFA
-       ((=~))
-
-import Data.Functor.Foldable
-       (Fix(..), cata)
-
-data Field a where
-  Url :: Field String
-  Title :: Field String
-
-data QueryF f where
-  StartsWith :: Field String -> String -> QueryF f
-  EndsWith :: Field String -> String -> QueryF f
-  Regex :: Field String -> String -> QueryF f
-  And :: f -> f -> QueryF f
-
-deriving instance Functor QueryF
-
-type Query = Fix QueryF
-
-startsWith :: Field String -> String -> Query
-startsWith field x = Fix (StartsWith field x)
-
-endsWith :: Field String -> String -> Query
-endsWith field x = Fix (EndsWith field x)
-
-regex :: Field String -> String -> Query
-regex field x = Fix (Regex field x)
-
-(.&&.) :: Query -> Query -> Query
-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
-  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
-
-predicate :: Query -> BuukaEntry -> Bool
-predicate = cata evaluate

src/Operations.hs

@@ -1,7 +1,6 @@
 module Operations
   ( module Operations.Insert
   , module Operations.List
-  , module Operations.Query
   )
   where
 
@@ -9,5 +8,3 @@ import Operations.Insert
        (insert)
 import Operations.List
        (list)
-import Operations.Query
-       (query)

src/Operations/Query.hs

@@ -1,23 +0,0 @@
-module Operations.Query where
-
-import Data.Query
-
-import Control.Monad.Buuka
-import Control.Monad.Reader
-
-import Data.Foldable
-       (traverse_)
-
-import Data.Buuka
-       (Buuka)
-import qualified Data.Buuka as B
-
-import Operations.Format
-
-query :: Field String -> String -> BuukaM ()
-query field q =
-  buukaQ (asks go) >>= traverse_ (liftIO . putStrLn)
-  where
-    go :: Buuka -> [String]
-    go b = formatEntries b (filter (predicate (regex field q)) . B.elements $ b)
-

test/MyLibTest.hs

@@ -3,16 +3,12 @@ module Main (main) where
 import Test.Tasty
 
 import qualified Test.Data.Buuka as Data.Buuka
-import qualified Test.Data.Query as Data.Query
-import qualified Test.Data.Functor.Foldable as Data.Functor.Foldable
 import qualified Test.Database.Migrations as Database.Migrations
 
 tests :: TestTree
 tests = testGroup "buuka"
   [ Database.Migrations.tests
   , Data.Buuka.tests
-  , Data.Functor.Foldable.tests
-  , Data.Query.tests
   ]
 
 main :: IO ()

test/Test/Data/Functor/Foldable.hs

@@ -1,68 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE TemplateHaskell #-}
-module Test.Data.Functor.Foldable where
-
-import Hedgehog
-import qualified Hedgehog.Gen as Gen
-import qualified Hedgehog.Range as Range
-import Test.Tasty
-import Test.Tasty.Hedgehog
-
-import Data.Eq.Deriving
-       (deriveEq1)
-import Text.Show.Deriving
-       (deriveShow1)
-
-import Data.Functor.Foldable
-
-data AST f
-  = Addition f f
-  | Value Int
-  deriving stock (Functor, Eq, Show)
-
-deriveShow1 ''AST
-deriveEq1 ''AST
-
-evaluate :: AST Int -> Int
-evaluate = \case
-  Addition a b -> a + b
-  Value x -> x
-
-render :: AST String -> String
-render = \case
-  Addition a b -> a <> " + " <> b
-  Value x -> show x
-
-parse :: [String] -> AST [String]
-parse = \case
-  a : "+" : b : xs -> Addition (a : xs) [b]
-  [a] -> Value (read a)
-  _ -> Value 0
-
-genAST :: Gen (Fix AST)
-genAST = Gen.recursive Gen.choice
-  [ Fix . Value <$> Gen.integral (Range.linear 0 100) ]
-  [ Gen.subterm2 genAST genAST (\a b -> Fix (Addition a b))
-  ]
-
-prop_parse_render_tripping :: Property
-prop_parse_render_tripping = property $ do
-  x <- forAll genAST
-  let rendered = cata render x
-      parsed = ana parse . words $ rendered
-  annotateShow rendered
-  annotateShow parsed
-  annotateShow $ cata evaluate x
-  cata evaluate parsed === cata evaluate x
-
-prop_parse_render_hylo :: Property
-prop_parse_render_hylo = property $ do
-  x <- forAll genAST
-  let rendered = cata render x
-  hylo evaluate parse (words rendered) === cata evaluate x
-
-tests :: TestTree
-tests = testGroup "Data.Functor.Foldable"
-  [ testProperty "cata and ana do reverse" $ prop_parse_render_tripping
-  , testProperty "hylo do reverse" $ prop_parse_render_hylo
-  ]

test/Test/Data/Query.hs

@@ -1,39 +0,0 @@
-module Test.Data.Query where
-
-import Test.Tasty
-import Test.Tasty.HUnit
-
-import Data.Buuka
-       (BuukaEntry(..), URL(..))
-import Data.Functor.Foldable
-       (cata)
-import Data.Query
-
-test_startswith :: Assertion
-test_startswith = do
-  let entry = BuukaEntry (URL "http://example.com") (Just "foo")
-  cata evaluate (startsWith Url "http://") entry @?= True
-  cata evaluate (startsWith Url "https://") entry @?= False
-  cata evaluate (startsWith Title "foo") entry @?= True
-  cata evaluate (startsWith Title "bar") entry @?= False
-
-test_endswith :: Assertion
-test_endswith = do
-  let entry = BuukaEntry (URL "http://example.com") (Just "foo")
-  cata evaluate (endsWith Url "com") entry @?= True
-  cata evaluate (endsWith Url "fi") entry @?= False
-  cata evaluate (endsWith Title "foo") entry @?= True
-  cata evaluate (endsWith Title "bar") entry @?= False
-
-test_and :: Assertion
-test_and = do
-  let entry = BuukaEntry (URL "http://example.com") (Just "foo")
-  cata evaluate (startsWith Url "http://" .&&. endsWith Url ".com") entry @?= True
-  cata evaluate (startsWith Url "http://" .&&. endsWith Url ".fi") entry @?= False
-
-tests :: TestTree
-tests = testGroup "Data.Query"
-  [ testCase "Queries startsWith" test_startswith
-  , testCase "Queries endsWith" test_endswith
-  , testCase "Queries and" test_and
-  ]