diff --git a/fixme-new/lib/Fixme/Run.hs b/fixme-new/lib/Fixme/Run.hs index 75bfc5e2..18e11177 100644 --- a/fixme-new/lib/Fixme/Run.hs +++ b/fixme-new/lib/Fixme/Run.hs @@ -103,18 +103,6 @@ silence = do setLoggingOff @NOTICE -defaultTemplate :: HashMap Id FixmeTemplate -defaultTemplate = HM.fromList [ ("default", Simple (SimpleTemplate short)) ] - where - short = parseTop s & fromRight mempty - s = [qc| -(trim 10 $fixme-key) " " -(align 6 $fixme-tag) " " -(trim 50 ($fixme-title)) -(nl) - |] - - readConfig :: FixmePerks m => FixmeM m [Syntax C] readConfig = do @@ -216,6 +204,14 @@ runTop forms = do _ -> throwIO $ BadFormException @C nil + + -- ListVal (SymbolVal "list" : (Template n [])) -> do + -- debug $ "list" <+> pretty n + -- list_ n () + + entry $ bindMatch "report" $ nil_ $ const $ do + lift $ list_ Nothing () + entry $ bindMatch "env:show" $ nil_ $ const $ do lift printEnv @@ -243,7 +239,7 @@ runTop forms = do _ -> throwIO $ BadFormException @C nil - entry $ bindMatch "fixme:list" $ nil_ $ const do + entry $ bindMatch "fixme:list:poor" $ nil_ $ const do fme <- lift listFixmies pure () diff --git a/fixme-new/lib/Fixme/Run/Internal.hs b/fixme-new/lib/Fixme/Run/Internal.hs index 296d4bf3..fd4dba8c 100644 --- a/fixme-new/lib/Fixme/Run/Internal.hs +++ b/fixme-new/lib/Fixme/Run/Internal.hs @@ -49,6 +49,17 @@ import System.IO qualified as IO import Streaming.Prelude qualified as S +defaultTemplate :: HashMap Id FixmeTemplate +defaultTemplate = HM.fromList [ ("default", Simple (SimpleTemplate short)) ] + where + short = parseTop s & fromRight mempty + s = [qc| +(trim 10 $fixme-key) " " +(align 6 $fixme-tag) " " +(trim 50 ($fixme-title)) +(nl) + |] + init :: FixmePerks m => FixmeM m () init = do @@ -199,3 +210,23 @@ importFromLog fn = do compactStorageClose sto + +list_ :: (FixmePerks m, HasPredicate a) => Maybe Id -> a -> FixmeM m () +list_ tpl a = do + tpl <- asks fixmeEnvTemplates >>= readTVarIO + <&> HM.lookup (fromMaybe "default" tpl) + + fixmies <- selectFixmeThin a + + case tpl of + Nothing-> do + liftIO $ LBS.putStr $ Aeson.encodePretty fixmies + + Just (Simple (SimpleTemplate simple)) -> do + for_ fixmies $ \(FixmeThin attr) -> do + let subst = [ (mkId k, mkStr @C v) | (k,v) <- HM.toList attr ] + let what = render (SimpleTemplate (inject subst simple)) + & fromRight "render error" + + liftIO $ hPutDoc stdout what + diff --git a/fixme-new/lib/Fixme/State.hs b/fixme-new/lib/Fixme/State.hs index b88bb91d..a1e6a290 100644 --- a/fixme-new/lib/Fixme/State.hs +++ b/fixme-new/lib/Fixme/State.hs @@ -327,7 +327,6 @@ newCommit gh = isNothing <$> withState (selectObjectHash gh) insertFixme :: FixmePerks m => Fixme -> DBPipeM m () insertFixme fx@Fixme{..} = do - notice $ red "insertFixme!!!" let fixme = serialise fx let fxId = hashObject @HbSync fixme & HashRef insert [qc|insert into fixme (id, ts, fixme) values (?,?,?)