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
|
||||
db <- asks fixmeEnvDb
|
||||
atomically do
|
||||
writeTVar db Nothing
|
||||
writeTVar p g
|
||||
writeTVar db Nothing
|
||||
|
||||
evolve
|
||||
|
||||
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
|
||||
evolve
|
||||
|
||||
ListVal [SymbolVal "builtin:list-commits"] -> do
|
||||
co <- listCommits
|
||||
liftIO $ print $ vcat (fmap (pretty . view _1) co)
|
||||
|
||||
ListVal [SymbolVal "builtin:cleanup-state"] -> do
|
||||
cleanupDatabase
|
||||
|
||||
|
|
|
@ -80,6 +80,8 @@ listCommits = do
|
|||
|
||||
let cmd = [qc|git {gd} log --all --format="%H '%cn' '%ce' %ct" {days}|]
|
||||
|
||||
debug $ yellow "listCommits" <+> pretty cmd
|
||||
|
||||
gitRunCommand cmd
|
||||
<&> fromRight mempty
|
||||
<&> LBS8.lines
|
||||
|
|
|
@ -108,6 +108,7 @@ withState what = do
|
|||
case newDb of
|
||||
Left e -> pure (Left e)
|
||||
Right db -> do
|
||||
debug "set-new-db"
|
||||
atomically $ writeTVar t (Just db)
|
||||
pure $ Right db
|
||||
|
||||
|
|
|
@ -295,7 +295,7 @@ fixmeGetGitDirCLIOpt :: (FixmePerks m, MonadReader FixmeEnv m) => m String
|
|||
fixmeGetGitDirCLIOpt = do
|
||||
asks fixmeEnvGitDir
|
||||
>>= readTVarIO
|
||||
<&> fmap (\d -> [qc|--dir-dir {d}|])
|
||||
<&> fmap (\d -> [qc|--git-dir {d}|])
|
||||
<&> fromMaybe ""
|
||||
|
||||
newtype FixmeM m a = FixmeM { fromFixmeM :: ReaderT FixmeEnv m a }
|
||||
|
|
Loading…
Reference in New Issue