module Language.ATS.Package.Build.C ( clibSetup
                                    , cpkgHome
                                    , allSubdirs
                                    ) where

import           Development.Shake.ATS
import           Development.Shake.C
import qualified Development.Shake.Check as Check
import           GHC.Conc
import           Quaalude

cpkgHome :: CCompiler -> IO FilePath
cpkgHome :: CCompiler -> IO FilePath
cpkgHome CCompiler
cc' = FilePath -> IO FilePath
getAppUserDataDirectory (FilePath
"atspkg" FilePath -> FilePath -> FilePath
</> CCompiler -> FilePath
ccToDir CCompiler
cc')

allSubdirs :: FilePath -> IO [FilePath]
allSubdirs :: FilePath -> IO [FilePath]
allSubdirs [] = [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath]
forall a. Monoid a => a
mempty
allSubdirs FilePath
d = do
    [FilePath]
d' <- FilePath -> IO [FilePath]
listDirectory FilePath
d
    let d'' :: [FilePath]
d'' = (FilePath
d FilePath -> FilePath -> FilePath
</>) (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
d'
    [FilePath]
ds <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesDirectoryExist [FilePath]
d''
    [[FilePath]]
ds' <- (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> IO [FilePath]
allSubdirs [FilePath]
ds
    [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [[FilePath]] -> [FilePath]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([FilePath]
ds [FilePath] -> [[FilePath]] -> [[FilePath]]
forall a. a -> [a] -> [a]
: [[FilePath]]
ds')

ccForConfig :: CCompiler -> String
ccForConfig :: CCompiler -> FilePath
ccForConfig = FilePath -> FilePath
g (FilePath -> FilePath)
-> (CCompiler -> FilePath) -> CCompiler -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CCompiler -> FilePath
ccToString
    where g :: FilePath -> FilePath
g FilePath
"icc" = FilePath
"cc"
          g FilePath
x     = FilePath
x

makeExecutable' :: FilePath -> [FilePath] -> IO ()
makeExecutable' :: FilePath -> [FilePath] -> IO ()
makeExecutable' FilePath
file [FilePath]
dirs = do
    Maybe FilePath
p <- [FilePath] -> FilePath -> IO (Maybe FilePath)
findFile [FilePath]
dirs FilePath
file
    Maybe (IO ()) -> IO ()
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (FilePath -> IO ()
makeExecutable (FilePath -> IO ()) -> Maybe FilePath -> Maybe (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
p)

clibSetup :: Verbosity -- ^ Shake verbosity level
          -> CCompiler -- ^ C compiler
          -> String -- ^ Library name
          -> FilePath -- ^ Filepath to unpack to
          -> IO ()
clibSetup :: Verbosity -> CCompiler -> FilePath -> FilePath -> IO ()
clibSetup Verbosity
v CCompiler
cc' FilePath
lib' FilePath
p = do

    -- Find configure script and make it executable
    [FilePath]
subdirs <- FilePath -> IO [FilePath]
allSubdirs FilePath
p
    Maybe FilePath
configurePath <- [FilePath] -> FilePath -> IO (Maybe FilePath)
findFile (FilePath
pFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
subdirs) FilePath
"configure"
    Maybe FilePath
cmakeLists <- [FilePath] -> FilePath -> IO (Maybe FilePath)
findFile (FilePath
pFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
subdirs) FilePath
"CMakeLists.txt"
    Maybe (IO ()) -> IO ()
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (FilePath -> IO ()
makeExecutable (FilePath -> IO ()) -> Maybe FilePath -> Maybe (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
configurePath)
    FilePath -> [FilePath] -> IO ()
makeExecutable' FilePath
"install-sh" (FilePath
pFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
subdirs)

    -- Set environment variables for configure script
    FilePath
h <- CCompiler -> IO FilePath
cpkgHome CCompiler
cc'
    let procEnv :: Maybe [(FilePath, FilePath)]
procEnv = [(FilePath, FilePath)] -> Maybe [(FilePath, FilePath)]
forall a. a -> Maybe a
Just [(FilePath
"CC", CCompiler -> FilePath
ccForConfig CCompiler
cc'), (FilePath
"CFLAGS" :: String, FilePath
"-I" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
h FilePath -> FilePath -> FilePath
</> FilePath
"include -Wno-error -O2"), (FilePath
"PATH", FilePath
"/usr/bin:/bin")]

    [FilePath -> FilePath -> IO ()] -> FilePath -> FilePath -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t (a -> b -> f ()) -> a -> b -> f ()
biaxe [Maybe (FilePath -> FilePath -> IO ())
-> FilePath -> FilePath -> IO ()
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Verbosity
-> FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> FilePath
-> FilePath
-> IO ()
configure Verbosity
v FilePath
h (FilePath
 -> Maybe [(FilePath, FilePath)] -> FilePath -> FilePath -> IO ())
-> Maybe FilePath
-> Maybe
     (Maybe [(FilePath, FilePath)] -> FilePath -> FilePath -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
configurePath Maybe
  (Maybe [(FilePath, FilePath)] -> FilePath -> FilePath -> IO ())
-> Maybe (Maybe [(FilePath, FilePath)])
-> Maybe (FilePath -> FilePath -> IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe [(FilePath, FilePath)]
-> Maybe (Maybe [(FilePath, FilePath)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [(FilePath, FilePath)]
procEnv), Verbosity
-> FilePath -> Maybe FilePath -> FilePath -> FilePath -> IO ()
cmake Verbosity
v FilePath
h Maybe FilePath
cmakeLists, Verbosity -> FilePath -> FilePath -> IO ()
make Verbosity
v, Verbosity -> FilePath -> FilePath -> IO ()
install Verbosity
v] FilePath
lib' FilePath
p

cmake :: Verbosity -> FilePath -> Maybe FilePath -> String -> FilePath -> IO ()
cmake :: Verbosity
-> FilePath -> Maybe FilePath -> FilePath -> FilePath -> IO ()
cmake Verbosity
_ FilePath
_ Maybe FilePath
Nothing FilePath
_ FilePath
_ = IO ()
forall a. Monoid a => a
mempty
cmake Verbosity
v FilePath
prefixPath (Just FilePath
cfgLists) FilePath
_ FilePath
_ = do
    let p :: FilePath
p = FilePath -> FilePath
takeDirectory FilePath
cfgLists
    Bool
cmakeB <- IO Bool
forall (m :: * -> *). MonadIO m => m Bool
Check.cmake
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
cmakeB (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Verbosity -> CreateProcess -> IO ()
silentCreateProcess Verbosity
v ((FilePath -> [FilePath] -> CreateProcess
proc FilePath
"cmake" [FilePath
"-DCMAKE_INSTALL_PREFIX:PATH=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
prefixPath, FilePath
p]) { cwd :: Maybe FilePath
cwd = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
p })

configure :: Verbosity -> FilePath -> FilePath -> Maybe [(String, String)] -> String -> FilePath -> IO ()
configure :: Verbosity
-> FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> FilePath
-> FilePath
-> IO ()
configure Verbosity
v FilePath
prefixPath FilePath
configurePath Maybe [(FilePath, FilePath)]
procEnv FilePath
lib' FilePath
p =
    FilePath -> IO ()
putStrLn (FilePath
"configuring " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
lib' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"...") IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
    Verbosity -> CreateProcess -> IO ()
silentCreateProcess Verbosity
v ((FilePath -> [FilePath] -> CreateProcess
proc FilePath
configurePath [FilePath
"--prefix", FilePath
prefixPath, FilePath
"--host", FilePath
host]) { cwd :: Maybe FilePath
cwd = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
p, env :: Maybe [(FilePath, FilePath)]
env = Maybe [(FilePath, FilePath)]
procEnv })

findMakefile :: FilePath -> IO FilePath
findMakefile :: FilePath -> IO FilePath
findMakefile FilePath
p = do
    [FilePath]
subdirs <- FilePath -> IO [FilePath]
allSubdirs FilePath
p
    Maybe FilePath
mp <- [FilePath] -> FilePath -> IO (Maybe FilePath)
findFile (FilePath
pFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
subdirs) FilePath
"Makefile"
    FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> (FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
p FilePath -> FilePath
takeDirectory Maybe FilePath
mp

make :: Verbosity -> String -> FilePath -> IO ()
make :: Verbosity -> FilePath -> FilePath -> IO ()
make Verbosity
v FilePath
lib' FilePath
p = do
    FilePath -> IO ()
putStrLn (FilePath
"building " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
lib' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"...")
    FilePath
p' <- FilePath -> IO FilePath
findMakefile FilePath
p
    Int
cpus <- IO Int
getNumCapabilities
    Verbosity -> CreateProcess -> IO ()
silentCreateProcess Verbosity
v ((FilePath -> [FilePath] -> CreateProcess
proc FilePath
makeExe [FilePath
"-j" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
cpus]) { cwd :: Maybe FilePath
cwd = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
p' })

install :: Verbosity -> String -> FilePath -> IO ()
install :: Verbosity -> FilePath -> FilePath -> IO ()
install Verbosity
v FilePath
lib' FilePath
p = do
    FilePath -> IO ()
putStrLn (FilePath
"installing " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
lib' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"...")
    FilePath
p' <- FilePath -> IO FilePath
findMakefile FilePath
p
    Verbosity -> CreateProcess -> IO ()
silentCreateProcess Verbosity
v ((FilePath -> [FilePath] -> CreateProcess
proc FilePath
makeExe [FilePath
"install"]) { cwd :: Maybe FilePath
cwd = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
p' })