wip

fixme-new/lib/Fixme/Run.hs

@@ -327,6 +327,17 @@ runTop forms = do
           -- magic <- lift $ asks fixmeEnvScanMagic >>= readTVarIO
           -- liftIO $ print $ pretty magic
 
+
+       entry $ bindMatch "report" $ nil_ $ lift . \case
+        ( SymbolVal "template" : StringLike t : p )  -> do
+          runReport (Just t) p
+
+        ( SymbolVal "--template" : StringLike t : p )  -> do
+          runReport (Just t) p
+
+        p -> do
+          runReport Nothing p
+
        entry $ bindMatch "fixme:key:show" $ nil_ \case
         [ FixmeHashLike w ] -> lift $ void $ runMaybeT do
           key <- lift (selectFixmeKey w) >>= toMPlus
@@ -571,6 +582,11 @@ runTop forms = do
        entry $ bindMatch "log:trace:off" $ nil_ $ const do
           lift $ setLoggingOff @TRACE
 
+       entry $ bindMatch "log:debug:on" $ nil_ $ const do
+          lift $ setLogging @DEBUG $ toStderr . logPrefix ""
+
+       entry $ bindMatch "log:debug:off" $ nil_ $ const do
+          lift $ setLoggingOff @DEBUG
 
        entry $ bindMatch "debug:peer:check" $ nil_ $ const do
         peer <- lift $ getClientAPI @PeerAPI @UNIX

fixme-new/lib/Fixme/Run/Internal.hs

@@ -195,3 +195,11 @@ scanFiles = do
       pure True
 
 
+runReport :: (FixmePerks m, HasPredicate q) => Maybe FilePath -> q -> FixmeM m ()
+runReport tpl q = do
+  debug $ "runReport" <+> pretty tpl
+  fxs <- listFixme q
+  for_ fxs $ \fme -> do
+    liftIO $ print $ pretty fme
+
+

fixme-new/lib/Fixme/State.hs

@@ -4,6 +4,7 @@ module Fixme.State
   ( evolve
   , withState
   , cleanupDatabase
+  , listFixme
   , insertFixme
   , modifyFixme
   , insertScanned
@@ -196,16 +197,12 @@ genPredQ tbl what = go what
       All -> ("true", mempty)
 
       FixmeHashExactly x ->
-        ([qc|(s2.fixme = ?)|], [Bound x])
+        ([qc|(o.o = ?)|], [Bound x])
-
-      AttrLike "fixme-hash" val -> do
-        let binds = [Bound (val <> "%")]
-        ([qc|(s2.fixme like ?)|], binds)
 
       AttrLike name val -> do
         let x = val <> "%"
         let binds = [Bound x]
-        ([qc|(json_extract({tbl}, '$."{name}"') like ?)|], binds)
+        ([qc|(json_extract({tbl}.blob, '$."{name}"') like ?)|], binds)
 
       Not a -> do
         let (sql, bound) = go a
@@ -267,6 +264,34 @@ selectFixmeKey s = do
        <&> fmap fromOnly
        <&> headMay
 
+
+listFixme :: (FixmePerks m, MonadReader FixmeEnv m, HasPredicate q)
+          => q
+          -> m [Fixme]
+listFixme expr = do
+
+  let (w,bound) = genPredQ "s1" (predicate expr)
+  let end = case bound of
+              [] -> " or true" :: String
+              _  -> " or false"
+
+  let sql = [qc|
+    with s1 as (
+      select (cast (json_group_object(o.k, o.v) as blob)) as blob from object o
+      group by o.o
+    )
+    select blob from s1
+    where
+      {w}
+      {end}
+    |]
+
+  debug $ pretty sql
+
+  withState $ select @(Only LBS.ByteString) sql bound
+        <&> fmap (Aeson.decode @Fixme . fromOnly)
+        <&> catMaybes
+
 getFixme :: (FixmePerks m, MonadReader FixmeEnv m) => FixmeKey -> m (Maybe Fixme)
 getFixme key = do