mirror of https://github.com/voidlizard/hbs2
fix
This commit is contained in:
parent
dc833177c8
commit
fa429faa19
|
@ -437,8 +437,9 @@ runForms ss = for_ ss $ \s -> do
|
||||||
p <- asks fixmeEnvDbPath
|
p <- asks fixmeEnvDbPath
|
||||||
db <- asks fixmeEnvDb
|
db <- asks fixmeEnvDb
|
||||||
atomically do
|
atomically do
|
||||||
writeTVar db Nothing
|
|
||||||
writeTVar p g
|
writeTVar p g
|
||||||
|
writeTVar db Nothing
|
||||||
|
|
||||||
evolve
|
evolve
|
||||||
|
|
||||||
ListVal [SymbolVal "fixme-def-context", LitIntVal a, LitIntVal b] -> do
|
ListVal [SymbolVal "fixme-def-context", LitIntVal a, LitIntVal b] -> do
|
||||||
|
@ -642,6 +643,10 @@ runForms ss = for_ ss $ \s -> do
|
||||||
ListVal [SymbolVal "builtin:evolve"] -> do
|
ListVal [SymbolVal "builtin:evolve"] -> do
|
||||||
evolve
|
evolve
|
||||||
|
|
||||||
|
ListVal [SymbolVal "builtin:list-commits"] -> do
|
||||||
|
co <- listCommits
|
||||||
|
liftIO $ print $ vcat (fmap (pretty . view _1) co)
|
||||||
|
|
||||||
ListVal [SymbolVal "builtin:cleanup-state"] -> do
|
ListVal [SymbolVal "builtin:cleanup-state"] -> do
|
||||||
cleanupDatabase
|
cleanupDatabase
|
||||||
|
|
||||||
|
|
|
@ -80,6 +80,8 @@ listCommits = do
|
||||||
|
|
||||||
let cmd = [qc|git {gd} log --all --format="%H '%cn' '%ce' %ct" {days}|]
|
let cmd = [qc|git {gd} log --all --format="%H '%cn' '%ce' %ct" {days}|]
|
||||||
|
|
||||||
|
debug $ yellow "listCommits" <+> pretty cmd
|
||||||
|
|
||||||
gitRunCommand cmd
|
gitRunCommand cmd
|
||||||
<&> fromRight mempty
|
<&> fromRight mempty
|
||||||
<&> LBS8.lines
|
<&> LBS8.lines
|
||||||
|
|
|
@ -108,6 +108,7 @@ withState what = do
|
||||||
case newDb of
|
case newDb of
|
||||||
Left e -> pure (Left e)
|
Left e -> pure (Left e)
|
||||||
Right db -> do
|
Right db -> do
|
||||||
|
debug "set-new-db"
|
||||||
atomically $ writeTVar t (Just db)
|
atomically $ writeTVar t (Just db)
|
||||||
pure $ Right db
|
pure $ Right db
|
||||||
|
|
||||||
|
|
|
@ -295,7 +295,7 @@ fixmeGetGitDirCLIOpt :: (FixmePerks m, MonadReader FixmeEnv m) => m String
|
||||||
fixmeGetGitDirCLIOpt = do
|
fixmeGetGitDirCLIOpt = do
|
||||||
asks fixmeEnvGitDir
|
asks fixmeEnvGitDir
|
||||||
>>= readTVarIO
|
>>= readTVarIO
|
||||||
<&> fmap (\d -> [qc|--dir-dir {d}|])
|
<&> fmap (\d -> [qc|--git-dir {d}|])
|
||||||
<&> fromMaybe ""
|
<&> fromMaybe ""
|
||||||
|
|
||||||
newtype FixmeM m a = FixmeM { fromFixmeM :: ReaderT FixmeEnv m a }
|
newtype FixmeM m a = FixmeM { fromFixmeM :: ReaderT FixmeEnv m a }
|
||||||
|
|
Loading…
Reference in New Issue