{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-}
module Development.Shake.C (
CConfig (..)
, CCompiler (ICC, GCC, Clang, GHC, Other, GCCStd, GHCStd, CompCert)
, staticLibR
, sharedLibR
, objectFileR
, dynLibR
, cBin
, cToLib
, pkgConfig
, binaryA
, staticLibA
, sharedLibA
, stripA
, queryCC
, queryCfg
, examineCC
, examineCfg
, getCDepends
, getAll
, cconfigToArgs
, ccToString
, ccFromString
, host
, isCross
) where
import Control.Monad
import Data.List (isPrefixOf, isSuffixOf)
import Development.Shake
import Development.Shake.Classes
import Development.Shake.FilePath
import GHC.Generics (Generic)
import Language.C.Dependency
import System.Info
pkgConfig :: String -> Action [String]
pkgConfig pkg = do
(Stdout o) <- command [] "pkg-config" ["--cflags", pkg]
(Stdout o') <- command [] "pkg-config" ["--libs", pkg]
pure (words o ++ words o')
mkQualified :: Monoid a => Maybe a -> Maybe a -> a -> a
mkQualified pre suff = h [f suff, g pre]
where g = maybe id mappend
f = maybe id (flip mappend)
h = foldr fmap id
host :: String
host = arch ++ withManufacturer os
where withManufacturer "darwin" = "-apple-" ++ os
withManufacturer _ = "-unknown-" ++ os
pattern GCCStd :: CCompiler
pattern GCCStd = GCC Nothing
pattern GHCStd :: CCompiler
pattern GHCStd = GHC Nothing Nothing
ccToString :: CCompiler -> String
ccToString ICC = "icc"
ccToString Clang = "clang"
ccToString (Other s) = s
ccToString (GCC pre) = mkQualified pre Nothing "gcc"
ccToString (GHC pre suff) = mkQualified pre suff "ghc"
ccToString CompCert = "ccomp"
stripToString :: CCompiler -> String
stripToString (GCC pre) = mkQualified pre Nothing "strip"
stripToString (GHC pre _) = mkQualified pre Nothing "strip"
stripToString _ = "strip"
arToString :: CCompiler -> String
arToString (GCC pre) = mkQualified pre Nothing "ar"
arToString (GHC pre _) = mkQualified pre Nothing "ar"
arToString _ = "ar"
isCross :: CCompiler -> Bool
isCross (GCC Just{}) = True
isCross (GHC Just{} _) = True
isCross _ = False
ccFromString :: String -> CCompiler
ccFromString "icc" = ICC
ccFromString "gcc" = GCC Nothing
ccFromString "ccomp" = CompCert
ccFromString "clang" = Clang
ccFromString "ghc" = GHC Nothing Nothing
ccFromString s
| "gcc" `isSuffixOf` s = GCC (Just (reverse . drop 3 . reverse $ s))
| "ghc" `isSuffixOf` s = GHC (Just (reverse . drop 3 . reverse $ s)) Nothing
| "ghc" `isPrefixOf` s = GHC Nothing (Just (drop 3 s))
ccFromString _ = Other "cc"
data CCompiler = GCC { _prefix :: Maybe String
}
| Clang
| GHC { _prefix :: Maybe String
, _postfix :: Maybe String
}
| CompCert
| ICC
| Other String
deriving (Show, Eq, Generic, Typeable, Hashable, Binary, NFData)
mapFlags :: String -> ([String] -> [String])
mapFlags s = fmap (s ++)
data CConfig = CConfig { includes :: [String]
, libraries :: [String]
, libDirs :: [String]
, extras :: [String]
, staticLink :: Bool
}
deriving (Show, Eq, Generic, Typeable, Hashable, Binary, NFData)
newtype CC = CC ()
deriving (Show, Eq)
deriving newtype (Typeable, Hashable, Binary, NFData)
newtype Cfg = Cfg ()
deriving (Show, Eq)
deriving newtype (Typeable, Hashable, Binary, NFData)
type instance RuleResult CC = CCompiler
type instance RuleResult Cfg = CConfig
examineCC :: CCompiler -> Rules ()
examineCC cc = void $ addOracle $ \(CC _) -> pure cc
examineCfg :: CConfig -> Rules ()
examineCfg cfg = void $ addOracle $ \(Cfg _) -> pure cfg
queryCC :: Action ()
queryCC = void $ askOracle (CC ())
queryCfg :: Action ()
queryCfg =void $ askOracle (Cfg ())
cToLib :: CCompiler
-> [FilePath]
-> FilePattern
-> CConfig
-> Rules ()
cToLib cc sources lib cfg =
mconcat [ mconcat objRules
, staticLibR cc (g sources) lib cfg
]
where objRules = objectFileR cc cfg <$> g sources <*> pure lib
g = fmap (-<.> "o")
cBin :: CCompiler
-> [FilePath]
-> FilePattern
-> CConfig
-> Rules ()
cBin cc sources bin cfg = bin %> \out -> binaryA cc sources out cfg
stripA :: CmdResult r
=> FilePath
-> CCompiler
-> Action r
stripA out cc = command mempty (stripToString cc) [out]
binaryA :: CmdResult r
=> CCompiler
-> [FilePath]
-> FilePath
-> CConfig
-> Action r
binaryA cc sources out cfg =
need sources >>
(command [EchoStderr False] (ccToString cc) . (("-o" : out : sources) ++) . cconfigToArgs) cfg
cconfigToArgs :: CConfig -> [String]
cconfigToArgs (CConfig is ls ds es sl) = join [ mapFlags "-I" is, mapFlags "-l" (g sl <$> ls), mapFlags "-L" ds, es ]
where g :: Bool -> (String -> String)
g False = id
g True = (":lib" ++) . (++ ".a")
dynLibR :: CCompiler
-> [FilePath]
-> FilePattern
-> CConfig
-> Rules ()
dynLibR cc objFiles shLib cfg =
shLib %> \out ->
need objFiles >>
command [EchoStderr False] (ccToString cc) ("-shared" : "-o" : out : objFiles ++ cconfigToArgs cfg)
objectFileR :: CCompiler
-> CConfig
-> FilePath
-> FilePattern
-> Rules ()
objectFileR cc cfg srcFile objFile =
objFile %> \out ->
need [srcFile] >>
command [EchoStderr False] (ccToString cc) (srcFile : "-c" : "-fPIC" : "-o" : out : cconfigToArgs cfg)
sharedLibA :: CmdResult r
=> CCompiler
-> [FilePath]
-> FilePattern
-> CConfig
-> Action r
sharedLibA cc objFiles shrLib _ =
need objFiles >>
command mempty (ccToString cc) ("-shared" : "-o" : shrLib : objFiles)
staticLibA :: CmdResult r
=> CCompiler
-> [FilePath]
-> FilePattern
-> CConfig
-> Action r
staticLibA ar objFiles stalib _ =
need objFiles >>
command mempty (arToString ar) ("rcs" : stalib : objFiles)
sharedLibR :: CCompiler
-> [FilePath]
-> FilePattern
-> CConfig
-> Rules ()
sharedLibR cc objFiles shrLib cfg =
shrLib %> \out -> sharedLibA cc objFiles out cfg
staticLibR :: CCompiler
-> [FilePath]
-> FilePattern
-> CConfig
-> Rules ()
staticLibR ar objFiles stalib cfg =
stalib %> \out -> staticLibA ar objFiles out cfg