bf6: forked and stuff for site generation

This commit is contained in:
voidlizard 2025-02-06 21:08:04 +03:00
parent 193ecc99ab
commit 0b2c0af8c1
2 changed files with 31 additions and 0 deletions

View File

@ -74,3 +74,4 @@ fixme-comments ";" "--"
refchan 3WtddmcE8zzgBAPR7Bu7mKMaVMTN423NNXSPUJp3Hx42 refchan 3WtddmcE8zzgBAPR7Bu7mKMaVMTN423NNXSPUJp3Hx42
source ./refchan.local source ./refchan.local

View File

@ -42,6 +42,7 @@ import Data.Map qualified as Map
import Data.Kind import Data.Kind
import Data.List (isPrefixOf) import Data.List (isPrefixOf)
import Data.List qualified as List import Data.List qualified as List
import Data.List ((\\))
import Data.Maybe import Data.Maybe
import Data.Either import Data.Either
import Data.String import Data.String
@ -64,6 +65,7 @@ import System.Directory qualified as Dir
import System.FilePath.Posix as P import System.FilePath.Posix as P
import Text.InterpolatedString.Perl6 (qc) import Text.InterpolatedString.Perl6 (qc)
import UnliftIO import UnliftIO
import Control.Monad.Trans.Cont
-- TODO: move-to-suckless-conf -- TODO: move-to-suckless-conf
@ -1760,6 +1762,26 @@ internalEntries = do
formattedTime = formatTime defaultTimeLocale fmt utcTime formattedTime = formatTime defaultTimeLocale fmt utcTime
pure $ mkStr formattedTime pure $ mkStr formattedTime
_ -> pure $ mkSym ""
entry $ bindMatch "forked" $ \case
[ e ] -> do
env <- ask
po <- pwd
oe <- liftIO $ getEnvironment
lift do
flip runContT pure do
a <- ContT $ withAsyncBound $ do
runEval env [e]
r <- wait a
cd po
restoreEnvironment oe
pure r
_ -> throwIO $ BadFormException @c nil _ -> throwIO $ BadFormException @c nil
@ -1900,3 +1922,11 @@ asSym = \case
other -> pretty other other -> pretty other
restoreEnvironment :: MonadIO m => [(String, String)] -> m ()
restoreEnvironment newEnv = liftIO do
currentEnv <- getEnvironment
let toRemove = map fst currentEnv \\ map fst newEnv
mapM_ unsetEnv toRemove
mapM_ (uncurry setEnv) newEnv