Search in all documents (#99)

CHANGELOG.md

@@ -11,6 +11,7 @@ and this project adheres to
 - Add completion installation instruction
 - Add contacts
 - Add command to show wiki notes
+- Search among tasks, wiki, and/or contacts
 
 ## [0.6] - 2018-08-07
 ### Added

ff-core/lib/FF.hs

@@ -18,7 +18,7 @@ module FF
     , cmdSearch
     , cmdUnarchive
     , getContactSamples
-    , getSamples
+    , getNoteSamples
     , getUtcToday
     , getWikiSamples
     , loadActiveNotes
@@ -60,8 +60,9 @@ import           System.Random (StdGen, mkStdGen, randoms, split)
 
 import           FF.Config (ConfigUI (..))
 import           FF.Options (Edit (..), New (..))
-import           FF.Storage (Document (..), MonadStorage, Storage, create,
-                             listDocuments, load, modify)
+import           FF.Storage (DocId (..), Document (..),
+                             MonadStorage, Storage, create, listDocuments, load,
+                             modify)
 import           FF.Types (Contact (..), ContactId, ContactSample,
                            ContactView (..), Limit, ModeMap, Note (..), NoteId,
                            NoteSample, NoteStatus (..), NoteView (..),
@@ -82,6 +83,12 @@ loadActiveContacts :: MonadStorage m => m [ContactView]
 loadActiveContacts =
     filter (\ContactView { contactViewStatus } -> contactViewStatus == Active) <$> loadAllContacts
 
+filterContacts :: (Text -> Bool) -> [ContactView] -> [ContactView]
+filterContacts predicate notes =
+    [ n | n@ContactView{contactViewId = DocId x, contactViewName} <- notes
+    , predicate contactViewName || predicate (Text.pack x)
+    ]
+
 getContactSamples :: MonadStorage m => m ContactSample
 getContactSamples = getContactSamplesWith $ const True
 
@@ -91,8 +98,8 @@ getContactSamplesWith
     -> m ContactSample
 getContactSamplesWith predicate = do
     activeContacts <- loadActiveContacts
-    pure . (\ys -> Sample ys $ genericLength ys) .
-        filter (predicate . contactViewName) $ activeContacts
+    pure . (\ys -> Sample ys $ genericLength ys) $
+        filterContacts predicate activeContacts
 
 loadAllNotes :: MonadStorage m => m [NoteView]
 loadAllNotes = do
@@ -109,7 +116,7 @@ loadTrackedNotes = do
     mnotes <- for docs load
     pure
         [ (noteId, value)
-        | (noteId, Right Document{value = value @ Note{noteTracked = Just _}})
+        | (noteId, Right Document{value = value@Note{noteTracked = Just _}})
             <- zip docs mnotes
         ]
 
@@ -121,30 +128,36 @@ loadWikiNotes :: MonadStorage m => m [NoteView]
 loadWikiNotes =
     filter (\NoteView { status } -> status == Wiki) <$> loadAllNotes
 
-getSamples
+filterNotes :: (Text -> Bool) -> [NoteView] -> [NoteView]
+filterNotes predicate notes =
+    [ n | n@NoteView {nid = Just (DocId i), text} <- notes
+    , predicate text || predicate (Text.pack i)
+    ]
+
+getNoteSamples
     :: MonadStorage m
     => ConfigUI
     -> Maybe Limit
     -> Day  -- ^ today
     -> m (ModeMap NoteSample)
-getSamples = getSamplesWith $ const True
+getNoteSamples = getNoteSamplesWith $ const True
 
-getSamplesWith
+getNoteSamplesWith
     :: MonadStorage m
     => (Text -> Bool)  -- ^ predicate to filter notes by text
     -> ConfigUI
     -> Maybe Limit
     -> Day             -- ^ today
     -> m (ModeMap NoteSample)
-getSamplesWith predicate ConfigUI { shuffle } limit today = do
+getNoteSamplesWith predicate ConfigUI { shuffle } limit today = do
     activeNotes <- loadActiveNotes
     -- in sorting by nid no business-logic is involved,
     -- it's just for determinism
     pure .
         takeSamples limit .
-        (if shuffle then shuffleItems gen else fmap (sortOn $ start &&& nid)) .
+        (if shuffle then shuffleTraverseItems gen else fmap (sortOn $ start &&& nid)) .
         splitModes today $
-        filter (predicate . text) activeNotes
+        filterNotes predicate activeNotes
   where
     gen = mkStdGen . fromIntegral $ toModifiedJulianDay today
 
@@ -153,7 +166,7 @@ getWikiSamples
     => ConfigUI
     -> Maybe Limit
     -> Day  -- ^ today
-    -> m (ModeMap NoteSample)
+    -> m NoteSample
 getWikiSamples = getWikiSamplesWith $ const True
 
 getWikiSamplesWith
@@ -162,21 +175,30 @@ getWikiSamplesWith
     -> ConfigUI
     -> Maybe Limit
     -> Day             -- ^ today
-    -> m (ModeMap NoteSample)
+    -> m NoteSample
 getWikiSamplesWith predicate ConfigUI { shuffle } limit today = do
     wikiNotes <- loadWikiNotes
+    let filteredNotes = filterNotes predicate wikiNotes
+    let wiki = case limit of
+            Nothing -> filteredNotes
+            Just l -> take (fromIntegral l) filteredNotes
+    pure . toSample $
     -- in sorting by nid no business-logic is involved,
     -- it's just for determinism
-    pure .
-        takeSamples limit .
-        (if shuffle then shuffleItems gen else fmap (sortOn $ start &&& nid)) .
-        splitModes today $
-        filter (predicate . text) wikiNotes
+        (if shuffle then shuffleItems gen else sortOn $ start &&& nid) wiki
   where
+    toSample ys = Sample ys $ genericLength ys
     gen = mkStdGen . fromIntegral $ toModifiedJulianDay today
 
-shuffleItems :: Traversable t => StdGen -> t [b] -> t [b]
-shuffleItems gen = (`evalState` gen) . traverse shuf
+shuffleItems :: StdGen -> [b] -> [b]
+shuffleItems gen = (`evalState` gen) . shuf
+  where
+    shuf xs = do
+        g <- state split
+        pure . map snd . sortOn fst $ zip (randoms g :: [Int]) xs
+
+shuffleTraverseItems :: Traversable t => StdGen -> t [b] -> t [b]
+shuffleTraverseItems gen = (`evalState` gen) . traverse shuf
   where
     shuf xs = do
         g <- state split
@@ -209,7 +231,7 @@ updateTrackedNote oldNotes NoteView{..} =
             note <- newNote' status text start end tracked
             void $ create note
         Just (n, _) ->
-            void $ modify n $ \note @ Note{..} -> do
+            void $ modify n $ \note@Note{..} -> do
                 noteStatus' <- lwwAssignIfDiffer status noteStatus
                 noteText'   <- rgaEditText text noteText
                 pure note{noteStatus = noteStatus', noteText = noteText'}
@@ -274,13 +296,18 @@ cmdDeleteContact cid = modifyAndViewContact cid $ \contact@Contact {..} -> do
         }
 
 cmdSearch
-    :: Text
+    :: Text  -- ^ query
     -> Maybe Limit
     -> Day  -- ^ today
-    -> Storage (ModeMap NoteSample)
-cmdSearch substr = getSamplesWith
-    (Text.isInfixOf (Text.toCaseFold substr) . Text.toCaseFold)
-    ConfigUI {shuffle = False}
+    -> Storage (ModeMap NoteSample, NoteSample, ContactSample)
+cmdSearch substr limit today = do
+    notes <- getNoteSamplesWith predicate ui limit today
+    wiki <- getWikiSamplesWith predicate ui limit today
+    contacts <- getContactSamplesWith predicate
+    pure (notes, wiki, contacts)
+  where
+    predicate = Text.isInfixOf (Text.toCaseFold substr) . Text.toCaseFold
+    ui = ConfigUI {shuffle = False}
 
 cmdDeleteNote :: NoteId -> Storage NoteView
 cmdDeleteNote nid = modifyAndView nid $ \note@Note {..} -> do
@@ -331,7 +358,7 @@ cmdEdit Edit{..} = case (editText, editStart, editEnd) of
             (Just start, Just (Just end), _       ) -> Just (start, end)
             _ -> Nothing
     update :: Note -> Storage Note
-    update note @ Note{noteStatus = (LWW.query -> noteStatus), noteEnd, noteStart, noteText} = do
+    update note@Note{noteStatus = (LWW.query -> noteStatus), noteEnd, noteStart, noteText} = do
         (start, end) <- case noteStatus of
             Wiki -> case (editStart, editEnd) of
                 (Nothing, Nothing) -> pure (Nothing, Nothing)

ff-core/lib/FF/Options.hs

@@ -90,8 +90,11 @@ data New = New
     }
 
 data Search = Search
-    { searchText  :: Text
-    , searchLimit :: Maybe Limit
+    { searchText     :: Text
+    , searchTasks    :: Bool  -- ^ search among tasks
+    , searchWiki     :: Bool  -- ^ search among wiki notes
+    , searchContacts :: Bool  -- ^ search among contacts
+    , searchLimit    :: Maybe Limit
     }
 
 parseOptions :: Storage.Handle -> IO Options
@@ -182,7 +185,15 @@ parseOptions h = execParser $ i parser "A note taker and task tracker"
         <*> optional textOption
         <*> optional start
         <*> optional maybeEnd
-    search = Search <$> strArgument (metavar "TEXT") <*> optional limit
+    search = Search
+        <$> strArgument (metavar "TEXT")
+        <*> searchN
+        <*> searchW
+        <*> searchC
+        <*> optional limit
+    searchN = switch (long "tasks" <> short 't' <> help "Search among notes")
+    searchW = switch (long "wiki" <> short 'w' <> help "Search among wiki")
+    searchC = switch (long "contacts" <> short 'c' <> help "Search among contacts")
     noteid = DocId <$> strArgument
         (metavar "ID" <> help "note id" <> completer completeNoteIds)
     text = strArgument $ metavar "TEXT" <> help "note text"

ff-core/lib/FF/Serve.hs

@@ -27,7 +27,7 @@ import           Text.Blaze.Html5 (Html, a, br, div, h1, li, p, section, span,
 import           Text.Blaze.Html5.Attributes (class_, href)
 import           Web.Scotty (get, html, scottyOpts, settings, verbose)
 
-import           FF (getSamples, getUtcToday)
+import           FF (getNoteSamples, getUtcToday)
 import           FF.Config (ConfigUI (..))
 import           FF.Storage (runStorage)
 import qualified FF.Storage as Storage
@@ -40,7 +40,7 @@ cmdServe h ui = liftIO $ do
     hPutStrLn stderr "serving at http://localhost:3000/"
     scottyOpts opts $ get "/" $ do
         today <- getUtcToday
-        nvs <- liftIO $ runStorage h $ getSamples ui Nothing today
+        nvs <- liftIO $ runStorage h $ getNoteSamples ui Nothing today
         html $ renderHtml $ do
             style ".metaItem { color: #ccc; }"
             prettyHtmlSamplesBySections nvs

ff-core/lib/FF/UI.hs

@@ -38,19 +38,61 @@ indentation = 2
 pshow :: Show a => a -> Doc
 pshow = string . show
 
-prettyContactSamplesOmitted :: ContactSample -> Doc
-prettyContactSamplesOmitted samples = sparsedStack $
-    prettyContactSample samples :
+prettyNotesWikiContacts
+    :: Bool  -- ^ brief output
+    -> ModeMap NoteSample
+    -> NoteSample
+    -> ContactSample
+    -> Bool  -- ^ search among tasks
+    -> Bool  -- ^ search among wiki notes
+    -> Bool  -- ^ search among contacts
+    -> Doc
+prettyNotesWikiContacts brief notes wiki contacts amongN amongW amongC =
+    case (amongN, amongW, amongC) of
+        (True, False, False) -> ns
+        (False, True, False) -> ws
+        (False, False, True) -> cs
+        (True, True, False)  -> ns </> ws
+        (False, True, True)  -> ws </> cs
+        (True, False, True)  -> ns </> cs
+        (_,_,_)              -> ns </> ws </> cs
+  where
+    ns = prettySamplesBySections brief notes
+    ws = prettyWikiSamplesOmitted brief wiki
+    cs = prettyContactSamplesOmitted brief contacts
+
+prettyContactSamplesOmitted :: Bool -> ContactSample -> Doc
+prettyContactSamplesOmitted brief samples = sparsedStack $
+    prettyContactSample brief samples :
     [Pretty.text $ show numOmitted <> " task(s) omitted" | numOmitted > 0]
   where
     numOmitted = omitted samples
 
-prettyContactSample :: ContactSample -> Doc
-prettyContactSample = \case
+prettyContactSample :: Bool -> ContactSample -> Doc
+prettyContactSample brief = \case
     Sample{total = 0} -> mempty
     Sample{docs} ->
-        withHeader "Contacts:" . sparsedStack $
+        withHeader "Contacts:" . stacking $
         map ((star <>) . indent 1 . contactViewFull) docs
+  where
+    stacking = if brief then stack else sparsedStack
+
+prettyWikiSamplesOmitted :: Bool -> NoteSample -> Doc
+prettyWikiSamplesOmitted brief samples = sparsedStack $
+    prettyWikiSample brief samples :
+    [Pretty.text $ show numOmitted <> " task(s) omitted" | numOmitted > 0]
+  where
+    numOmitted = omitted samples
+
+prettyWikiSample :: Bool -> NoteSample -> Doc
+prettyWikiSample brief = \case
+    Sample{total = 0} -> mempty
+    Sample{docs} ->
+        withHeader "Wiki notes:" . stacking $
+        map ((star <>) . indent 1 . noteView) docs
+  where
+    stacking = if brief then stack else sparsedStack
+    noteView = if brief then noteViewBrief else noteViewFull
 
 prettySamplesBySections :: Bool -> ModeMap NoteSample -> Doc
 prettySamplesBySections brief samples = stack' brief $

ff-test/test/Main.hs

@@ -43,7 +43,7 @@ import           Test.Tasty (TestTree, testGroup)
 import           Test.Tasty.Hedgehog (testProperty)
 import           Test.Tasty.TH (defaultMainGenerator)
 
-import           FF (cmdNewNote, getSamples)
+import           FF (cmdNewNote, getNoteSamples)
 import           FF.Config (ConfigUI (..))
 import qualified FF.Github as Github
 import           FF.Options (New (..))
@@ -61,15 +61,15 @@ main = $defaultMainGenerator
 prop_not_exist :: Property
 prop_not_exist = property $ do
     (agenda, fs') <-
-        either fail pure $ runStorageSim fs $ getSamples ui agendaLimit today
+        either fail pure $ runStorageSim fs $ getNoteSamples ui agendaLimit today
     agenda === Map.empty
     fs' === fs
     where fs = Map.empty
 
 prop_smoke :: Property
 prop_smoke = property $ do
     (agenda, fs') <-
-        either fail pure $ runStorageSim fs123 $ getSamples ui agendaLimit today
+        either fail pure $ runStorageSim fs123 $ getNoteSamples ui agendaLimit today
     agenda ===
         Map.singleton
             (Overdue 365478)