module Kempe.Proc.Nasm ( writeO
                       ) where

import           Data.Functor              (void)
import qualified Data.Text.Lazy.IO         as TLIO
import           Prettyprinter             (Doc, layoutCompact)
import           Prettyprinter.Render.Text (renderLazy)
import           System.IO                 (hFlush)
import           System.IO.Temp            (withSystemTempFile)
import           System.Process            (CreateProcess (..), StdStream (Inherit), proc, readCreateProcess)

-- | Assemble using @nasm@, output in some file.
writeO :: Doc ann
       -> FilePath
       -> Bool -- ^ Debug symbols?
       -> IO ()
writeO :: Doc ann -> FilePath -> Bool -> IO ()
writeO Doc ann
p FilePath
fpO Bool
dbg = FilePath -> (FilePath -> Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> Handle -> m a) -> m a
withSystemTempFile FilePath
"kmp.S" ((FilePath -> Handle -> IO ()) -> IO ())
-> (FilePath -> Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
fp Handle
h -> do
    let txt :: Text
txt = SimpleDocStream Any -> Text
forall ann. SimpleDocStream ann -> Text
renderLazy (SimpleDocStream Any -> Text) -> SimpleDocStream Any -> Text
forall a b. (a -> b) -> a -> b
$ Doc ann -> SimpleDocStream Any
forall ann1 ann2. Doc ann1 -> SimpleDocStream ann2
layoutCompact Doc ann
p
    Handle -> Text -> IO ()
TLIO.hPutStr Handle
h Text
txt
    Handle -> IO ()
hFlush Handle
h
    let debugFlag :: [FilePath] -> [FilePath]
debugFlag = if Bool
dbg then (FilePath
"-g"FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:) else [FilePath] -> [FilePath]
forall a. a -> a
id
    -- -O1 is signed byte optimization but no multi-passes
    IO FilePath -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO FilePath -> IO ()) -> IO FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ CreateProcess -> FilePath -> IO FilePath
readCreateProcess ((FilePath -> [FilePath] -> CreateProcess
proc FilePath
"nasm" ([FilePath] -> [FilePath]
debugFlag [FilePath
fp, FilePath
"-f", FilePath
"elf64", FilePath
"-O1", FilePath
"-o", FilePath
fpO])) { std_err :: StdStream
std_err = StdStream
Inherit }) FilePath
""