Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- {-# LANGUAGE QuasiQuotes, StandaloneDeriving, DeriveDataTypeable #-}
- import Atomo.Environment
- import Atomo.Haskell
- import Data.Typeable
- import System.Exit
- import System.Process
- deriving instance Typeable ProcessHandle
- load :: VM ()
- load = do
- ([$p|Command|] =::) =<< eval [$e|Object clone|]
- [$p|Command run: (cmd: String)|] =: do
- cmd <- getString [$e|cmd|]
- ph <- liftIO (runCommand cmd)
- newCommand ph
- [$p|Command run-interactively: (cmd: String)|] =: do
- cmd <- getString [$e|cmd|]
- (sin, sout, serr, h) <- liftIO (runInteractiveCommand cmd)
- newInteractiveCommand (sin, sout, serr) h
- [$p|(c: Command) wait|] =:
- getPH [$e|c handle|]
- >>= liftIO . waitForProcess
- >>= return . toExit
- [$p|(c: Command) exit-status|] =:
- getPH [$e|c handle|]
- >>= liftIO . getProcessExitCode
- >>= return . maybe
- (particle "running")
- (\ec -> keyParticleN ["done"] [toExit ec])
- [$p|(c: Command) terminate|] =:
- getPH [$e|c handle|]
- >>= liftIO . terminateProcess
- >> return (particle "ok")
- where
- getPH e = eval e >>= fromHaskell "ProcessHandle"
- toExit ExitSuccess = particle "success"
- toExit (ExitFailure i) =
- keyParticleN ["failure"] [Integer (fromIntegral i)]
- newCommand h = do
- proc <- eval [$e|Command clone|]
- [$p|p|] =:: proc
- [$p|p handle|] =:: haskell h
- here "p"
- newInteractiveCommand (sin, sout, serr) h = do
- proc <- eval [$e|Command clone|]
- [$p|p|] =:: proc
- [$p|p handle|] =:: haskell h
- ([$p|p standard-input|] =::) =<< portObj sin
- ([$p|p standard-output|] =::) =<< portObj sout
- ([$p|p standard-error|] =::) =<< portObj serr
- here "p"
- portObj hdl = newScope $ do
- port <- eval [$e|Port clone|]
- [$p|p|] =:: port
- [$p|p handle|] =:: haskell hdl
- here "p"
Add Comment
Please, Sign In to add comment