mirror of https://github.com/voidlizard/hbs2
wip, back to template definition
This commit is contained in:
parent
85b2f67c2e
commit
0443a07884
|
@ -28,3 +28,27 @@ fixme-file-comments "*.scm" ";"
|
||||||
|
|
||||||
fixme-comments ";" "--"
|
fixme-comments ";" "--"
|
||||||
|
|
||||||
|
(define-template short
|
||||||
|
(quot
|
||||||
|
(simple
|
||||||
|
(trim 10 $fixme-key) " "
|
||||||
|
|
||||||
|
(if (~ FIXME $fixme-tag)
|
||||||
|
(then (fgd red (align 6 $fixme-tag)) )
|
||||||
|
(else (if (~ TODO $fixme-tag)
|
||||||
|
(then (fgd green (align 6 $fixme-tag)))
|
||||||
|
(else (align 6 $fixme-tag)) ) )
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
(align 10 ("[" $workflow "]")) " "
|
||||||
|
(align 8 $type) " "
|
||||||
|
(align 12 $assigned) " "
|
||||||
|
(align 20 (trim 20 $committer-name)) " "
|
||||||
|
(trim 50 ($fixme-title)) " "
|
||||||
|
(nl))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(set-template default short)
|
||||||
|
|
||||||
|
|
|
@ -204,13 +204,14 @@ runTop forms = do
|
||||||
|
|
||||||
_ -> throwIO $ BadFormException @C nil
|
_ -> throwIO $ BadFormException @C nil
|
||||||
|
|
||||||
|
entry $ bindMatch "report" $ nil_ \case
|
||||||
|
[] -> lift $ list_ Nothing ()
|
||||||
|
|
||||||
-- ListVal (SymbolVal "list" : (Template n [])) -> do
|
(SymbolVal "--template" : StringLike name : query) -> do
|
||||||
-- debug $ "list" <+> pretty n
|
lift $ list_ (Just (fromString name)) query
|
||||||
-- list_ n ()
|
|
||||||
|
|
||||||
entry $ bindMatch "report" $ nil_ $ const $ do
|
query -> do
|
||||||
lift $ list_ Nothing ()
|
lift $ list_ mzero query
|
||||||
|
|
||||||
entry $ bindMatch "env:show" $ nil_ $ const $ do
|
entry $ bindMatch "env:show" $ nil_ $ const $ do
|
||||||
lift printEnv
|
lift printEnv
|
||||||
|
@ -257,6 +258,23 @@ runTop forms = do
|
||||||
entry $ bindMatch "init" $ nil_ $ const $ do
|
entry $ bindMatch "init" $ nil_ $ const $ do
|
||||||
lift init
|
lift init
|
||||||
|
|
||||||
|
entry $ bindMatch "set-template" $ nil_ \case
|
||||||
|
[SymbolVal who, SymbolVal w] -> do
|
||||||
|
templates <- lift $ asks fixmeEnvTemplates
|
||||||
|
t <- readTVarIO templates
|
||||||
|
for_ (HM.lookup w t) $ \tpl -> do
|
||||||
|
atomically $ modifyTVar templates (HM.insert who tpl)
|
||||||
|
|
||||||
|
_ -> throwIO $ BadFormException @C nil
|
||||||
|
|
||||||
|
entry $ bindMatch "define-template" $ nil_ $ \case
|
||||||
|
[SymbolVal who, IsSimpleTemplate body ] -> do
|
||||||
|
-- notice $ red "define-template" <+> pretty who <+> pretty what
|
||||||
|
t <- lift $ asks fixmeEnvTemplates
|
||||||
|
atomically $ modifyTVar t (HM.insert who (Simple (SimpleTemplate body)))
|
||||||
|
|
||||||
|
_ -> throwIO $ BadFormException @C nil
|
||||||
|
|
||||||
conf <- readConfig
|
conf <- readConfig
|
||||||
|
|
||||||
run dict (conf <> forms) >>= eatNil display
|
run dict (conf <> forms) >>= eatNil display
|
||||||
|
|
|
@ -1,3 +1,5 @@
|
||||||
|
{-# Language PatternSynonyms #-}
|
||||||
|
{-# Language ViewPatterns #-}
|
||||||
module Fixme.Run.Internal where
|
module Fixme.Run.Internal where
|
||||||
|
|
||||||
import Prelude hiding (init)
|
import Prelude hiding (init)
|
||||||
|
@ -48,6 +50,8 @@ import System.IO qualified as IO
|
||||||
|
|
||||||
import Streaming.Prelude qualified as S
|
import Streaming.Prelude qualified as S
|
||||||
|
|
||||||
|
pattern IsSimpleTemplate :: forall {c} . [Syntax c] -> Syntax c
|
||||||
|
pattern IsSimpleTemplate xs <- ListVal (SymbolVal "simple" : xs)
|
||||||
|
|
||||||
defaultTemplate :: HashMap Id FixmeTemplate
|
defaultTemplate :: HashMap Id FixmeTemplate
|
||||||
defaultTemplate = HM.fromList [ ("default", Simple (SimpleTemplate short)) ]
|
defaultTemplate = HM.fromList [ ("default", Simple (SimpleTemplate short)) ]
|
||||||
|
|
Loading…
Reference in New Issue