This commit is contained in:
Dmitry Zuikov 2024-08-30 06:25:58 +03:00
parent ed82ed26a2
commit 85b2f67c2e
3 changed files with 40 additions and 14 deletions

View File

@ -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 ()

View File

@ -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

View File

@ -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 (?,?,?)