voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

wip

This commit is contained in:
voidlizard 2025-01-17 11:42:21 +03:00
parent a6f4a5a1fa
commit dc60abfd6b
1 changed files with 17 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
hbs2-git3/app/GitRemoteHelper.hs
View File

@ -12,6 +12,8 @@ import System.Posix.Signals
import System.IO qualified as IO import System.IO qualified as IO
import System.Exit qualified as Exit import System.Exit qualified as Exit
import System.Environment (getArgs) import System.Environment (getArgs)
import Text.InterpolatedString.Perl6 (qc)
import Data.Text qualified as Text
import Data.Config.Suckless.Script import Data.Config.Suckless.Script
@ -90,9 +92,24 @@ localDict = makeDict @C do
sendLine "" sendLine ""
entry $ bindMatch "r:push" $ nil_ $ splitPushArgs $ \pushFrom pushTo -> lift do
notice $ pretty pushFrom <+> pretty pushTo
sendLine [qc|ok {pretty pushTo}|]
entry $ bindMatch "r:" $ nil_ $ \syn -> lift do entry $ bindMatch "r:" $ nil_ $ \syn -> lift do
none none
where
splitPushArgs :: forall m . MonadIO m => (Maybe GitRef -> GitRef -> m ()) -> [Syntax C] -> m ()
splitPushArgs action = \case
[ StringLike params ] -> do
case Text.splitOn ":" (fromString params) of
[ b ] -> action Nothing (fromString (Text.unpack b))
[ a, b ] -> action (Just (fromString (Text.unpack a))) (fromString (Text.unpack b))
_ -> throwIO (BadFormException @C nil)
_ -> throwIO (BadFormException @C nil)
runTop :: (ParseSExp what, MonadUnliftIO m) => Dict C m -> what -> m () runTop :: (ParseSExp what, MonadUnliftIO m) => Dict C m -> what -> m ()
runTop dict s = parseTop s & either (const none) (void . run dict) runTop dict s = parseTop s & either (const none) (void . run dict)