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.1.0.2 +version: 1.2.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 @@ -22,6 +22,8 @@ library hs-source-dirs: src exposed-modules: Development.Shake.ATS + other-modules: Development.Shake.ATS.Type + , Development.Shake.ATS.Rules build-depends: base >= 4.7 && < 5 , language-ats , shake-ext >= 2.1.0.0 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 @@ -1,7 +1,6 @@ {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeSynonymInstances #-} @@ -11,7 +10,7 @@ , cleanATS , atsBin , atsLex - , ghcExport + , cabalExport -- * Actions , patsHome -- * Helper functions @@ -19,88 +18,36 @@ -- Types , Version (..) , ForeignCabal (..) + , BinaryTarget (..) ) where import Control.Monad import Control.Monad.IO.Class -import Data.Binary (Binary (..)) -import Data.Bool (bool) -import Data.Either (fromRight) -import Data.List (intercalate) -import Data.Maybe (fromMaybe) -import Data.Semigroup (Semigroup (..)) -import qualified Data.Text.Lazy as TL -import Development.Shake hiding (doesDirectoryExist) -import Development.Shake.Cabal +import Data.Bool (bool) +import Data.Either (fromRight) +import Data.List (intercalate) +import Data.Maybe (fromMaybe) +import Data.Semigroup (Semigroup (..)) +import qualified Data.Text.Lazy as TL +import Development.Shake +import Development.Shake.ATS.Rules +import Development.Shake.ATS.Type import Development.Shake.FilePath -import GHC.Generics (Generic) import Language.ATS import Language.ATS.Generate -import System.Directory (copyFile, createDirectoryIfMissing, doesDirectoryExist, listDirectory) -import System.Exit (ExitCode (ExitSuccess)) - -data ForeignCabal = ForeignCabal { cabalFile :: TL.Text -- ^ @.cabal@ file associated with the library - , objectFile :: TL.Text -- ^ Object file to be generated - } - -getSubdirs :: FilePath -> IO [FilePath] -getSubdirs p = do - ds <- listDirectory p - case ds of - [] -> pure [] - xs -> do - ds' <- filterM doesDirectoryExist (((p <> "/") <>) <$> xs) - ss <- mapM getSubdirs ds' - pure $ ds' <> join ss - -newtype Version = Version [Integer] - deriving (Eq, Generic, Binary) - -instance Show Version where - show (Version is) = intercalate "." (show <$> is) +import System.Directory (copyFile, createDirectoryIfMissing) +import System.Exit (ExitCode (ExitSuccess)) -genATS :: FilePath -> FilePath -> Rules () +-- | Given a plain Haskell source file, generate a @.sats@ file containing +-- analogous types. +genATS :: FilePath -- ^ Haskell source + -> FilePath -- ^ @.sats@ file to generate + -> Rules () genATS src target = target %> \out -> liftIO $ do createDirectoryIfMissing True (takeDirectory out) genATSTypes src target --- dumb heuristic: --- go to dist-newstyle/build --- find 'build' subdir --- file is there - -cabalExport :: ForeignCabal -> Rules () -cabalExport (ForeignCabal cf' obf') = do - - let cf = TL.unpack cf' - obf = TL.unpack obf' - obfDir = takeDirectory (obf -<.> "hs") - - trDeps <- liftIO $ getCabalDeps cf - obf %> \out -> do - - need (cf : fmap ((obfDir <> "/") <>) trDeps) - command_ [Cwd obfDir] "cabal" ["new-build"] - - let subdir = takeDirectory cf ++ "/" - endsBuild = (== "build") . last . splitPath - dir <- filter endsBuild <$> liftIO (getSubdirs $ subdir ++ "dist-newstyle/build") - let obj = head dir ++ "/" ++ takeFileName obf - liftIO $ copyFile obj out - - let hdr = dropExtension obj ++ "_stub.h" - liftIO $ copyFile hdr (takeDirectory out ++ "/" ++ takeFileName hdr) - --- cabal deps -ghcExport :: String -> Rules () -ghcExport m = - [ m ++ ".o" ] &%> \[out] -> do - let fn = out -<.> "hs" - let dir = takeDirectory out - need [ fn ] - command [Cwd dir] "ghc" ["-c", "-O", takeFileName fn ] - -- | The directory @~/.atspkg@ pkgHome :: Action String pkgHome = fromMaybe "/usr/local/" <$> mh @@ -110,7 +57,12 @@ patsHome :: Version -> Action String patsHome v = fmap (++ (show v ++ "/")) pkgHome -atsCommand :: CmdResult r => Version -> Version -> String -> String -> Action r +-- | Run @patsopt@ given information about +atsCommand :: CmdResult r => Version -- ^ Compiler version + -> Version -- ^ Standard library version + -> String -- ^ Source file + -> String -- ^ C code to be generated + -> Action r atsCommand v v' sourceFile out = do h <- patsHome v' let home = h ++ "lib/ats2-postiats-" ++ show v @@ -123,7 +75,7 @@ gcFlag True = "-DATS_MEMALLOC_GCBDW" -- Copy source files to the appropriate place. This is necessary because --- @#include@s in ATS are fucked up. +-- @#include@s in ATS are weird. copySources :: Version -> Version -> [FilePath] -> Action () copySources v v' sources = forM_ sources $ \dep -> do @@ -132,6 +84,7 @@ liftIO $ createDirectoryIfMissing True (home ++ "/" ++ takeDirectory dep) liftIO $ copyFile dep (home ++ "/" ++ dep) +-- This is the @$PATSHOMELOCS@ variable to be passed to the shell. patsHomeLocs :: Int -> String patsHomeLocs n = intercalate ":" $ (<> ".atspkg/contrib") . ("./" <>) <$> g where g = [ join $ replicate i "../" | i <- [1..n] ] @@ -146,34 +99,25 @@ hsExtra = bool ["--make", "-odir", ".atspkg", "-no-hs-main", "-package-db", "~/.cabal/store/ghc-8.2.2/package.db/"] mempty noHs noHs = null fc -atsBin :: String -- ^ C compiler we should use - -> [String] -- ^ Flags to pass to the C compiler - -> Version -- ^ Library version - -> Version -- ^ Compiler version - -> Bool -- ^ Whether to use the garbage collector - -> [String] -- ^ A list of libraries against which to link - -> String -- ^ Source file - -> [ForeignCabal] -- ^ Cabal-based Haskell libraries - -> [(String, String)] -- ^ Files to be run through @hs2ats@. - -> String -- ^ Binary target - -> Rules () -atsBin cc cFlags v v' gc libs sourceFile hs atg out = do +-- TODO ideally cache C files and use `gcc` on them? +atsBin :: BinaryTarget -> Rules () +atsBin BinaryTarget{..} = do - unless (null atg) $ - mapM_ (uncurry genATS) atg + unless (null genTargets) $ + mapM_ (uncurry genATS) genTargets - unless (null hs) $ - mapM_ cabalExport hs + unless (null hsLibs) $ + mapM_ cabalExport hsLibs - out %> \_ -> do - h <- patsHome v' + binTarget %> \_ -> do + h <- patsHome compilerVer h' <- pkgHome - let home = h ++ "lib/ats2-postiats-" ++ show v - sources <- transitiveDeps (snd <$> atg) [sourceFile] - need (sources ++ (TL.unpack . objectFile <$> hs)) - copySources v v' sources + let home = h ++ "lib/ats2-postiats-" ++ show libVersion + sources <- transitiveDeps (snd <$> genTargets) [src] + need (sources ++ (TL.unpack . objectFile <$> hsLibs)) + copySources libVersion compilerVer sources - cmd_ ["mkdir", "-p", dropDirectory1 out] + cmd_ ["mkdir", "-p", dropDirectory1 binTarget] path <- fromMaybe "" <$> getEnv "PATH" let toLibs = fmap ("-l" <>) let libs' = ("atslib" :) $ bool libs ("gc" : libs) gc @@ -181,26 +125,10 @@ [EchoStderr False, AddEnv "PATSHOME" home, AddEnv "PATH" (home ++ "/bin:" ++ path), AddEnv "PATSHOMELOCS" $ patsHomeLocs 5] (home ++ "/bin/patscc") (mconcat - [ [sourceFile, "-atsccomp", cc ++ " -I" ++ h ++ "/ccomp/runtime/ -I" ++ h ++ " -L" ++ h' ++ "/lib" ++ " -L" ++ home ++ "/ccomp/atslib/lib", "-o", out, "-cleanaft"] - , makeCFlags cFlags hs gc + [ [src, "-atsccomp", cc ++ " -I" ++ h ++ "/ccomp/runtime/ -I" ++ h ++ " -L" ++ h' ++ "/lib" ++ " -L" ++ home ++ "/ccomp/atslib/lib", "-o", binTarget, "-cleanaft"] + , makeCFlags cFlags hsLibs gc , toLibs libs' ]) - --- | Build a @.lats@ file. -atsLex :: Rules () -atsLex = - "*.dats" %> \out -> do - lats <- liftIO $ readFile (out -<.> "lats") - (Stdout contents) <- command [Stdin lats] "atslex" [] - liftIO $ writeFile out contents - -cleanATS :: Rules () -cleanATS = - - "clean" ~> do - removeFilesAfter "." ["//*.c", "//tags"] - removeFilesAfter ".atspkg" ["//*"] - removeFilesAfter "ats-deps" ["//*"] handleSource :: Version -> Version -> FilePath -> Action () handleSource v v' sourceFile = do diff --git a/src/Development/Shake/ATS/Rules.hs b/src/Development/Shake/ATS/Rules.hs new file mode 100644 --- /dev/null +++ b/src/Development/Shake/ATS/Rules.hs @@ -0,0 +1,62 @@ +module Development.Shake.ATS.Rules ( atsLex + , cleanATS + , cabalExport + , getSubdirs + ) where + +import Control.Monad +import Data.Semigroup (Semigroup (..)) +import qualified Data.Text.Lazy as TL +import Development.Shake hiding (doesDirectoryExist) +import Development.Shake.ATS.Type hiding (BinaryTarget (..)) +import Development.Shake.Cabal +import Development.Shake.FilePath +import System.Directory (copyFile, doesDirectoryExist, listDirectory) + +getSubdirs :: FilePath -> IO [FilePath] +getSubdirs p = do + ds <- listDirectory p + case ds of + [] -> pure [] + xs -> do + ds' <- filterM doesDirectoryExist (((p <> "/") <>) <$> xs) + ss <- mapM getSubdirs ds' + pure $ ds' <> join ss + +cabalExport :: ForeignCabal -> Rules () +cabalExport (ForeignCabal cf' obf') = do + + let cf = TL.unpack cf' + obf = TL.unpack obf' + obfDir = takeDirectory (obf -<.> "hs") + + trDeps <- liftIO $ getCabalDeps cf + obf %> \out -> do + + need (cf : fmap ((obfDir <> "/") <>) trDeps) + command_ [Cwd obfDir] "cabal" ["new-build"] + + let subdir = takeDirectory cf ++ "/" + endsBuild = (== "build") . last . splitPath + dir <- filter endsBuild <$> liftIO (getSubdirs $ subdir ++ "dist-newstyle/build") + let obj = head dir ++ "/" ++ takeFileName obf + liftIO $ copyFile obj out + + let hdr = dropExtension obj ++ "_stub.h" + liftIO $ copyFile hdr (takeDirectory out ++ "/" ++ takeFileName hdr) + +-- | Build a @.lats@ file. +atsLex :: Rules () +atsLex = + "*.dats" %> \out -> do + lats <- liftIO $ readFile (out -<.> "lats") + (Stdout contents) <- command [Stdin lats] "atslex" [] + liftIO $ writeFile out contents + +cleanATS :: Rules () +cleanATS = + + "clean" ~> do + removeFilesAfter "." ["//*.c", "//tags"] + removeFilesAfter ".atspkg" ["//*"] + removeFilesAfter "ats-deps" ["//*"] diff --git a/src/Development/Shake/ATS/Type.hs b/src/Development/Shake/ATS/Type.hs new file mode 100644 --- /dev/null +++ b/src/Development/Shake/ATS/Type.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + +-- gcc ats-src/libnumbertheory.o -shared -o ats-src/libnumbertheory.so +-- gcc number-theory-ffi_dats.c -c -fPIC -o ats-src/libnumbertheory.o -IATS2-Postiats-include-0.3.8/ -IATS2-Postiats-include-0.3.8/ccomp/runtime/ + +module Development.Shake.ATS.Type ( ForeignCabal (..) + , Version (..) + , BinaryTarget (..) + ) where + +import Data.Binary (Binary (..)) +import Data.List (intercalate) +import qualified Data.Text.Lazy as TL +import GHC.Generics (Generic) + +-- We should have four build types: +-- +-- 1. Static library +-- +-- 2. Dynamic library +-- +-- 3. Binary +-- +-- 4. C sources +-- +-- AND variations on these where a Haskell library is to be built +-- Or a C library. + +data BinaryTarget = BinaryTarget { cc :: String -- ^ C compiler to be used. + , cFlags :: [String] -- ^ Flags to be passed to the C compiler + , libVersion :: Version + , compilerVer :: Version + , 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@. + , binTarget :: String -- ^ Binary target + } + +-- | 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 + } + +newtype Version = Version [Integer] + deriving (Eq, Generic, Binary) + +instance Show Version where + show (Version is) = intercalate "." (show <$> is)