{-# LANGUAGE PatternSynonyms #-}

-- | This module provides functions for easy C builds of binaries, static
-- libraries, and dynamic libraries.
module Development.Shake.C ( -- * Types
                             CConfig (..)
                           , CCompiler (GCC, Clang, GHC, Other, GCCStd, GHCStd, CompCert)
                           -- * Rules
                           , staticLibR
                           , sharedLibR
                           , objectFileR
                           , dynLibR
                           , cBin
                           , cToLib
                           -- * Actions
                           , pkgConfig
                           , binaryA
                           , staticLibA
                           , sharedLibA
                           , stripA
                           -- * Helper functions
                           , cconfigToArgs
                           , ccToString
                           , ccFromString
                           , getCDepends
                           , host
                           ) where

import           Control.Monad
import           Data.List                  (isPrefixOf, isSuffixOf)
import           Development.Shake
import           Development.Shake.FilePath
import           System.Directory           (removeFile)
import           System.Info

-- cmake?? make (??)

-- | Given a package name or path to a @.pc@ file, output flags for C compiler.
pkgConfig :: String -> Action [String]
pkgConfig :: String -> Action [String]
pkgConfig String
pkg = do
    (Stdout String
o) <- [CmdOption] -> String -> [String] -> Action (Stdout String)
forall r.
(Partial, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [] String
"pkg-config" [String
"--cflags", String
pkg]
    (Stdout String
o') <- [CmdOption] -> String -> [String] -> Action (Stdout String)
forall r.
(Partial, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [] String
"pkg-config" [String
"--libs", String
pkg]
    [String] -> Action [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String]
words String
o [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> String -> [String]
words String
o')

-- | Given C source code, return a list of included files. This writes to a file
-- and then makes a call to either @clang@ or @gcc@, so it should be used
-- sparingly.
getCDepends :: CCompiler -- ^ Should be either @gcc@ or @clang@.
            -> String -- ^ C source code
            -> Action [FilePath]
getCDepends :: CCompiler -> String -> Action [String]
getCDepends CCompiler
cc' String
src = do
    IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
writeFile String
"shake.c" String
src
    (Stdout String
o) <- [CmdOption] -> String -> [String] -> Action (Stdout String)
forall r.
(Partial, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [] (CCompiler -> String
ccToString CCompiler
cc') [String
"-MM", String
"shake.c"]
    IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeFile String
"shake.c"
    [String] -> Action [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"/") ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
o)

mkQualified :: Monoid a => Maybe a -> Maybe a -> a -> a
mkQualified :: Maybe a -> Maybe a -> a -> a
mkQualified Maybe a
pre Maybe a
suff = [a -> a] -> a -> a
forall a. [a -> a] -> a -> a
h [Maybe a -> a -> a
f Maybe a
suff, Maybe a -> a -> a
g Maybe a
pre]
    where g :: Maybe a -> a -> a
g = (a -> a) -> (a -> a -> a) -> Maybe a -> a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a -> a
forall a. a -> a
id a -> a -> a
forall a. Monoid a => a -> a -> a
mappend
          f :: Maybe a -> a -> a
f = (a -> a) -> (a -> a -> a) -> Maybe a -> a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a -> a
forall a. a -> a
id ((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> a
forall a. Monoid a => a -> a -> a
mappend)
          h :: [a -> a] -> a -> a
h = ((a -> a) -> (a -> a) -> a -> a) -> (a -> a) -> [a -> a] -> a -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a -> a) -> (a -> a) -> a -> a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. a -> a
id

-- | The target triple of the host machine.
host :: String
host :: String
host = String
arch String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
withManufacturer String
os
    where withManufacturer :: String -> String
withManufacturer String
"darwin" = String
"-apple-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
os
          withManufacturer String
_        = String
"-unknown-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
os

-- | Default @gcc@ available
pattern GCCStd :: CCompiler
pattern $bGCCStd :: CCompiler
$mGCCStd :: forall r. CCompiler -> (Void# -> r) -> (Void# -> r) -> r
GCCStd = GCC Nothing

-- | Default @ghc@ available
pattern GHCStd :: CCompiler
pattern $bGHCStd :: CCompiler
$mGHCStd :: forall r. CCompiler -> (Void# -> r) -> (Void# -> r) -> r
GHCStd = GHC Nothing Nothing

-- | Get the executable name for a 'CCompiler'
ccToString :: CCompiler -> String
ccToString :: CCompiler -> String
ccToString CCompiler
Clang          = String
"clang"
ccToString (Other String
s)      = String
s
ccToString (GCC Maybe String
pre)      = Maybe String -> Maybe String -> String -> String
forall a. Monoid a => Maybe a -> Maybe a -> a -> a
mkQualified Maybe String
pre Maybe String
forall a. Maybe a
Nothing String
"gcc"
ccToString (GHC Maybe String
pre Maybe String
suff) = Maybe String -> Maybe String -> String -> String
forall a. Monoid a => Maybe a -> Maybe a -> a -> a
mkQualified Maybe String
pre Maybe String
suff String
"ghc"
ccToString CCompiler
CompCert       = String
"ccomp"

stripToString :: CCompiler -> String
stripToString :: CCompiler -> String
stripToString (GCC Maybe String
pre)   = Maybe String -> Maybe String -> String -> String
forall a. Monoid a => Maybe a -> Maybe a -> a -> a
mkQualified Maybe String
pre Maybe String
forall a. Maybe a
Nothing String
"strip"
stripToString (GHC Maybe String
pre Maybe String
_) = Maybe String -> Maybe String -> String -> String
forall a. Monoid a => Maybe a -> Maybe a -> a -> a
mkQualified Maybe String
pre Maybe String
forall a. Maybe a
Nothing String
"strip"
stripToString CCompiler
_           = String
"strip"

arToString :: CCompiler -> String
arToString :: CCompiler -> String
arToString (GCC Maybe String
pre)   = Maybe String -> Maybe String -> String -> String
forall a. Monoid a => Maybe a -> Maybe a -> a -> a
mkQualified Maybe String
pre Maybe String
forall a. Maybe a
Nothing String
"ar"
arToString (GHC Maybe String
pre Maybe String
_) = Maybe String -> Maybe String -> String -> String
forall a. Monoid a => Maybe a -> Maybe a -> a -> a
mkQualified Maybe String
pre Maybe String
forall a. Maybe a
Nothing String
"ar"
arToString CCompiler
_           = String
"ar"

-- | Attempt to parse a string as a 'CCompiler', defaulting to @cc@ if parsing
-- fails.
ccFromString :: String -> CCompiler
ccFromString :: String -> CCompiler
ccFromString String
"gcc" = Maybe String -> CCompiler
GCC Maybe String
forall a. Maybe a
Nothing
ccFromString String
"clang" = CCompiler
Clang
ccFromString String
"ghc" = Maybe String -> Maybe String -> CCompiler
GHC Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
ccFromString String
s
    | String
"gcc" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
s = Maybe String -> CCompiler
GCC (String -> Maybe String
forall a. a -> Maybe a
Just (String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
3 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
s))
    | String
"ghc" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
s = Maybe String -> Maybe String -> CCompiler
GHC (String -> Maybe String
forall a. a -> Maybe a
Just (String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
3 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
s)) Maybe String
forall a. Maybe a
Nothing
    | String
"ghc" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s = Maybe String -> Maybe String -> CCompiler
GHC Maybe String
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
3 String
s))
ccFromString String
_ = String -> CCompiler
Other String
"cc"

-- | A data type representing the C compiler to be used.
data CCompiler = GCC { CCompiler -> Maybe String
_prefix :: Maybe String -- ^ Usually the target triple
                     }
               | Clang
               | GHC { _prefix  :: Maybe String -- ^ The target triple
                     , CCompiler -> Maybe String
_postfix :: Maybe String -- ^ The compiler version
                     }
               | CompCert
               | Other String
               deriving (CCompiler -> CCompiler -> Bool
(CCompiler -> CCompiler -> Bool)
-> (CCompiler -> CCompiler -> Bool) -> Eq CCompiler
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CCompiler -> CCompiler -> Bool
$c/= :: CCompiler -> CCompiler -> Bool
== :: CCompiler -> CCompiler -> Bool
$c== :: CCompiler -> CCompiler -> Bool
Eq)

mapFlags :: String -> ([String] -> [String])
mapFlags :: String -> [String] -> [String]
mapFlags String
s = (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<>)

data CConfig = CConfig { CConfig -> [String]
includes   :: [String] -- ^ Directories to be included.
                       , CConfig -> [String]
libraries  :: [String] -- ^ Libraries against which to link.
                       , CConfig -> [String]
libDirs    :: [String] -- ^ Directories to find libraries.
                       , CConfig -> [String]
extras     :: [String] -- ^ Extra flags to be passed to the compiler
                       , CConfig -> Bool
staticLink :: Bool -- ^ Whether to link against static versions of libraries
                       }

-- | Rules for making a static library from C source files. Unlike 'staticLibR',
-- this also creates rules for creating object files.
cToLib :: CCompiler
       -> [FilePath] -- ^ C source files
       -> FilePattern -- ^ Static libary output
       -> CConfig
       -> Rules ()
cToLib :: CCompiler -> [String] -> String -> CConfig -> Rules ()
cToLib CCompiler
cc [String]
sources String
lib CConfig
cfg =
    [Rules ()] -> Rules ()
forall a. Monoid a => [a] -> a
mconcat [ [Rules ()] -> Rules ()
forall a. Monoid a => [a] -> a
mconcat [Rules ()]
objRules
            , CCompiler -> [String] -> String -> CConfig -> Rules ()
staticLibR CCompiler
cc ([String] -> [String]
g [String]
sources) String
lib CConfig
cfg
            ]
    where objRules :: [Rules ()]
objRules = CCompiler -> CConfig -> String -> String -> Rules ()
objectFileR CCompiler
cc CConfig
cfg (String -> String -> Rules ()) -> [String] -> [String -> Rules ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> [String]
g [String]
sources [String -> Rules ()] -> [String] -> [Rules ()]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
lib
          g :: [String] -> [String]
g = (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
-<.> String
"o")

-- | Rules for generating a binary from C source files. Can have at most have
-- one @main@ function.
cBin :: CCompiler
     -> [FilePath] -- ^ C source files
     -> FilePattern -- ^ Binary file output
     -> CConfig
     -> Rules ()
cBin :: CCompiler -> [String] -> String -> CConfig -> Rules ()
cBin CCompiler
cc [String]
sources String
bin CConfig
cfg = String
bin Partial => String -> (String -> Action ()) -> Rules ()
String -> (String -> Action ()) -> Rules ()
%> \String
out -> CCompiler -> [String] -> String -> CConfig -> Action ()
forall r.
CmdResult r =>
CCompiler -> [String] -> String -> CConfig -> Action r
binaryA CCompiler
cc [String]
sources String
out CConfig
cfg

stripA :: CmdResult r
       => FilePath -- ^ Build product to be stripped
       -> CCompiler -- ^ C compiler
       -> Action r
stripA :: String -> CCompiler -> Action r
stripA String
out CCompiler
cc = [CmdOption] -> String -> [String] -> Action r
forall r.
(Partial, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [CmdOption]
forall a. Monoid a => a
mempty (CCompiler -> String
stripToString CCompiler
cc) [String
out]

-- | This action builds an executable.
binaryA :: CmdResult r
        => CCompiler
        -> [FilePath] -- ^ Source files
        -> FilePath -- ^ Executable output
        -> CConfig
        -> Action r
binaryA :: CCompiler -> [String] -> String -> CConfig -> Action r
binaryA CCompiler
cc [String]
sources String
out CConfig
cfg =
    Partial => [String] -> Action ()
[String] -> Action ()
need [String]
sources Action () -> Action r -> Action r
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    ([CmdOption] -> String -> [String] -> Action r
forall r.
(Partial, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [Bool -> CmdOption
EchoStderr Bool
False] (CCompiler -> String
ccToString CCompiler
cc) ([String] -> Action r)
-> (CConfig -> [String]) -> CConfig -> Action r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String
"-o" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
out String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
sources) [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<>) ([String] -> [String])
-> (CConfig -> [String]) -> CConfig -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CConfig -> [String]
cconfigToArgs) CConfig
cfg

-- | Generate compiler flags for a given configuration.
cconfigToArgs :: CConfig -> [String]
cconfigToArgs :: CConfig -> [String]
cconfigToArgs (CConfig [String]
is [String]
ls [String]
ds [String]
es Bool
sl) = [[String]] -> [String]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join [ String -> [String] -> [String]
mapFlags String
"-I" [String]
is, String -> [String] -> [String]
mapFlags String
"-l" (Bool -> String -> String
g Bool
sl (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
ls), String -> [String] -> [String]
mapFlags String
"-L" [String]
ds, [String]
es ]
    where g :: Bool -> (String -> String)
          g :: Bool -> String -> String
g Bool
False = String -> String
forall a. a -> a
id
          g Bool
True  = (String
":lib" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".a")

-- | These rules build a dynamic library (@.so@ on Linux).
dynLibR :: CCompiler
        -> [FilePath] -- ^ C source files
        -> FilePattern -- ^ Shared object file to be generated.
        -> CConfig
        -> Rules ()
dynLibR :: CCompiler -> [String] -> String -> CConfig -> Rules ()
dynLibR CCompiler
cc [String]
objFiles String
shLib CConfig
cfg =
    String
shLib Partial => String -> (String -> Action ()) -> Rules ()
String -> (String -> Action ()) -> Rules ()
%> \String
out ->
        Partial => [String] -> Action ()
[String] -> Action ()
need [String]
objFiles Action () -> Action () -> Action ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
        [CmdOption] -> String -> [String] -> Action ()
forall r.
(Partial, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [Bool -> CmdOption
EchoStderr Bool
False] (CCompiler -> String
ccToString CCompiler
cc) (String
"-shared" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"-o" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
out String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
objFiles [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> CConfig -> [String]
cconfigToArgs CConfig
cfg)

-- | These rules build an object file from a C source file.
objectFileR :: CCompiler
            -> CConfig
            -> FilePath -- ^ C source file
            -> FilePattern -- ^ Object file output
            -> Rules ()
objectFileR :: CCompiler -> CConfig -> String -> String -> Rules ()
objectFileR CCompiler
cc CConfig
cfg String
srcFile String
objFile =
    String
objFile Partial => String -> (String -> Action ()) -> Rules ()
String -> (String -> Action ()) -> Rules ()
%> \String
out ->
        Partial => [String] -> Action ()
[String] -> Action ()
need [String
srcFile] Action () -> Action () -> Action ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
        [CmdOption] -> String -> [String] -> Action ()
forall r.
(Partial, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [Bool -> CmdOption
EchoStderr Bool
False] (CCompiler -> String
ccToString CCompiler
cc) (String
srcFile String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"-c" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"-fPIC" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"-o" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
out String -> [String] -> [String]
forall a. a -> [a] -> [a]
: CConfig -> [String]
cconfigToArgs CConfig
cfg)

sharedLibA :: CmdResult r
           => CCompiler
           -> [FilePath] -- ^ Object files to be linked
           -> FilePattern -- ^ File pattern for shared library outputs
           -> CConfig
           -> Action r
sharedLibA :: CCompiler -> [String] -> String -> CConfig -> Action r
sharedLibA CCompiler
cc [String]
objFiles String
shrLib CConfig
_ =
    Partial => [String] -> Action ()
[String] -> Action ()
need [String]
objFiles Action () -> Action r -> Action r
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    [CmdOption] -> String -> [String] -> Action r
forall r.
(Partial, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [CmdOption]
forall a. Monoid a => a
mempty (CCompiler -> String
ccToString CCompiler
cc) (String
"-shared" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"-o" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
shrLib String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
objFiles)

staticLibA :: CmdResult r
           => CCompiler
           -> [FilePath] -- ^ Object files to be linked
           -> FilePattern -- ^ File pattern for static library outputs
           -> CConfig
           -> Action r
staticLibA :: CCompiler -> [String] -> String -> CConfig -> Action r
staticLibA CCompiler
ar [String]
objFiles String
stalib CConfig
_ =
    Partial => [String] -> Action ()
[String] -> Action ()
need [String]
objFiles Action () -> Action r -> Action r
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    [CmdOption] -> String -> [String] -> Action r
forall r.
(Partial, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [CmdOption]
forall a. Monoid a => a
mempty (CCompiler -> String
arToString CCompiler
ar) (String
"rcs" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
stalib String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
objFiles)

sharedLibR :: CCompiler
           -> [FilePath] -- ^ Object files to be linked
           -> FilePattern -- ^ File pattern for shared library outputs
           -> CConfig
           -> Rules ()
sharedLibR :: CCompiler -> [String] -> String -> CConfig -> Rules ()
sharedLibR CCompiler
cc [String]
objFiles String
shrLib CConfig
cfg =
    String
shrLib Partial => String -> (String -> Action ()) -> Rules ()
String -> (String -> Action ()) -> Rules ()
%> \String
out -> CCompiler -> [String] -> String -> CConfig -> Action ()
forall r.
CmdResult r =>
CCompiler -> [String] -> String -> CConfig -> Action r
sharedLibA CCompiler
cc [String]
objFiles String
out CConfig
cfg

staticLibR :: CCompiler
           -> [FilePath] -- ^ Object files to be linked
           -> FilePattern -- ^ File pattern for static library outputs
           -> CConfig
           -> Rules ()
staticLibR :: CCompiler -> [String] -> String -> CConfig -> Rules ()
staticLibR CCompiler
ar [String]
objFiles String
stalib CConfig
cfg =
    String
stalib Partial => String -> (String -> Action ()) -> Rules ()
String -> (String -> Action ()) -> Rules ()
%> \String
out -> CCompiler -> [String] -> String -> CConfig -> Action ()
forall r.
CmdResult r =>
CCompiler -> [String] -> String -> CConfig -> Action r
staticLibA CCompiler
ar [String]
objFiles String
out CConfig
cfg