mirror of https://github.com/voidlizard/hbs2
99 lines
2.6 KiB
Haskell
99 lines
2.6 KiB
Haskell
{-# Language TypeOperators #-}
|
|
module Data.Config.Suckless.Almost.RPC where
|
|
|
|
import Data.Config.Suckless
|
|
|
|
import Control.Exception
|
|
import Control.Monad
|
|
import Control.Monad.IO.Class
|
|
import Data.ByteString.Lazy as LBS
|
|
import Data.ByteString.Lazy.Char8 as LBS8
|
|
import Data.Function
|
|
import Data.Text.Encoding.Error qualified as TE
|
|
import Data.Text.Encoding qualified as TE
|
|
import Data.Text qualified as T
|
|
import Data.Text (Text)
|
|
import Data.Typeable
|
|
import Prettyprinter
|
|
import System.Process.Typed
|
|
|
|
import System.IO
|
|
|
|
data CallProcException =
|
|
CallProcException ExitCode
|
|
deriving (Show,Typeable)
|
|
|
|
instance Exception CallProcException
|
|
|
|
-- FIXME: to-suckless-script
|
|
callProc :: forall m . MonadIO m
|
|
=> FilePath
|
|
-> [String]
|
|
-> [Syntax C]
|
|
-> m [Syntax C]
|
|
|
|
callProc name params syn = do
|
|
let input = fmap (LBS.fromStrict . TE.encodeUtf8 . T.pack . show . pretty) syn
|
|
& LBS8.unlines
|
|
& byteStringInput
|
|
|
|
-- let what = proc name params & setStderr closed & setStdin input
|
|
let what = proc name params & setStderr closed & setStdin input
|
|
(code, i, o) <- readProcess what
|
|
|
|
unless (code == ExitSuccess) do
|
|
liftIO $ hPrint stderr ( pretty $ LBS8.unpack o )
|
|
liftIO $ throwIO (CallProcException code)
|
|
|
|
let s = TE.decodeUtf8With TE.lenientDecode (LBS.toStrict i)
|
|
|
|
parseTop s & either (liftIO . throwIO) pure
|
|
|
|
|
|
-- FIXME: to-suckless-script
|
|
callProcRaw :: forall m . MonadIO m
|
|
=> FilePath
|
|
-> [String]
|
|
-> m Text
|
|
|
|
callProcRaw name params = do
|
|
-- let input = fmap (LBS.fromStrict . TE.encodeUtf8 . T.pack . show . pretty) syn
|
|
-- & LBS8.unlines
|
|
-- & byteStringInput
|
|
|
|
-- let what = proc name params & setStderr closed & setStdin input
|
|
let what = proc name params & setStderr closed & setStdin closed
|
|
(code, i, o) <- readProcess what
|
|
|
|
unless (code == ExitSuccess) do
|
|
liftIO $ hPrint stderr ( pretty $ LBS8.unpack o )
|
|
liftIO $ throwIO (CallProcException code)
|
|
|
|
let s = TE.decodeUtf8With TE.lenientDecode (LBS.toStrict i)
|
|
|
|
pure s
|
|
|
|
|
|
pipeProcText :: forall m . MonadIO m
|
|
=> FilePath
|
|
-> [String]
|
|
-> Text
|
|
-> m Text
|
|
|
|
pipeProcText name params input' = do
|
|
|
|
let input = LBS.fromStrict (TE.encodeUtf8 input')
|
|
& byteStringInput
|
|
|
|
|
|
let what = proc name params & setStderr closed & setStdin input
|
|
(code, i, o) <- readProcess what
|
|
|
|
unless (code == ExitSuccess) do
|
|
liftIO $ hPrint stderr ( pretty $ LBS8.unpack o )
|
|
liftIO $ throwIO (CallProcException code)
|
|
|
|
pure $ TE.decodeUtf8With TE.lenientDecode (LBS.toStrict i)
|
|
|
|
|