module Kempe.Proc.As ( writeO
                     ) where

import           Data.Functor                (void)
import           Prettyprinter               (Doc, layoutCompact)
import           Prettyprinter.Render.String (renderString)
import           System.Info                 (arch)
import           System.Process              (CreateProcess (..), StdStream (Inherit), proc, readCreateProcess)

-- | @as@ on Aarch64 systems, or @aarch64-linux-gnu-as@ when
-- cross-assembling/cross-compiling.
assembler :: String
assembler :: String
assembler =
    case String
arch of
        String
"x86_64" -> String
"aarch64-linux-gnu-as"
        String
_        -> String
"as"

-- | Assemble using @as@, output in some file.
writeO :: Doc ann
       -> FilePath
       -> Bool -- ^ Debug symbols?
       -> IO ()
writeO :: Doc ann -> String -> Bool -> IO ()
writeO Doc ann
p String
fpO Bool
dbg = do
    let inp :: String
inp = SimpleDocStream Any -> String
forall ann. SimpleDocStream ann -> String
renderString (Doc ann -> SimpleDocStream Any
forall ann1 ann2. Doc ann1 -> SimpleDocStream ann2
layoutCompact Doc ann
p)
        debugFlag :: [String] -> [String]
debugFlag = if Bool
dbg then (String
"-g"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) else [String] -> [String]
forall a. a -> a
id
    IO String -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO String -> IO ()) -> IO String -> IO ()
forall a b. (a -> b) -> a -> b
$ CreateProcess -> String -> IO String
readCreateProcess ((String -> [String] -> CreateProcess
proc String
assembler ([String] -> [String]
debugFlag [String
"-o", String
fpO, String
"--"])) { std_err :: StdStream
std_err = StdStream
Inherit }) String
inp