wip

fixme-new/lib/Fixme/Run.hs

@@ -414,13 +414,17 @@ startGitCatFile = do
   let config = setStdin createPipe $ setStdout createPipe $ setStderr closed $ shell cmd
   startProcess config
 
-
 readFixmeStdin :: FixmePerks m => FixmeM m ()
 readFixmeStdin = do
   what <- liftIO LBS8.getContents
   fixmies <- Scan.scanBlob Nothing what
   liftIO $ print $ vcat (fmap pretty fixmies)
 
+list :: FixmePerks m => FixmeM m ()
+list = do
+  fixmies <- selectFixme ()
+  pure ()
+
 printEnv :: FixmePerks m => FixmeM m ()
 printEnv = do
   g <- asks fixmeEnvGitDir

fixme-new/lib/Fixme/Scan.hs

@@ -163,9 +163,8 @@ scanBlob fpath lbs = do
                 Nothing
                 mempty
                 mempty
-                Nothing
 
-      _ -> Fixme mempty mempty Nothing Nothing Nothing mempty mempty Nothing
+      _ -> Fixme mempty mempty Nothing Nothing Nothing mempty mempty
 
     emitFixmeStart lno lvl tagbs restbs = do
       let tag  = decodeUtf8With ignore  (LBS8.toStrict tagbs) & Text.strip

fixme-new/lib/Fixme/State.hs

@@ -3,6 +3,7 @@ module Fixme.State
   ( evolve
   , withState
   , insertFixme
+  , selectFixme
   , insertCommit
   , selectCommit
   , newCommit
@@ -13,7 +14,7 @@ import Fixme.Types
 import Fixme.Config
 
 import HBS2.System.Dir
-
+import Data.Config.Suckless
 import DBPipe.SQLite
 
 import Data.HashMap.Strict qualified as HM
@@ -60,11 +61,31 @@ createTables = do
   ddl [qc|
         create table if not exists fixme
           ( id    text not null
+          , ts    integer
           , fixme blob not null
           , primary key (id)
           )
       |]
 
+  ddl [qc|
+        create table if not exists fixmedeleted
+          ( id      text not null
+          , ts      integer not null
+          , deleted bool not null
+          , primary key (id,ts)
+          )
+      |]
+
+  ddl [qc|
+        create table if not exists fixmerel
+          ( origin  text not null
+          , related text not null
+          , ts      integer not null
+          , reason  text not null
+          , primary key (origin,related,ts)
+          )
+      |]
+
   ddl [qc|
         create table if not exists fixmeattr
           ( fixme   text not null
@@ -115,9 +136,9 @@ insertFixme :: FixmePerks m => Fixme -> DBPipeM m ()
 insertFixme fx@Fixme{..} = do
   let fixme = serialise fx
   let fxId = hashObject @HbSync fixme & HashRef
-  insert [qc|insert into fixme (id, fixme) values (?,?)
+  insert [qc|insert into fixme (id, ts, fixme) values (?,?,?)
              on conflict(id) do nothing
-            |] (fxId, fixme)
+            |] (fxId, fixmeTs, fixme)
 
   for_ (HM.toList fixmeAttr) $ \(n,v) -> do
     insert [qc|
@@ -139,3 +160,16 @@ insertFixme fx@Fixme{..} = do
               |] (fxId, fixmeTs, "fixme-title", fixmeTitle)
 
 
+data SelectPredicate = All
+
+class HasPredicate a where
+  predicate :: a -> SelectPredicate
+
+instance HasPredicate () where
+  predicate = const All
+
+selectFixme :: (FixmePerks m, HasPredicate a) => a -> FixmeM m [Fixme]
+selectFixme _ = do
+  pure mempty
+
+

fixme-new/lib/Fixme/Types.hs

@@ -17,17 +17,6 @@ import System.FilePath
 import Text.InterpolatedString.Perl6 (qc)
 
 
-data GitLocation =
-  GitLocation
-  { gitLocationHash   :: GitHash
-  , gitLocationLine   :: Integer
-  }
-  deriving stock (Eq,Ord,Show,Data,Generic)
-
-data FixmeSource =
-  FixmeSourceGit GitLocation
-  deriving stock (Show,Data,Generic)
-
 newtype FixmeTag = FixmeTag { fromFixmeTag :: Text }
                    deriving newtype (Eq,Ord,Show,IsString,Hashable,Semigroup,Monoid,ToField,FromField)
                    deriving stock (Data,Generic)
@@ -69,7 +58,6 @@ data Fixme =
   , fixmeEnd       :: Maybe FixmeOffset
   , fixmePlain     :: [FixmePlainLine]
   , fixmeAttr      :: HashMap FixmeAttrName FixmeAttrVal
-  , fixmeSource    :: Maybe FixmeSource
   }
   deriving stock (Show,Data,Generic)
 
@@ -128,9 +116,6 @@ newtype FixmeM m a = FixmeM { fromFixmeM :: ReaderT FixmeEnv m a }
 withFixmeEnv :: FixmePerks m => FixmeEnv -> FixmeM m a -> m a
 withFixmeEnv env what = runReaderT ( fromFixmeM what) env
 
-
-instance Serialise GitLocation
-instance Serialise FixmeSource
 instance Serialise FixmeTag
 instance Serialise FixmeTitle
 instance Serialise FixmePlainLine