module GhcStdin (frontendPlugin) where
import GHC.Paths
#if MIN_VERSION_ghc(9,0,2)
import GHC.Plugins
#else
import GhcPlugins
#endif
import Control.Monad
import qualified Data.ByteString as B
import System.IO
import System.IO.Temp
import System.Process
import System.Exit
frontendPlugin :: FrontendPlugin
frontendPlugin :: FrontendPlugin
frontendPlugin = FrontendPlugin
defaultFrontendPlugin { frontend :: FrontendPluginAction
frontend = FrontendPluginAction
compileCodeFromStdin }
compileCodeFromStdin :: FrontendPluginAction
compileCodeFromStdin :: FrontendPluginAction
compileCodeFromStdin [String]
flags [(String, Maybe Phase)]
_ = IO () -> Ghc ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
forall a b. (a -> b) -> a -> b
$
String -> String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
String -> String -> (String -> m a) -> m a
withTempDirectory String
"." String
"ghc-stdin" ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
dir ->
String -> String -> (String -> Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> String -> (String -> Handle -> m a) -> m a
withTempFile String
dir String
"ghc-stdin.hs" ((String -> Handle -> IO ()) -> IO ())
-> (String -> Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
src Handle
hsrc -> do
ByteString
contents <- IO ByteString
B.getContents
Handle -> ByteString -> IO ()
B.hPutStr Handle
hsrc ByteString
contents IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
hsrc
(Maybe Handle
_, Maybe Handle
_, Maybe Handle
_, ProcessHandle
h) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a b. (a -> b) -> a -> b
$ String -> [String] -> CreateProcess
proc String
ghc ([String] -> CreateProcess) -> [String] -> CreateProcess
forall a b. (a -> b) -> a -> b
$ String
src String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
wordsOfHead [String]
flags
ExitCode
r <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
h
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ExitCode
r ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith ExitCode
r
where wordsOfHead :: [String] -> [String]
wordsOfHead [] = []
wordsOfHead (String
x : [String]
_) = String -> [String]
words String
x