Better editor search reporting; Better tags data definition

Author: cblp

ff-core/lib/FF.hs

@@ -81,7 +81,7 @@ import System.Random (StdGen, mkStdGen, randoms, split)
 
 import FF.Config (Config (Config), ConfigUI (ConfigUI), dataDir, shuffle)
 import FF.Options (Assign (Clear, Set), Edit (..), New (..), Tags (..),
-                   assignToMaybe)
+                   TagsRequest (..), assignToMaybe)
 import FF.Types (Contact (..), ContactId, ContactSample, Entity (..), EntityDoc,
                  EntityView, Limit, ModeMap, Note (..), NoteId, NoteSample,
                  NoteStatus (..), Sample (..), Status (..), Tag (..),
@@ -211,15 +211,15 @@ filterWikis = filter $ (Just Wiki ==) . note_status . entityVal
 
 data NoteFilter = NoteFilter
   { status        :: Status
-  , tags          :: Tags
+  , tags          :: TagsRequest
   , textPredicate :: Text -> Bool
   }
 
 defaultNoteFilter :: NoteFilter
 defaultNoteFilter =
   NoteFilter
     { status        = Active
-    , tags          = Tags{require = Set.empty, exclude = Set.empty}
+    , tags          = EmptyTagsRequest
     , textPredicate = const True
     }
 
@@ -268,9 +268,10 @@ viewTaskSamples
 
       tagPredicate =
         case tagFilter of
-          Tags{require, exclude} ->
+          EmptyTagsRequest -> const True
+          TagsContain Tags{require, exclude} ->
             \ts -> require `isSubsetOf` ts && exclude `disjoint` ts
-          NoTags -> null
+          TagsAbsent -> null
 
       noteViewPredicate Entity{entityVal = NoteView{tags}} =
         tagPredicate $ Set.fromList $ toList tags
@@ -442,7 +443,7 @@ cmdSearch ::
   Maybe Limit ->
   -- | today
   Day ->
-  Tags ->
+  TagsRequest ->
   m (ModeMap NoteSample, NoteSample, ContactSample)
 cmdSearch substr status ui limit today tags =
   do

ff-core/lib/FF/CLI.hs

@@ -10,7 +10,6 @@
 
 module FF.CLI where
 
-import Control.Applicative (empty)
 import Control.Concurrent (threadDelay)
 import Control.Concurrent.Async (race)
 import Control.Monad (forever, guard, when)
@@ -96,7 +95,7 @@ import FF.Options (
     Options (..),
     Search (..),
     Shuffle (..),
-    Tags (Tags),
+    TagsRequest (EmptyTagsRequest),
     Track (..),
     parseOptions,
  )
@@ -373,7 +372,7 @@ cmdTrack Track{dryRun, address, limit} today brief
     | dryRun =
         liftIO do
             samples <- run $ getOpenIssueSamples address limit today
-            pprint $ prettyTaskSections brief (Tags mempty mempty) samples
+            pprint $ prettyTaskSections brief EmptyTagsRequest samples
     | otherwise = do
         notes <- liftIO $ run $ getIssueViews address limit
         updateTrackedNotes notes
@@ -469,7 +468,7 @@ pprint doc = liftIO do
 fromEither :: Either a a -> a
 fromEither = either id id
 
-jprint :: (ToJSON a, MonadIO io) => a -> io ()
+jprint :: (MonadIO io, ToJSON a) => a -> io ()
 jprint = liftIO . BSL.putStrLn . JSON.encodePretty
 
 jprintObject :: (MonadIO io) => [JSON.Pair] -> io ()
@@ -500,7 +499,7 @@ runExternalEditor textOld = do
     assertExecutableFromConfig = do
         cfg <- loadConfig
         case externalEditor cfg of
-            Nothing -> empty
+            Nothing -> fail "Empty config parameter 'externalEditor'"
             Just editor ->
                 assertExecutableWithArgs
                     "config parameter 'externalEditor'"
@@ -512,11 +511,6 @@ runExternalEditor textOld = do
 
     assertExecutableWithArgs source cmd = do
         case ShellWords.parse cmd of
-            Left err -> do
-                hPutStrLn stderr $
-                    "bad editor command in " <> source <> ": " <> err
-                empty
-            Right [] -> do
-                hPutStrLn stderr $ "empty editor command in " <> source
-                empty
+            Left err -> fail $ "bad editor command in " <> source <> ": " <> err
+            Right [] -> fail $ "empty editor command in " <> source
             Right (prog : args) -> assertExecutable prog $> prog :| args

ff-core/lib/FF/Options.hs

@@ -3,10 +3,13 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE ImportQualifiedPost #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ViewPatterns #-}
 
 module FF.Options (
     ActionOptions (..),
@@ -23,6 +26,7 @@ module FF.Options (
     Search (..),
     Shuffle (..),
     Tags (..),
+    TagsRequest (EmptyTagsRequest, ..),
     Track (..),
     assignToMaybe,
     parseOptions,
@@ -136,9 +140,21 @@ assignToMaybe = \case
     Clear -> Nothing
     Set x -> Just x
 
-data Agenda = Agenda {limit :: Maybe Limit, tags :: Tags}
+data Agenda = Agenda {limit :: Maybe Limit, tags :: TagsRequest}
 
-data Tags = Tags {require, exclude :: Set Text} | NoTags
+data Tags = Tags {require, exclude :: Set Text}
+    deriving (Eq)
+
+data TagsRequest = TagsContain Tags | TagsAbsent
+    deriving (Eq)
+
+emptyTagsRequest :: TagsRequest
+emptyTagsRequest = TagsContain Tags{require = mempty, exclude = mempty}
+
+pattern EmptyTagsRequest :: TagsRequest
+pattern EmptyTagsRequest <- ((emptyTagsRequest ==) -> True)
+    where
+        EmptyTagsRequest = emptyTagsRequest
 
 data Edit = Edit
     { ids :: NonEmpty NoteId
@@ -166,7 +182,7 @@ data Search = Search
     , inContacts :: Bool
     , status :: Status
     , limit :: Maybe Limit
-    , tags :: Tags
+    , tags :: TagsRequest
     }
 
 parseOptions :: Maybe StorageFS.Handle -> IO Options
@@ -263,10 +279,14 @@ parser h = do
     briefOption =
         switch $ long "brief" <> short 'b' <> help "List only note titles and ids"
 
-    agenda = Agenda <$> optional limitOption <*> filterTags
+    agenda = Agenda <$> optional limitOption <*> filterByTags
+
+    filterByTags = filterByTagsAbsent <|> filterByTagsContain
 
-    filterTags =
-        filterByNoTags <|> (Tags <$> filterRequireTags <*> filterExcludeTags)
+    filterByTagsContain = do
+        require <- filterRequireTags
+        exclude <- filterExcludeTags
+        pure $ TagsContain Tags{require, exclude}
 
     track = Track <$> dryRunOption <*> optional repo <*> optional limitOption
 
@@ -325,7 +345,7 @@ parser h = do
             <*> searchC
             <*> searchA
             <*> optional limitOption
-            <*> filterTags
+            <*> filterByTags
 
     searchT = switch $ long "tasks" <> short 't' <> help "Search among tasks"
 
@@ -350,8 +370,8 @@ parser h = do
                 strOption $
                     long "tag" <> metavar "TAG" <> help "Filter by tag"
 
-    filterByNoTags =
-        flag' NoTags $
+    filterByTagsAbsent =
+        flag' TagsAbsent $
             long "no-tag"
                 <> short 'n'
                 <> help "Filter items that have no tags"

ff-core/lib/FF/UI.hs

@@ -29,7 +29,7 @@ import Data.Text (Text)
 import qualified Data.Text as Text
 import Data.Time (Day)
 import FF (fromRgaM)
-import FF.Options (Tags (..))
+import FF.Options (Tags (..), TagsRequest (TagsContain, TagsAbsent))
 import FF.Types (
     Contact (..),
     ContactSample,
@@ -102,7 +102,7 @@ prettyTasksWikisContacts ::
     -- | does search include contacts
     Bool ->
     -- | requested tags
-    Tags ->
+    TagsRequest ->
     Doc AnsiStyle
 prettyTasksWikisContacts
     isBrief
@@ -210,15 +210,15 @@ title =
 prettyTaskSections ::
     Bool ->
     -- | requested tags
-    Tags ->
+    TagsRequest ->
     ModeMap NoteSample ->
     Doc AnsiStyle
 prettyTaskSections isBrief tags samples =
     case tags of
-        Tags{require, exclude}
+        TagsContain Tags{require, exclude}
             | null require && null exclude -> tasks
             | otherwise -> tagHeader require exclude tasks
-        NoTags -> noTagHeader tasks
+        TagsAbsent -> noTagHeader tasks
   where
     noTagHeader = withHeader "Items without tags: "