{-# LANGUAGE NamedFieldPuns #-}

module GHC.Toolchain.Tools.Cxx
    ( Cxx(..)
    , findCxx
      -- * Helpful utilities
    , compileCxx
    ) where

import System.FilePath

import GHC.Platform.ArchOS
import GHC.Toolchain.Prelude
import GHC.Toolchain.Program
import GHC.Toolchain.Utils

newtype Cxx = Cxx { Cxx -> Program
cxxProgram :: Program
                  }
    deriving (Int -> Cxx -> ShowS
[Cxx] -> ShowS
Cxx -> String
(Int -> Cxx -> ShowS)
-> (Cxx -> String) -> ([Cxx] -> ShowS) -> Show Cxx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cxx -> ShowS
showsPrec :: Int -> Cxx -> ShowS
$cshow :: Cxx -> String
show :: Cxx -> String
$cshowList :: [Cxx] -> ShowS
showList :: [Cxx] -> ShowS
Show, ReadPrec [Cxx]
ReadPrec Cxx
Int -> ReadS Cxx
ReadS [Cxx]
(Int -> ReadS Cxx)
-> ReadS [Cxx] -> ReadPrec Cxx -> ReadPrec [Cxx] -> Read Cxx
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Cxx
readsPrec :: Int -> ReadS Cxx
$creadList :: ReadS [Cxx]
readList :: ReadS [Cxx]
$creadPrec :: ReadPrec Cxx
readPrec :: ReadPrec Cxx
$creadListPrec :: ReadPrec [Cxx]
readListPrec :: ReadPrec [Cxx]
Read, Cxx -> Cxx -> Bool
(Cxx -> Cxx -> Bool) -> (Cxx -> Cxx -> Bool) -> Eq Cxx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cxx -> Cxx -> Bool
== :: Cxx -> Cxx -> Bool
$c/= :: Cxx -> Cxx -> Bool
/= :: Cxx -> Cxx -> Bool
Eq, Eq Cxx
Eq Cxx =>
(Cxx -> Cxx -> Ordering)
-> (Cxx -> Cxx -> Bool)
-> (Cxx -> Cxx -> Bool)
-> (Cxx -> Cxx -> Bool)
-> (Cxx -> Cxx -> Bool)
-> (Cxx -> Cxx -> Cxx)
-> (Cxx -> Cxx -> Cxx)
-> Ord Cxx
Cxx -> Cxx -> Bool
Cxx -> Cxx -> Ordering
Cxx -> Cxx -> Cxx
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Cxx -> Cxx -> Ordering
compare :: Cxx -> Cxx -> Ordering
$c< :: Cxx -> Cxx -> Bool
< :: Cxx -> Cxx -> Bool
$c<= :: Cxx -> Cxx -> Bool
<= :: Cxx -> Cxx -> Bool
$c> :: Cxx -> Cxx -> Bool
> :: Cxx -> Cxx -> Bool
$c>= :: Cxx -> Cxx -> Bool
>= :: Cxx -> Cxx -> Bool
$cmax :: Cxx -> Cxx -> Cxx
max :: Cxx -> Cxx -> Cxx
$cmin :: Cxx -> Cxx -> Cxx
min :: Cxx -> Cxx -> Cxx
Ord)

_cxxProgram :: Lens Cxx Program
_cxxProgram :: Lens Cxx Program
_cxxProgram = (Cxx -> Program) -> (Program -> Cxx -> Cxx) -> Lens Cxx Program
forall a b. (a -> b) -> (b -> a -> a) -> Lens a b
Lens Cxx -> Program
cxxProgram (\Program
x Cxx
o -> Cxx
o{cxxProgram=x})

findCxx :: ArchOS
        -> String -- ^ The llvm target to use if Cc supports --target
        -> ProgOpt -> M Cxx
findCxx :: ArchOS -> String -> ProgOpt -> M Cxx
findCxx ArchOS
archOs String
target ProgOpt
progOpt = String -> M Cxx -> M Cxx
forall a. Show a => String -> M a -> M a
checking String
"for C++ compiler" (M Cxx -> M Cxx) -> M Cxx -> M Cxx
forall a b. (a -> b) -> a -> b
$ do
    -- TODO: We use the search order in configure, but there could be a more optimal one
    cxxProgram <- String -> ProgOpt -> [String] -> M Program
findProgram String
"C++ compiler" ProgOpt
progOpt [String
"g++", String
"clang++", String
"c++"]
    cxx        <- cxxSupportsTarget archOs target Cxx{cxxProgram}
    checkCxxWorks cxx
    return cxx

cxxSupportsTarget :: ArchOS -> String -> Cxx -> M Cxx
cxxSupportsTarget :: ArchOS -> String -> Cxx -> M Cxx
cxxSupportsTarget ArchOS
archOs String
target Cxx
cxx =
    String -> M Cxx -> M Cxx
forall a. Show a => String -> M a -> M a
checking String
"whether C++ supports --target" (M Cxx -> M Cxx) -> M Cxx -> M Cxx
forall a b. (a -> b) -> a -> b
$
    ArchOS
-> Lens Cxx Program -> (Cxx -> M ()) -> String -> Cxx -> M Cxx
forall compiler.
ArchOS
-> Lens compiler Program
-> (compiler -> M ())
-> String
-> compiler
-> M compiler
supportsTarget ArchOS
archOs Lens Cxx Program
_cxxProgram Cxx -> M ()
checkCxxWorks String
target Cxx
cxx

checkCxxWorks :: Cxx -> M ()
checkCxxWorks :: Cxx -> M ()
checkCxxWorks Cxx
cxx = (String -> M ()) -> M ()
forall a. (String -> M a) -> M a
withTempDir ((String -> M ()) -> M ()) -> (String -> M ()) -> M ()
forall a b. (a -> b) -> a -> b
$ \String
dir -> do
    let test_o :: String
test_o = String
dir String -> ShowS
</> String
"test.o"
    Cxx -> String -> String -> M ()
compileCxx Cxx
cxx String
test_o (String -> M ()) -> String -> M ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
        [ String
"#include <stdio.h>"
        , String
"int main(int argc, char **argv) {"
        , String
"  printf(\"hello world!\");"
        , String
"  return 0;"
        , String
"}"
        ]

compileCxx
    :: Cxx      -- ^ cxx
    -> FilePath -- ^ output path
    -> String   -- ^ C++ source
    -> M ()
compileCxx :: Cxx -> String -> String -> M ()
compileCxx = String
-> [String] -> Lens Cxx Program -> Cxx -> String -> String -> M ()
forall compiler.
String
-> [String]
-> Lens compiler Program
-> compiler
-> String
-> String
-> M ()
compile String
"cpp" [String
"-c"] Lens Cxx Program
_cxxProgram