diff --git a/fixme-new/lib/Fixme/Run.hs b/fixme-new/lib/Fixme/Run.hs index b0f9965b..15130607 100644 --- a/fixme-new/lib/Fixme/Run.hs +++ b/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 diff --git a/fixme-new/lib/Fixme/Scan.hs b/fixme-new/lib/Fixme/Scan.hs index 90faaf1a..28a54c9e 100644 --- a/fixme-new/lib/Fixme/Scan.hs +++ b/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 diff --git a/fixme-new/lib/Fixme/State.hs b/fixme-new/lib/Fixme/State.hs index 9606881f..823b9b18 100644 --- a/fixme-new/lib/Fixme/State.hs +++ b/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 + + diff --git a/fixme-new/lib/Fixme/Types.hs b/fixme-new/lib/Fixme/Types.hs index 68113718..7eb77969 100644 --- a/fixme-new/lib/Fixme/Types.hs +++ b/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