diff --git a/.fixme-new/config b/.fixme-new/config index 0b5ee2e1..1c01431e 100644 --- a/.fixme-new/config +++ b/.fixme-new/config @@ -48,7 +48,12 @@ fixme-comments ";" "--" (define-template short (simple - ($fixme-key) (nl) + (trim 10 $fixme-key) " " + (align 6 $fixme-tag) " " + (align 8 ("[" $workflow "]")) " " + (align 12 $assigned) " " + (trim 50 ($fixme-title)) + (nl) ) ) diff --git a/fixme-new/lib/Fixme/Run.hs b/fixme-new/lib/Fixme/Run.hs index 2a395234..c32e990b 100644 --- a/fixme-new/lib/Fixme/Run.hs +++ b/fixme-new/lib/Fixme/Run.hs @@ -455,9 +455,12 @@ runLogActions :: FixmePerks m => FixmeM m () runLogActions = do debug $ yellow "runLogActions" actions <- asks fixmeEnvReadLogActions >>= readTVarIO + for_ actions $ \(ReadLogAction a) -> do liftIO (a (List noContext [])) + updateIndexes + startGitCatFile :: (FixmePerks m, MonadReader FixmeEnv m) => m (Process Handle Handle ()) startGitCatFile = do gd <- fixmeGetGitDirCLIOpt @@ -568,14 +571,6 @@ help :: FixmePerks m => m () help = do notice "this is help message" --- FIXME: tied-context-type -inject :: forall c a . (Data c, Data (Context c), Data a) => [(Id,Syntax c)] -> a -> a --- inject ::(Data C, Data (Context C), Data a) => [(Id,Syntax C)] -> a -> a -inject repl target = - flip transformBi target $ \case - w@(SymbolVal x) -> fromMaybe w (Map.lookup x rmap) - other -> other - where rmap = Map.fromList repl splitForms :: [String] -> [[String]] splitForms s0 = runIdentity $ S.toList_ (go mempty s0) diff --git a/fixme-new/lib/Fixme/State.hs b/fixme-new/lib/Fixme/State.hs index e58bd78f..8ab16a27 100644 --- a/fixme-new/lib/Fixme/State.hs +++ b/fixme-new/lib/Fixme/State.hs @@ -12,6 +12,7 @@ module Fixme.State , selectCommit , newCommit , cleanupDatabase + , updateIndexes , HasPredicate(..) ) where @@ -172,7 +173,7 @@ createTables = do join fixme f on a.fixme = f.id where a.name = 'fixme-key' - and not exists (select null from fixmedeleted d where a.fixme = id limit 1) + and not exists (select null from fixmedeleted d where d.id = f.id) ), rn AS ( select @@ -184,10 +185,21 @@ createTables = do fixme f join a1 a on f.id = a.fixme and a.name = 'fixme-key' ) - select id as fixme, fixmekey from rn + select id as fixme, fixmekey, ts from rn where rn = 1 |] + + ddl [qc| + create table if not exists fixmeactual + ( fixme text not null + , primary key (fixme) + ) + |] + +-- .fixme-new/state.db +-- and not exists (select null from fixmedeleted d where a.fixme = id limit 1) + insertCommit :: FixmePerks m => GitHash -> DBPipeM m () insertCommit gh = do insert [qc| @@ -372,15 +384,12 @@ selectFixmeThin a = withState do let sql = [qc| -with actual as ( - select x.fixme, f.ts from fixmeactualview x join fixme f on x.fixme = f.id - ) - select cast(json_set(json_group_object(a.name,a.value), '$."fixme-hash"', f.fixme) as blob) from - fixmeattrview a join actual f on f.fixme = a.fixme + fixmeattrview a join fixmeactual f on f.fixme = a.fixme + join fixme f0 on f0.id = f.fixme where @@ -389,7 +398,7 @@ where ) group by a.fixme -order by f.ts nulls first +order by f0.ts nulls first |] @@ -412,6 +421,7 @@ cleanupDatabase = do update_ [qc|delete from fixmecommit|] update_ [qc|delete from fixmedeleted|] update_ [qc|delete from fixmerel|] + update_ [qc|delete from fixmeactual|] deleteFixme :: (FixmePerks m,MonadReader FixmeEnv m) => Text -> m () @@ -423,3 +433,12 @@ deleteFixme hash = withState do |] (Only hash) +updateIndexes :: (FixmePerks m, MonadReader FixmeEnv m) => m () +updateIndexes = withState $ transactional do + update_ [qc|delete from fixmeactual|] + update_ [qc| + insert into fixmeactual + select distinct fixme from fixmeactualview + |] + + diff --git a/fixme-new/lib/Fixme/Types.hs b/fixme-new/lib/Fixme/Types.hs index 7ce33a35..13eacb05 100644 --- a/fixme-new/lib/Fixme/Types.hs +++ b/fixme-new/lib/Fixme/Types.hs @@ -4,7 +4,7 @@ module Fixme.Types ( module Fixme.Types ) where -import Fixme.Prelude +import Fixme.Prelude hiding (align) import DBPipe.SQLite import HBS2.Git.Local @@ -21,6 +21,9 @@ import Data.Word (Word64,Word32) import Data.Maybe import Data.Coerce import Data.Text qualified as Text +import Data.List qualified as List +import Data.Either +import Data.Map qualified as Map import System.FilePath import Text.InterpolatedString.Perl6 (qc) import Lens.Micro.Platform @@ -290,20 +293,49 @@ commentKey fp = "" -> takeFileName fp xs -> xs +inject :: forall c a . (IsContext c, Data c, Data (Context c), Data a) => [(Id,Syntax c)] -> a -> a +inject repl target = + flip transformBi target $ \case + (SymbolVal x) | issubst x -> fromMaybe mt (Map.lookup x rmap) + other -> other + where + mt = Literal (noContext @c) (LitStr "") + rmap = Map.fromList repl + issubst (Id x) = Text.isPrefixOf "$" x + pattern NL :: forall {c}. Syntax c pattern NL <- ListVal [SymbolVal "nl"] instance FixmeRenderTemplate SimpleTemplate where - render (SimpleTemplate syn) = - Right $ Text.concat $ + render (SimpleTemplate syn) = Right $ Text.concat $ flip fix (mempty,syn) $ \next -> \case (acc, NL : rest) -> next (acc <> nl, rest) (acc, ListVal [StringLike w] : rest) -> next (acc <> txt w, rest) (acc, StringLike w : rest) -> next (acc <> txt w, rest) - (acc, e : rest) -> next (acc <> p e, rest) + (acc, ListVal [SymbolVal "trim", LitIntVal n, e] : rest) -> next (acc <> trim n (deep [e]), rest) + (acc, ListVal [SymbolVal "align", LitIntVal n, e] : rest) -> next (acc <> align n (deep [e]), rest) + (acc, ListVal es : rest) -> next (acc <> deep es, rest) + (acc, e : rest) -> next (acc <> p e, rest) (acc, []) -> acc where + + align n0 s0 | n > 0 = [Text.justifyLeft n ' ' s] + | otherwise = [Text.justifyRight (abs n) ' ' s] + + where + n = fromIntegral n0 + s = mconcat s0 + + trim n0 s0 | n >= 0 = [ Text.take n s ] + | otherwise = [ Text.takeEnd (abs n) s ] + where + n = fromIntegral n0 + s = mconcat s0 + + deep :: forall c . (IsContext c, Data (Context c), Data c) => [Syntax c] -> [Text] + deep sy = either mempty List.singleton (render (SimpleTemplate sy)) + nl = [ "\n" ] txt s = [fromString s] p e = [Text.pack (show $ pretty e)]