feat: add `search` command

3 files changed, 42 insertions, 17 deletions

diff --git a/app/Issue.hs b/app/Issue.hs
index 27f6801..d58d14d 100644
--- a/app/Issue.hs
+++ b/app/Issue.hs
@@ -83,10 +83,6 @@ internalTags :: Issue -> [Tag]
 internalTags issue@(Issue {..}) =
   concat
     [ [ Tag "id" $ Just issue.id,
-        Tag "title" $ Just title,
-        -- TODO Remove @rawText internal tag
-        --
-        -- Tag "rawText" $ Just rawText,
         Tag "createdAt" $ Just $ T.pack $ show $ utctDay provenance.first.date,
         Tag "modifiedAt" $ Just $ T.pack $ show $ utctDay provenance.last.date,
         Tag "author" $ Just provenance.first.author.name,
diff --git a/app/Main.hs b/app/Main.hs
index ffd1c99..06b326c 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,16 +1,3 @@
--- TODO Add fulltext search
---
--- Additional to `--filter` it should be possible to search for issues
--- using `--search 'some query'` using a search-engine like full text
--- search.
---
--- To make this fast, we could use a package like
--- <https://hackage.haskell.org/package/full-text-search> and make sure
--- to persist the index in a local cache.
---
--- @topic search
--- @backlog
-
 -- TODO Compute history from the top
 --
 -- Currently we are computing the history from the bottom (ie. earliest commit
@@ -360,6 +347,7 @@ import System.FilePath ((</>))
 import System.IO.Temp (withSystemTempDirectory)
 import System.Process.Typed qualified as P
 import Text.Printf
+import Text.RE.TDFA.Text qualified as R
 import Tuple ()
 import Prelude hiding (id)
 
@@ -441,6 +429,11 @@ data Command
   | Log
       { patch :: Bool
       }
+  | Search
+      { pattern :: R.RE,
+        closed :: Bool,
+        detailed :: Bool
+      }
   | Show
       { id :: String,
         edit :: Bool
@@ -454,6 +447,8 @@ cmd =
         O.progDesc "List all issues",
       O.command "log" . O.info logCmd $
         O.progDesc "Show a log of all issues",
+      O.command "search" . O.info searchCmd $
+        O.progDesc "List issues matching a pattern",
       O.command "show" . O.info showCmd $
         O.progDesc "Show details of all issues",
       O.command "tags" . O.info tagsCmd $
@@ -476,12 +471,25 @@ logCmd =
   Log
     <$> patchFlag
 
+searchCmd :: O.Parser Command
+searchCmd =
+  Search
+    <$> patternArg
+    <*> closedArg
+    <*> detailedArg
+
 showCmd :: O.Parser Command
 showCmd =
   Show
     <$> idArg
     <*> editFlag
 
+patternArg :: O.Parser R.RE
+patternArg =
+  O.argument
+    (O.maybeReader R.compileRegex)
+    (O.metavar "PATTERN")
+
 tagsCmd :: O.Parser Command
 tagsCmd =
   pure Tags
@@ -589,6 +597,20 @@ main = do
               )
               issues
       putDoc colorize noPager width tags
+    Options {colorize, noPager, width, command = Search {pattern, closed, detailed}} -> do
+      issues <-
+        I.applyClosed closed
+          . (M.elems . (.issues))
+          <$> H.getIssues
+      putDoc colorize noPager width
+        . (P.vsep . intersperse "")
+        . map
+          ( if detailed
+              then P.render . P.Detailed
+              else P.render . P.Summarized
+          )
+        . filter (\issue -> R.matched (P.renderAsText issue R.?=~ pattern))
+        $ issues
 
 showIssue :: [Issue] -> Issue -> P.Doc P.AnsiStyle
 showIssue issues issue = do
diff --git a/app/Render.hs b/app/Render.hs
index f4293c2..907ef15 100644
--- a/app/Render.hs
+++ b/app/Render.hs
@@ -12,6 +12,7 @@ module Render
     (<<<),
     (===),
     styled,
+    renderAsText,
 
     -- * Reporting styles
     Detailed (..),
@@ -46,6 +47,12 @@ class Render a where
   default render :: Pretty a => a -> Doc AnsiStyle
   render = pretty
 
+renderAsString :: Render a => a -> String
+renderAsString = show . render
+
+renderAsText :: Render a => a -> T.Text
+renderAsText = T.pack . renderAsString
+
 instance Render (Doc AnsiStyle) where
   render = id