diff --git a/shake-ats.cabal b/shake-ats.cabal --- a/shake-ats.cabal +++ b/shake-ats.cabal @@ -1,5 +1,5 @@ name: shake-ats -version: 1.3.0.7 +version: 1.4.0.0 synopsis: Utilities for building ATS projects with shake description: Various helper functions for building [ATS](http://www.ats-lang.org/) with the [shake](http://shakebuild.com/) library homepage: https://github.com/vmchale/shake-ats#readme @@ -30,6 +30,7 @@ , shake-ext >= 2.1.0.0 , hs2ats >= 0.2.0.1 , directory + , microlens , text , dependency , shake diff --git a/src/Development/Shake/ATS.hs b/src/Development/Shake/ATS.hs --- a/src/Development/Shake/ATS.hs +++ b/src/Development/Shake/ATS.hs @@ -16,13 +16,17 @@ -- * Helper functions , getSubdirs , ccToString + , ccFromString + , ccToDir , compatible + , host -- Types , Version (..) , ForeignCabal (..) , BinaryTarget (..) , ATSToolConfig (..) , CCompiler (..) + , ArtifactType (..) ) where import Control.Monad @@ -40,22 +44,16 @@ import Development.Shake.FilePath import Development.Shake.Version import Language.ATS +import Lens.Micro import System.Directory (copyFile, createDirectoryIfMissing) import System.Exit (ExitCode (ExitSuccess)) --- | Whether +-- | Whether generated libraries are to be considered compatible. compatible :: CCompiler -> CCompiler -> Bool compatible (GCC Nothing Nothing) Clang = True compatible Clang (GCC Nothing Nothing) = True compatible x y = x == y -ccToString :: CCompiler -> String -ccToString Clang = "clang" -ccToString (Other s) = s -ccToString (GCC pre suff) = h (g <$> [pre, suff]) "gcc" - where g = maybe id mappend - h = foldr fmap id - -- | Run @patsopt@ given information about atsCommand :: CmdResult r => ATSToolConfig -> String -- ^ Source file @@ -75,7 +73,7 @@ -- Copy source files to the appropriate place. This is necessary because -- @#include@s in ATS are weird. copySources :: ATSToolConfig -> [FilePath] -> Action () -copySources (ATSToolConfig v v' _) sources = +copySources (ATSToolConfig v v' _ _) sources = forM_ sources $ \dep -> do h <- patsHome v' let home = h ++ "lib/ats2-postiats-" ++ show v @@ -100,37 +98,43 @@ packageDbs = (\x -> ["-package-db", x ++ "/dist-newstyle/packagedb/ghc-" ++ ghcV]) =<< libToDirs fc libToDirs :: [ForeignCabal] -> [String] -libToDirs = fmap (takeDirectory . TL.unpack . cabalFile) +libToDirs = fmap (takeDirectory . TL.unpack . h) + where h (ForeignCabal mpr cf _) = fromMaybe cf mpr +uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d) +uncurry3 f (x, y, z) = f x y z + -- TODO libraries should be linked against *cross-compiled* versions!! +-- aka we need to compile atslib atsBin :: BinaryTarget -> Rules () atsBin BinaryTarget{..} = do unless (null genTargets) $ - mapM_ (uncurry genATS) genTargets + mapM_ (uncurry3 genATS) genTargets unless (null hsLibs) $ mapM_ cabalExport hsLibs binTarget %> \_ -> do h <- patsHome (compilerVer toolConfig) - h' <- pkgHome + let cc' = cc toolConfig + h' <- pkgHome cc' let home = h ++ "lib/ats2-postiats-" ++ show (libVersion toolConfig) - sources <- transitiveDeps (snd <$> genTargets) [src] + need otherDeps + sources <- (<> cDeps) <$> transitiveDeps ((^._2) <$> genTargets) [src] b' <- doesFileExist "atspkg.dhall" let hb = bool id ("atspkg.dhall" :) b' need (hb (sources ++ (TL.unpack . objectFile <$> hsLibs))) copySources toolConfig sources - let ccommand = unwords [ cc, "-I" ++ h ++ "ccomp/runtime/", "-I" ++ h, "-I" ++ h' ++ "include", "-L" ++ h' ++ "lib", "-L" ++ home ++ "/ccomp/atslib/lib"] - cmd_ ["mkdir", "-p", dropDirectory1 binTarget] + let ccommand = unwords [ ccToString cc', "-I" ++ h ++ "ccomp/runtime/", "-I" ++ h, "-I" ++ h' ++ "include", "-L" ++ h' ++ "lib", "-L" ++ home ++ "/ccomp/atslib/lib"] path <- fromMaybe "" <$> getEnv "PATH" let toLibs = fmap ("-l" <>) - let libs' = ("atslib" :) $ bool libs ("gc" : libs) gc + let libs' = ("atslib" :) $ bool libs ("gc" : libs) gc -- TODO make atslib a configuration option ghcV <- case hsLibs of [] -> pure undefined _ -> ghcVersion - command + command_ [EchoStderr False, AddEnv "PATSHOME" home, AddEnv "PATH" (home ++ "/bin:" ++ path), AddEnv "PATSHOMELOCS" $ patsHomeLocs 5] (home ++ "/bin/patscc") (mconcat @@ -164,7 +168,7 @@ transitiveDeps _ [] = pure [] transitiveDeps gen ps = fmap join $ forM ps $ \p -> if p `elem` gen then pure mempty else do contents <- liftIO $ readFile p - let ats = fromRight mempty . parseATS . lexATS $ contents + let ats = fromRight mempty . parse $ contents let dir = takeDirectory p deps <- filterM (\f -> ((f `elem` gen) ||) <$> doesFileExist f) $ fixDir dir . trim <$> getDependencies ats deps' <- transitiveDeps gen deps diff --git a/src/Development/Shake/ATS/Environment.hs b/src/Development/Shake/ATS/Environment.hs --- a/src/Development/Shake/ATS/Environment.hs +++ b/src/Development/Shake/ATS/Environment.hs @@ -1,22 +1,59 @@ module Development.Shake.ATS.Environment ( fixDir , pkgHome , patsHome + , ccToDir + , ccToString + , ccFromString + , host ) where +import Data.List (isPrefixOf, isSuffixOf) import Data.Maybe (fromMaybe) import qualified Data.Text.Lazy as TL import Development.Shake import Development.Shake.ATS.Type import Development.Shake.FilePath +import System.Info +host :: String +host = arch ++ withManufacturer os + where withManufacturer "darwin" = "-apple-" ++ os + withManufacturer _ = "-unknown-" ++ os + +ccToDir :: CCompiler -> String +ccToDir (GCC (Just s) _) = reverse (drop 1 $ reverse s) ++ "/" +ccToDir _ = "" + +ccToString :: CCompiler -> String +ccToString Clang = "clang" +ccToString (Other s) = s +ccToString (GCC pre suff) = mkQualified pre suff "gcc" +ccToString (GHC pre suff) = mkQualified pre suff "ghc" + +ccFromString :: String -> CCompiler +ccFromString "gcc" = GCC Nothing Nothing +ccFromString "clang" = Clang +ccFromString "ghc" = GHC Nothing Nothing +ccFromString s + | "gcc" `isSuffixOf` s = GCC (Just (reverse . drop 3 . reverse $ s)) Nothing + | "gcc" `isPrefixOf` s = GCC Nothing (Just $ drop 3 s) + | "ghc" `isSuffixOf` s = GHC (Just (reverse . drop 3 . reverse $ s)) Nothing + | "ghc" `isPrefixOf` s = GHC Nothing (Just $ drop 3 s) +ccFromString _ = GCC Nothing Nothing + +mkQualified :: Monoid a => Maybe a -> Maybe a -> a -> a +mkQualified pre suff = h (g <$> [pre, suff]) + where g = maybe id mappend + h = foldr fmap id + -- | The directory @~/.atspkg@ -pkgHome :: Action String -pkgHome = fromMaybe "/usr/local/" <$> mh - where mh = fmap (++ "/.atspkg/") <$> getEnv "HOME" +pkgHome :: CCompiler -> Action String +pkgHome cc' = fromMaybe "/usr/local/" <$> mh + where mh = fmap (++ ("/.atspkg/" ++ ccToDir cc')) <$> getEnv "HOME" -- | The directory that will be @PATSHOME@. patsHome :: Version -> Action String -patsHome v = fmap (++ (show v ++ "/")) pkgHome +patsHome v = fmap (++ (show v ++ "/")) (pkgHome (GCC Nothing Nothing)) fixDir :: FilePath -> String -> String fixDir p = diff --git a/src/Development/Shake/ATS/Rules.hs b/src/Development/Shake/ATS/Rules.hs --- a/src/Development/Shake/ATS/Rules.hs +++ b/src/Development/Shake/ATS/Rules.hs @@ -6,6 +6,7 @@ ) where import Control.Monad +import Data.List (isPrefixOf) import Data.Semigroup (Semigroup (..)) import qualified Data.Text.Lazy as TL import Development.Shake hiding (doesDirectoryExist) @@ -13,17 +14,18 @@ import Development.Shake.Cabal import Development.Shake.FilePath import Language.ATS.Generate -import System.Directory (copyFile, createDirectoryIfMissing, doesDirectoryExist, listDirectory) +import System.Directory -- | Given a plain Haskell source file, generate a @.sats@ file containing -- analogous types. genATS :: FilePath -- ^ Haskell source -> FilePath -- ^ @.sats@ file to generate + -> Bool -- ^ Whether to call cpphs preprocessor -> Rules () -genATS src target = +genATS src target cpphs = target %> \out -> liftIO $ do createDirectoryIfMissing True (takeDirectory out) - genATSTypes src out + genATSTypes src out cpphs getSubdirs :: FilePath -> IO [FilePath] getSubdirs p = do @@ -35,13 +37,15 @@ ss <- mapM getSubdirs ds' pure $ ds' <> join ss --- TODO - copy the .ghc.environment.* file to the current directory +-- TODO cabal exports can happen concurrently w/ compiler & whatnot cabalExport :: ForeignCabal -> Rules () -cabalExport (ForeignCabal cf' obf') = do +cabalExport (ForeignCabal cbp' cf' obf') = do let cf = TL.unpack cf' + cbp = maybe cf TL.unpack cbp' obf = TL.unpack obf' obfDir = takeDirectory (obf -<.> "hs") + libName = takeBaseName cf trDeps <- liftIO $ getCabalDeps cf obf %> \out -> do @@ -49,10 +53,11 @@ need (cf : fmap ((obfDir <> "/") <>) trDeps) command_ [Cwd obfDir] "cabal" ["new-build"] - let subdir = takeDirectory cf ++ "/" - endsBuild = (== "build") . last . splitPath + let subdir = takeDirectory cbp ++ "/" + correctDir = (libName `isPrefixOf`) + endsBuild = correctDir . last . splitPath dir <- filter endsBuild <$> liftIO (getSubdirs $ subdir ++ "dist-newstyle/build") - let obj = head dir ++ "/" ++ takeFileName obf + let obj = head dir ++ "/opt/build/" ++ takeFileName obf liftIO $ copyFile obj out let hdr = dropExtension obj ++ "_stub.h" diff --git a/src/Development/Shake/ATS/Type.hs b/src/Development/Shake/ATS/Type.hs --- a/src/Development/Shake/ATS/Type.hs +++ b/src/Development/Shake/ATS/Type.hs @@ -12,7 +12,7 @@ , BinaryTarget (..) , ArtifactType (..) , ATSToolConfig (..) - , CCompiler (GCC, Clang, Other, GCCStd) + , CCompiler (GCC, Clang, GHC, Other, GCCStd, GHCStd) ) where import Data.Binary (Binary (..)) @@ -23,6 +23,9 @@ pattern GCCStd :: CCompiler pattern GCCStd = GCC Nothing Nothing +pattern GHCStd :: CCompiler +pattern GHCStd = GHC Nothing Nothing + -- We should have four build types: -- -- 1. Static library @@ -52,32 +55,38 @@ data ArtifactType = StaticLibrary | DynamicLibrary - | Binary Bool + | Binary Bool -- ^ Whether binary build should create a static binary + deriving (Generic, Binary) data CCompiler = GCC { _prefix :: Maybe String, _suffix :: Maybe String } | Clang | Other String - deriving (Eq) + | GHC { _prefix :: Maybe String, _suffix :: Maybe String } + deriving (Eq, Generic, Binary) -- | Information about where to find @patscc@ and @patsopt@. data ATSToolConfig = ATSToolConfig { libVersion :: Version , compilerVer :: Version , hasPretty :: Bool -- ^ Whether to display errors via @pats-filter@ + , cc :: CCompiler -- ^ C compiler to be used } deriving (Generic, Binary) -data BinaryTarget = BinaryTarget { cc :: String -- ^ C compiler to be used. - , cFlags :: [String] -- ^ Flags to be passed to the C compiler +-- | Type for binary and library builds with ATS. +data BinaryTarget = BinaryTarget { cFlags :: [String] -- ^ Flags to be passed to the C compiler , toolConfig :: ATSToolConfig , gc :: Bool -- ^ Whether to configure build for use with the garbage collector. , libs :: [String] -- ^ Libraries against which to link , src :: String -- ^ Source file for binary. , hsLibs :: [ForeignCabal] -- ^ Cabal-based Haskell libraries - , genTargets :: [(String, String)] -- ^ Files to be run through @hs2ats@. + , genTargets :: [(String, String, Bool)] -- ^ Files to be run through @hs2ats@. , binTarget :: String -- ^ Binary target - , cDeps :: [String] -- ^ Any C files necessary to compile the target + , cDeps :: [String] -- ^ C files necessary to compile the target + , otherDeps :: [String] -- ^ Other files necessary to compile target + , tgtType :: ArtifactType -- ^ Build type } deriving (Generic, Binary) -- | Data type containing information about Haskell components of a build. -data ForeignCabal = ForeignCabal { cabalFile :: TL.Text -- ^ @.cabal@ file associated with the library - , objectFile :: TL.Text -- ^ Object file to be generated +data ForeignCabal = ForeignCabal { projectFile :: Maybe TL.Text -- ^ @cabal.project@ file to track + , cabalFile :: TL.Text -- ^ @.cabal@ file associated with the library + , objectFile :: TL.Text -- ^ Object file to be generated } deriving (Eq, Show, Generic, Binary)