reflex-process (empty) → 0.1.0.0

raw patch · 7 files changed

+304/−0 lines, 7 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, data-default, process, reflex, reflex-process, reflex-vty, text, unix, vty

Files

ChangeLog.md +5/−0
LICENSE +30/−0
README.lhs +41/−0
README.md +41/−0
Setup.hs +2/−0
reflex-process.cabal +42/−0
src/Reflex/Process.hs +143/−0

+ ChangeLog.md view

@@ -0,0 +1,5 @@+# Revision history for reflex-process++## 0.1.0.0++* Initial release. The core of the interface is `Reflex.Process.createProcess`, which runs a `System.Process.CreateProcess` command, taking `Event`s of input and producing `Event`s of output.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2018, Obsidian Systems LLC++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Obsidian Systems LLC nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.lhs view

@@ -0,0 +1,41 @@+reflex-process+==============++Functional-reactive shell commands+----------------------------------++This library provides a functional-reactive interface for running shell commands from [reflex](https://github.com/reflex-frp/reflex).++Example+-------++The following example uses [reflex-vty](https://github.com/reflex-frp/reflex-vty) to run a terminal application that calls a shell command and displays the result:++```haskell+> {-# LANGUAGE OverloadedStrings #-}+> import Reflex+> import Reflex.Process+> import Reflex.Vty+>+> import Control.Monad ((<=<))+> import Data.Default (def)+> import qualified Data.Set as Set+> import qualified Data.Text.Encoding as T+> import qualified Graphics.Vty.Input as V+> import qualified System.Process as P+>+> cmd :: P.CreateProcess+> cmd = P.proc "ls" ["-a"]+>+> main :: IO ()+> main = mainWidget $ do+>   exit <- keyCombos $ Set.singleton (V.KChar 'c', [V.MCtrl])+>   p <- createProcess cmd def+>   stdout <- foldDyn (flip mappend) "" $ _process_stdout p+>   boxStatic def $ col $ do+>     fixed 3 $ boxStatic def $ text "reflex-process"+>     fixed 3 $ text "Press Ctrl-C to exit."+>     fixed 1 $ text "stdout:"+>     stretch $ text $ T.decodeUtf8 <$> current stdout+>   pure $ () <$ exit+```

+ README.md view

@@ -0,0 +1,41 @@+reflex-process+==============++Functional-reactive shell commands+----------------------------------++This library provides a functional-reactive interface for running shell commands from [reflex](https://github.com/reflex-frp/reflex).++Example+-------++The following example uses [reflex-vty](https://github.com/reflex-frp/reflex-vty) to run a terminal application that calls a shell command and displays the result:++```haskell+> {-# LANGUAGE OverloadedStrings #-}+> import Reflex+> import Reflex.Process+> import Reflex.Vty+>+> import Control.Monad ((<=<))+> import Data.Default (def)+> import qualified Data.Set as Set+> import qualified Data.Text.Encoding as T+> import qualified Graphics.Vty.Input as V+> import qualified System.Process as P+>+> cmd :: P.CreateProcess+> cmd = P.proc "ls" ["-a"]+>+> main :: IO ()+> main = mainWidget $ do+>   exit <- keyCombos $ Set.singleton (V.KChar 'c', [V.MCtrl])+>   p <- createProcess cmd def+>   stdout <- foldDyn (flip mappend) "" $ _process_stdout p+>   boxStatic def $ col $ do+>     fixed 3 $ boxStatic def $ text "reflex-process"+>     fixed 3 $ text "Press Ctrl-C to exit."+>     fixed 1 $ text "stdout:"+>     stretch $ text $ T.decodeUtf8 <$> current stdout+>   pure $ () <$ exit+```

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ reflex-process.cabal view

@@ -0,0 +1,42 @@+cabal-version: >=1.10+name: reflex-process+version: 0.1.0.0+synopsis: reflex-frp interface for running shell commands+description: Run shell commands from within reflex applications and interact with them over a functional-reactive interface+bug-reports: https://github.com/reflex-frp/reflex-process/issues+license: BSD3+license-file: LICENSE+author: Obsidian Systems LLC+maintainer: maintainer@obsidian.systems+copyright: 2020 Obsidian Systems LLC+category: System, FRP+build-type: Simple+extra-source-files: ChangeLog.md+                    README.md+tested-with: GHC ==8.6.5++library+  exposed-modules: Reflex.Process+  build-depends: base >=4.12 && <4.14+               , bytestring >=0.10 && < 0.11+               , data-default >= 0.7.1 && < 0.8+               , process >= 1.6.4 && < 1.7+               , reflex >= 0.6.2.4 && < 0.7+               , unix >= 2.7 && < 2.8+  hs-source-dirs: src+  default-language: Haskell2010+  ghc-options: -Wall++executable readme+  main-is: README.lhs+  ghc-options: -threaded -optL -q+  build-depends: base+               , containers >= 0.5 && < 0.7+               , data-default+               , process+               , reflex+               , reflex-process+               , reflex-vty >= 0.1.2.1 && < 0.1.3+               , text >= 1.2.3 && < 1.3+               , vty >= 5.21 && < 5.26+  default-language: Haskell2010

+ src/Reflex/Process.hs view

@@ -0,0 +1,143 @@+{-|+Module: Reflex.Process+Description: Run interactive shell commands in reflex+-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+module Reflex.Process+  ( createProcess+  , createRedirectedProcess+  , Process(..)+  , ProcessConfig(..)+  ) where++import Control.Concurrent (forkIO, killThread)+import Control.Exception (mask_)+import Control.Monad (void, when)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as Char8+import Data.Default+import qualified GHC.IO.Handle as H+import GHC.IO.Handle (Handle)+import System.Exit (ExitCode)+import qualified System.Posix.Signals as P+import qualified System.Process as P+import System.Process hiding (createProcess)++import Reflex++-- | The inputs to a process+data ProcessConfig t = ProcessConfig+  { _processConfig_stdin :: Event t ByteString+  -- ^ "stdin" input to be fed to the process+  , _processConfig_signal :: Event t P.Signal+  -- ^ Signals to send to the process+  }++instance Reflex t => Default (ProcessConfig t) where+  def = ProcessConfig never never++-- | The output of a process+data Process t = Process+  { _process_handle :: P.ProcessHandle+  , _process_stdout :: Event t ByteString+  -- ^ Fires whenever there's some new stdout output. Depending on the buffering strategy of the implementation, this could be anything from whole lines to individual characters.+  , _process_stderr :: Event t ByteString+  -- ^ Fires whenever there's some new stderr output. See note on '_process_stdout'.+  , _process_exit :: Event t ExitCode+  , _process_signal :: Event t P.Signal+  -- ^ Fires when a signal has actually been sent to the process (via '_processConfig_signal').+  }++-- | Runs a process and uses the given input and output handler functions+-- to interact with the process. Used to implement 'createProcess'.+--+-- NB: The 'std_in', 'std_out', and 'std_err' parameters of the+-- provided 'CreateProcess' are replaced with new pipes and all output is redirected+-- to those pipes.+createRedirectedProcess+  :: (MonadIO m, TriggerEvent t m, PerformEvent t m, MonadIO (Performable m))+  => (Handle -> IO (ByteString -> IO ()))+  -- ^ Builder for the stdin handler+  -> (Handle -> (ByteString -> IO ()) -> IO (IO ()))+  -- ^ Builder for the stdout and stderr handlers+  -> CreateProcess+  -> ProcessConfig t+  -> m (Process t)+createRedirectedProcess mkWriteInput mkReadOutput p (ProcessConfig input signal) = do+  let redirectedProc = p+        { std_in = CreatePipe+        , std_out = CreatePipe+        , std_err = CreatePipe+        }+  po@(mi, mout, merr, ph) <- liftIO $ P.createProcess redirectedProc +  case (mi, mout, merr) of+    (Just hIn, Just hOut, Just hErr) -> do+      writeInput <- liftIO $ mkWriteInput hIn+      performEvent_ $ liftIO . writeInput <$> input+      sigOut <- performEvent $ ffor signal $ \sig -> liftIO $ do+        mpid <- P.getPid ph+        case mpid of+          Nothing -> return Nothing+          Just pid -> do+            P.signalProcess sig pid >> return (Just sig)+      let output h = do+            (e, trigger) <- newTriggerEvent+            reader <- liftIO $ mkReadOutput h trigger+            t <- liftIO $ forkIO reader+            return (e, t)+      (out, outThread) <- output hOut+      (err, errThread) <- output hErr+      (ecOut, ecTrigger) <- newTriggerEvent+      void $ liftIO $ forkIO $ waitForProcess ph >>= \ec -> mask_ $ do+        ecTrigger ec+        P.cleanupProcess po+        killThread outThread+        killThread errThread +      return $ Process+        { _process_exit = ecOut+        , _process_stdout = out+        , _process_stderr = err+        , _process_signal = fmapMaybe id sigOut+        , _process_handle = ph+        }+    _ -> error "Reflex.Vty.Process.createRedirectedProcess: Created pipes were not returned by System.Process.createProcess."++-- | Run a shell process, feeding it input using an 'Event' and exposing its output+-- 'Event's representing the process exit code, stdout and stderr.+--+-- The input 'Handle' is not buffered and the output 'Handle's are line-buffered.+--+-- NB: The 'std_in', 'std_out', and 'std_err' parameters of the+-- provided 'CreateProcess' are replaced with new pipes and all output is redirected+-- to those pipes.+createProcess+  :: (MonadIO m, TriggerEvent t m, PerformEvent t m, MonadIO (Performable m))+  => CreateProcess+  -> ProcessConfig t+  -> m (Process t)+createProcess = createRedirectedProcess input output+  where+    input h = do+      H.hSetBuffering h H.NoBuffering+      let go b = do+            open <- H.hIsOpen h+            when open $ do+              writable <- H.hIsWritable h+              when writable $ Char8.hPutStrLn h b+      return go+    output h trigger = do+      H.hSetBuffering h H.LineBuffering+      let go = do+            open <- H.hIsOpen h+            readable <- H.hIsReadable h+            when (open && readable) $ do+              out <- BS.hGetSome h 32768+              if BS.null out+                then return ()+                else do+                  void $ trigger out+                  go+      return go