wip

.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)
   )
 )
 

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)

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
+    |]
+
+

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) =
+  render (SimpleTemplate syn) = Right $ Text.concat $
-    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, 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)]