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.Exit qualified as Exit
import System.Environment (getArgs)
import Text.InterpolatedString.Perl6 (qc)
import Data.Text qualified as Text
import Data.Config.Suckless.Script
@ -90,9 +92,24 @@ localDict = makeDict @C do
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
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 dict s = parseTop s & either (const none) (void . run dict)