wip

fixme-new/lib/Fixme/Run.hs

@@ -749,25 +749,42 @@ runForms ss = for_  ss $ \s -> do
       stage <- gitListStage
 
       blobs  <- for stage $ \case
-          Left (fn, _) -> pure (fn, liftIO $ LBS8.readFile fn)
-          Right (fn,hash) -> pure (fn, liftIO (withFixmeEnv env $ gitCatBlob hash))
+          Left (fn, hash) -> pure (fn, hash, liftIO $ LBS8.readFile fn)
+          Right (fn,hash) -> pure (fn, hash, liftIO (withFixmeEnv env $ gitCatBlob hash))
 
-      let fns = fmap fst blobs
+      let fns = fmap (view _1) blobs
 
       -- TODO: extract-metadata-from-git-blame
       --   subj
 
-      for_ blobs $ \(fn, readBlob) -> do
+      for_ blobs $ \(fn, bhash, readBlob) -> do
+        nno <- newTVarIO (mempty :: HashMap FixmeTitle Integer)
         lbs <- readBlob
         fxs <- scanBlob (Just fn) lbs
                  >>= \e -> do
                   for e $ \fx0 -> do
+                    n <- atomically $ stateTVar nno (\m -> do
+                            let what = HM.lookup (fixmeTitle fx0) m & fromMaybe 0
+                            (what, HM.insert (fixmeTitle fx0) (succ what) m)
+                         )
                     let ls = fixmePlain fx0
                     meta <- getMetaDataFromGitBlame fn fx0
-                    -- let fxm = fromMaybe mempty $ HM.lookup fn meta
+                    let tit = fixmeTitle fx0 & coerce @_ @Text
+
+                    -- FIXME: fix-this-copypaste
+                    let ks  = [qc|{fn}#{tit}:{n}|] :: Text
+                    let ksh = hashObject @HbSync (serialise ks) & pretty & show & Text.pack & FixmeAttrVal
+                    let kh = HM.singleton "fixme-key" ksh
+                    let kv = HM.singleton "fixme-key-string" (FixmeAttrVal ks) <> kh
+
                     pure $ fixmeDerivedFields (fx0 <> mkFixmeFileName fn <> meta)
                              & set  (field @"fixmePlain") ls
 
+                             & over (field @"fixmeAttr")
+                                    (HM.insert "blob" (fromString $ show $ pretty bhash))
+                             & over (field @"fixmeAttr")
+                                    (mappend (kh<>kv))
+
         for_ fxs $ \fx -> do
           liftIO $ print (pretty fx)
 

fixme-new/lib/Fixme/Types.hs

@@ -7,7 +7,7 @@ module Fixme.Types
 import Fixme.Prelude hiding (align)
 import HBS2.Base58
 
-import DBPipe.SQLite
+import DBPipe.SQLite hiding (field)
 import HBS2.Git.Local
 
 import Data.Config.Suckless
@@ -30,6 +30,8 @@ import Data.List qualified as List
 import Data.Map qualified as Map
 import System.FilePath
 import Text.InterpolatedString.Perl6 (qc)
+import Data.Generics.Product.Fields (field)
+import Lens.Micro.Platform
 
 -- FIXME: move-to-suckless-conf
 deriving stock instance Ord (Syntax C)
@@ -134,7 +136,7 @@ newtype FixmeTag = FixmeTag { fromFixmeTag :: Text }
                    deriving stock (Data,Generic)
 
 newtype FixmeTitle = FixmeTitle { fromFixmeTitle :: Text }
-                     deriving newtype (Eq,Ord,Show,IsString,Semigroup,Monoid,ToField,FromField)
+                     deriving newtype (Eq,Ord,Show,IsString,Semigroup,Monoid,ToField,FromField,Hashable)
                      deriving stock (Data,Generic)
 
 newtype FixmePlainLine = FixmePlainLine { fromFixmeText :: Text }
@@ -611,7 +613,7 @@ fixmeAttrNonEmpty a b = case (coerce a :: Text, coerce b :: Text) of
   (_,_) -> b
 
 fixmeDerivedFields :: Fixme -> Fixme
-fixmeDerivedFields fx = fx <> fxCo <> tag <> fxLno
+fixmeDerivedFields fx = fx <> fxCo <> tag <> fxLno <> fxMisc
   where
     email = HM.lookup "commiter-email" (fixmeAttr fx)
               & maybe mempty (\x -> " <" <> x <> ">")
@@ -628,6 +630,10 @@ fixmeDerivedFields fx = fx <> fxCo <> tag <> fxLno
     fxCo =
       maybe mempty (\c -> mempty { fixmeAttr = HM.singleton "committer" c }) comitter
 
+    fxMisc =
+      fx & over (field @"fixmeAttr")
+                (HM.insert "fixme-title" (FixmeAttrVal (coerce (fixmeTitle fx))))
+
 mkFixmeFileName :: FilePath -> Fixme
 mkFixmeFileName fp =
   mempty { fixmeAttr = HM.singleton "file" (FixmeAttrVal (fromString fp)) }