diff --git a/fixme-new/lib/Fixme/Run.hs b/fixme-new/lib/Fixme/Run.hs index df11dc28..9fe6fbe9 100644 --- a/fixme-new/lib/Fixme/Run.hs +++ b/fixme-new/lib/Fixme/Run.hs @@ -330,13 +330,13 @@ runTop forms = do entry $ bindMatch "report" $ nil_ $ lift . \case ( SymbolVal "template" : StringLike t : p ) -> do - runReport (Just t) p + report (Just t) p ( SymbolVal "--template" : StringLike t : p ) -> do - runReport (Just t) p + report (Just t) p p -> do - runReport Nothing p + report Nothing p entry $ bindMatch "fixme:key:show" $ nil_ \case [ FixmeHashLike w ] -> lift $ void $ runMaybeT do diff --git a/fixme-new/lib/Fixme/Run/Internal.hs b/fixme-new/lib/Fixme/Run/Internal.hs index f533a6dc..91d5f00f 100644 --- a/fixme-new/lib/Fixme/Run/Internal.hs +++ b/fixme-new/lib/Fixme/Run/Internal.hs @@ -195,11 +195,42 @@ scanFiles = do pure True -runReport :: (FixmePerks m, HasPredicate q) => Maybe FilePath -> q -> FixmeM m () -runReport tpl q = do - debug $ "runReport" <+> pretty tpl + -- 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 + + + +report :: (FixmePerks m, HasPredicate q) => Maybe FilePath -> q -> FixmeM m () +report t q = do + + tpl <- asks fixmeEnvTemplates >>= readTVarIO + <&> HM.lookup (maybe "default" fromString t) + fxs <- listFixme q - for_ fxs $ \fme -> do - liftIO $ print $ pretty fme + case tpl of + Nothing -> + liftIO $ LBS.putStr $ Aeson.encodePretty (fmap fixmeAttr fxs) + + Just (Simple (SimpleTemplate simple)) -> do + for_ fxs $ \(Fixme{..}) -> do + let subst = [ (mkId k, mkStr @C v) | (k,v) <- HM.toList fixmeAttr ] + let what = render (SimpleTemplate (inject subst simple)) + & fromRight "render error" + + liftIO $ hPutDoc stdout what