diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -17,7 +17,7 @@ * Track all file dependencies * Make contributing to your projects easier * Run builds in parallel (like `make`) - * Handle flags and libraries for garbage collection when specified + * Handle flags and libraries for garbage collection * Install `patscc` and other ATS tooling * Install manual pages and shell completions * Install ATS libraries diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -17,7 +17,7 @@ maybeInstallActions cfs = bool nothing act cond where act = installActions nothing = pure mempty - cond = (mkFlagName "no-executable", True) `elem` configConfigurationsFlags cfs + cond = (mkFlagName "no-executable", True) `notElem` configConfigurationsFlags cfs main :: IO () main = defaultMainWithHooks $ diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -14,7 +14,6 @@ import Language.ATS.Package import Lens.Micro import Options.Applicative -import qualified Paths_ats_pkg as P import System.Directory import System.IO.Temp (withSystemTempDirectory) @@ -26,14 +25,15 @@ <> header "atspkg - a build tool for ATS\nsee 'man atspkg' for more detailed help") versionInfo :: Parser (a -> a) -versionInfo = infoOption ("atspkg version: " ++ showVersion P.version) (short 'V' <> long "version" <> help "Show version") +versionInfo = infoOption ("atspkg version: " ++ showVersion atspkgVersion) (short 'V' <> long "version" <> help "Show version") -data Command = Install +data Command = Install { _archTarget :: Maybe String } | Build { _targets :: [String] , _archTarget :: Maybe String , _rebuildAll :: Bool , _verbosity :: Int , _lint :: Bool + , _prof :: Bool } | Clean | Test { _targets :: [String] @@ -46,6 +46,7 @@ | Valgrind { _targets :: [String] } | Run { _targets :: [String] , _rebuildAll :: Bool + , _verbosity :: Int , _lint :: Bool } | Check { _filePath :: String, _details :: Bool } @@ -53,7 +54,7 @@ command' :: Parser Command command' = hsubparser - (command "install" (info (pure Install) (progDesc "Install all binaries to $HOME/.local/bin")) + (command "install" (info install (progDesc "Install all binaries to $HOME/.local/bin")) <> command "clean" (info (pure Clean) (progDesc "Clean current project directory")) <> command "remote" (info fetch (progDesc "Fetch and install a binary package")) <> command "build" (info build' (progDesc "Build current package targets")) @@ -66,6 +67,10 @@ <> command "list" (info (pure List) (progDesc "List available packages")) ) +install :: Parser Command +install = Install + <$> triple + check' :: Parser Command check' = Check <$> targetP dhallCompletions id "check" @@ -81,8 +86,10 @@ dhallCompletions = ftypeCompletions "dhall" run' :: Parser Command -run' = Run <$> targets "run" +run' = Run + <$> targets "run" <*> rebuild + <*> verbosity <*> noLint test' :: Parser Command @@ -104,6 +111,12 @@ <> help ("Targets to " <> s) <> completions')) +profile :: Parser Bool +profile = switch + (long "profile" + <> short 'p' + <> help "Print profiling information for the build") + rebuild :: Parser Bool rebuild = switch (long "rebuild" @@ -128,6 +141,7 @@ <*> rebuild <*> verbosity <*> noLint + <*> profile noLint :: Parser Bool noLint = fmap not @@ -148,30 +162,27 @@ buildHelper True (ATSDependency lib dirName url' undefined undefined mempty mempty) ps <- getSubdirs p pkgDir <- fromMaybe p <$> findFile (p:ps) "atspkg.dhall" - let a = withCurrentDirectory (takeDirectory pkgDir) (mkPkg False False mempty ["install"] Nothing 0) - bool (buildAll (Just pkgDir) >> a) a =<< check (Just pkgDir) + let a = withCurrentDirectory (takeDirectory pkgDir) (mkPkg False False False mempty ["install"] Nothing 0) + bool (buildAll Nothing (Just pkgDir) >> a) a =<< check (Just pkgDir) main :: IO () main = execParser wrapper >>= run -runHelper :: Bool -> Bool -> [String] -> Maybe String -> Int -> IO () -runHelper rba lint rs tgt v = g . bool x y =<< check Nothing - where g xs = mkPkg rba lint xs rs tgt v +runHelper :: Bool -> Bool -> Bool -> [String] -> Maybe String -> Int -> IO () +runHelper rba lint tim rs tgt v = g . bool x y =<< check Nothing + where g xs = mkPkg rba lint tim xs rs tgt v y = mempty - x = [buildAll Nothing] + x = [buildAll tgt Nothing] run :: Command -> IO () -run List = displayList "https://raw.githubusercontent.com/vmchale/atspkg/master/pkgs/pkg-set.dhall" -run (Check p b) = print =<< checkPkg p b -run Upgrade = upgradeBin "vmchale" "atspkg" -run Nuke = cleanAll -run (Fetch u) = fetchPkg u -run Clean = mkPkg False True mempty ["clean"] Nothing 0 -run (Build rs tgt rba v lint) = runHelper rba lint rs tgt v -run (Test ts rba lint) = runHelper rba lint ("test" : ts) Nothing 0 -run (Run ts rba lint) = runHelper rba lint ("run" : ts) Nothing 0 -run c = runHelper False True rs Nothing 0 - where rs = g c - g Install = ["install"] - g (Valgrind ts) = "valgrind" : ts - g _ = undefined +run List = displayList "https://raw.githubusercontent.com/vmchale/atspkg/master/pkgs/pkg-set.dhall" +run (Check p b) = print =<< checkPkg p b +run Upgrade = upgradeBin "vmchale" "atspkg" +run Nuke = cleanAll +run (Fetch u) = fetchPkg u +run Clean = mkPkg False True False mempty ["clean"] Nothing 0 +run (Build rs tgt rba v lint tim) = runHelper rba lint tim rs tgt v +run (Test ts rba lint) = runHelper rba lint False ("test" : ts) Nothing 0 +run (Run ts rba v lint) = runHelper rba lint False ("run" : ts) Nothing v +run (Install tgt) = runHelper False True False ["install"] tgt 0 +run (Valgrind ts) = runHelper False True False ("valgrind" : ts) Nothing 0 diff --git a/ats-pkg.cabal b/ats-pkg.cabal --- a/ats-pkg.cabal +++ b/ats-pkg.cabal @@ -1,6 +1,6 @@ cabal-version: 1.18 name: ats-pkg -version: 2.6.1.16 +version: 2.7.0.10 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2018 Vanessa McHale @@ -15,7 +15,8 @@ extra-source-files: stack.yaml man/atspkg.1 - config.dhall + dhall/config.dhall + dhall/atslib.dhall extra-doc-files: README.md docs/manual.tex @@ -47,7 +48,6 @@ other-modules: Paths_ats_pkg Distribution.ATS.Build - Distribution.ATS.Compiler Language.ATS.Package.Build Language.ATS.Package.Build.IO Language.ATS.Package.Compiler @@ -58,6 +58,7 @@ Language.ATS.Package.PackageSet Language.ATS.Package.Type Language.ATS.Package.Upgrade + Distribution.ATS.Version System.Process.Ext Quaalude default-language: Haskell2010 diff --git a/config.dhall b/config.dhall deleted file mode 100644 --- a/config.dhall +++ /dev/null @@ -1,7 +0,0 @@ -let cfg = - { defaultPkgs = "https://raw.githubusercontent.com/vmchale/atspkg/master/pkgs/pkg-set.dhall" - , path = ([] : Optional Text) - , githubUsername = "" - } - -in cfg diff --git a/dhall/atslib.dhall b/dhall/atslib.dhall new file mode 100644 --- /dev/null +++ b/dhall/atslib.dhall @@ -0,0 +1,62 @@ +{- Dhall prelude imports -} +let map = https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/List/map +in +let concat = https://ipfs.io/ipfs/QmQ8w5PLcsNz56dMvRtq54vbuPe9cNnCCUXAQp6xLc6Ccx/Prelude/List/concat +in + +{- Helper functions -} +let mapDir = + λ(rec : {dir : Text, xs : List Text }) → + map Text Text + (λ(x : Text) → "${rec.dir}/DATS/${x}.dats") + rec.xs +in + +let mapUtil = + λ(xs : List Text) → + map Text Text + (λ(x : Text) → "utils/atscc/DATS/atscc_${x}.dats") + xs +in + +let mapPre = + λ(xs : List Text) → + mapDir { dir = "prelude", xs = xs } +in + +let mapC = + λ(xs : List Text) → + mapDir { dir = "libats/libc", xs = xs } +in + +let mapML = + λ(xs : List Text) → + mapDir { dir = "libats/ML", xs = xs } +in + +{- ATSPackage parts -} +let prelude = https://raw.githubusercontent.com/vmchale/atspkg/master/dhall/atspkg-prelude.dhall + +in prelude.default // + { libraries = + [ + prelude.staticLib // + { libTarget = "target/lib/libatslib.a" + , name = "atslib" + , src = + concat Text + [ mapPre [ "bool", "integer", "basics", "pointer", "integer_long", "integer_short", "integer_size", "char", "float", "string", "strptr", "integer_ptr", "integer_fixed", "filebas" ] + , mapC [ "math", "float", "errno", "fcntl", "dirent", "stdio", "stdlib", "string", "strings", "time", "unistd" ] + , mapML [ "list0", "option0", "array0", "matrix0", "string", "strarr", "gvalue", "dynarray", "hashtblref", "filebas", "filebas_dirent" ] + ] + , includes = ([] : List Text) + } + , prelude.staticLib // + { libTarget = "target/lib/libatsopt.a" + , name = "atsopt" + , src = mapUtil [ "main", "print", "util" ] + } + ] + , cflags = [ "-fPIC" ] + , compiler = [0,3,10] + } diff --git a/dhall/config.dhall b/dhall/config.dhall new file mode 100644 --- /dev/null +++ b/dhall/config.dhall @@ -0,0 +1,10 @@ +let version = "master" +in + +let cfg = + { defaultPkgs = "https://raw.githubusercontent.com/vmchale/atspkg/${version}/pkgs/pkg-set.dhall" + , path = ([] : Optional Text) + , githubUsername = "" + , filterErrors = False + } +in cfg diff --git a/man/atspkg.1 b/man/atspkg.1 --- a/man/atspkg.1 +++ b/man/atspkg.1 @@ -88,9 +88,9 @@ .SH CONFIGURATION .PP \f[B]atspkg\f[] is configured with Dhall, in an atspkg.dhall file. -\f[B]atspkg\f[] can be configured to produce binary targets (possibly -linked against Haskell libraries), static library targets, and as plain -C targets. +\f[B]atspkg\f[] can be configured to produce binary targets, static +library targets, shared object files, or plain C targets. +Artifacts can be linked against Haskell libraries if desired. .PP There is also a file $HOME/.config/atspkg/config.dhall which can be used to configure all builds. diff --git a/src/Distribution/ATS.hs b/src/Distribution/ATS.hs --- a/src/Distribution/ATS.hs +++ b/src/Distribution/ATS.hs @@ -1,11 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} module Distribution.ATS ( cleanATSCabal - , atsUserHooks - , atsLibUserHooks , fetchDependencies -- * Types - , Version + , Version (..) , ATSDependency (..) -- * Libraries , libgmp @@ -14,11 +12,8 @@ , atsContrib -- * Cabal helper functions , cabalHooks + , atsUserHooks , atsPolyglotBuild - -- * Functions involving the compiler - , fetchCompiler - , setupCompiler - , packageCompiler ) where import qualified Codec.Archive.Tar as Tar @@ -26,11 +21,10 @@ import Control.Concurrent.ParallelIO.Global import Control.Monad import Data.Bool -import qualified Data.Dependency as Dep +import Data.Dependency import Distribution.ATS.Build -import Distribution.ATS.Compiler import Distribution.PackageDescription -import Distribution.Simple +import Distribution.Simple hiding (Version) import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Setup import Network.HTTP.Client hiding (decompress) @@ -43,6 +37,8 @@ , _url :: String -- ^ URL of tarball containing ATS library. } +-- | Cleans local build, unless the @development@ flag is set for that +-- particular package. maybeCleanBuild :: LocalBuildInfo -> IO () maybeCleanBuild li = let cf = configConfigurationsFlags (configFlags li) in @@ -51,58 +47,34 @@ putStrLn "Cleaning up ATS dependencies..." >> cleanATSCabal --- | Default compiler version -defV :: Dep.Version -defV = Dep.Version [0,3,9] - -fetchCompiler' :: IO () -fetchCompiler' = fetchCompiler (Just "ats-deps") defV - -setupCompiler' :: IO () -setupCompiler' = setupCompiler (Just "ats-deps") defV - --- preConf :: Args -> ConfigFlags -> IO HookedBuildInfo - -- | This generates user hooks for a Cabal distribution that has some ATS --- library dependencies. For an example of its use, see the @Setup.hs@ of --- [fast-arithmetic](https://hackage.haskell.org/package/fast-arithmetic) +-- library dependencies. This will *not* do anything with the ATS source files, +-- but it *will* download any files necessary for the bundled C to compile. atsUserHooks :: [ATSDependency] -> UserHooks atsUserHooks deps = simpleUserHooks { preConf = \_ flags -> fetchDependencies flags deps >> pure emptyHookedBuildInfo , postBuild = \_ _ _ -> maybeCleanBuild } -installCompiler :: IO () -installCompiler = do - b <- doesFileExist "ats-deps/0.3.9/done" - unless b $ - fetchCompiler' >> - setupCompiler' - --- | Same as 'atsUserHooks', but installs @atslib@ as well. -atsLibUserHooks :: [ATSDependency] -> UserHooks -atsLibUserHooks deps = simpleUserHooks { preConf = \_ flags -> mconcat [ installCompiler, fetchDependencies flags deps ] >> pure emptyHookedBuildInfo - , postBuild = \_ _ _ -> maybeCleanBuild - } -- TODO custom directory? cleanATSCabal :: IO () cleanATSCabal = do b <- doesDirectoryExist "ats-deps" bool (pure ()) (removeDirectoryRecursive "ats-deps") b -atsContrib :: Dep.Version -> ATSDependency +atsContrib :: Version -> ATSDependency atsContrib v = ATSDependency ("ats2-postiats-" ++ vs ++ "-contrib") "ats-deps/contrib" ("https://downloads.sourceforge.net/project/ats2-lang/ats2-lang/ats2-postiats-" ++ vs ++ "/ATS2-Postiats-contrib-" ++ vs ++ ".tgz") where vs = show v -- | GMP bindings for ATS -libgmp :: ATSDependency -libgmp = ATSDependency "atscntrb-libgmp-1.0.4" "ats-deps/contrib/atscntrb-libgmp" "https://registry.npmjs.org/atscntrb-libgmp/-/atscntrb-libgmp-1.0.4.tgz" +libgmp :: Version -> ATSDependency +libgmp v = ATSDependency ("atscntrb-libgmp-" ++ show v) "ats-deps/contrib/atscntrb-libgmp" ("https://registry.npmjs.org/atscntrb-libgmp/-/atscntrb-libgmp-" ++ show v ++ "1.0.4.tgz") -- | Arbitrary-precision arithmetic library for ATS -intinf :: ATSDependency -intinf = ATSDependency "atscntrb-hs-intinf-1.0.6" "ats-deps/contrib/atscntrb-hx-intinf" "https://registry.npmjs.org/atscntrb-hx-intinf/-/atscntrb-hx-intinf-1.0.6.tgz" +intinf :: Version -> ATSDependency +intinf v = ATSDependency ("atscntrb-hs-intinf-" ++ show v) "ats-deps/contrib/atscntrb-hx-intinf" ("https://registry.npmjs.org/atscntrb-hx-intinf/-/atscntrb-hx-intinf-" ++ show v ++ ".tgz") -- | ATS prelude -atsPrelude :: Dep.Version -> ATSDependency +atsPrelude :: Version -> ATSDependency atsPrelude v = ATSDependency ("ats2-postiats-" ++ vs ++ "-prelude") "ats-deps/prelude" ("https://downloads.sourceforge.net/project/ats2-lang/ats2-lang/ats2-postiats-" ++ vs ++ "/ATS2-Postiats-include-" ++ vs ++ ".tgz") where vs = show v diff --git a/src/Distribution/ATS/Build.hs b/src/Distribution/ATS/Build.hs --- a/src/Distribution/ATS/Build.hs +++ b/src/Distribution/ATS/Build.hs @@ -1,14 +1,16 @@ -- | Integration with @Cabal@. module Distribution.ATS.Build ( cabalHooks - , atsPolyglotBuild - ) where + , atsPolyglotBuild + ) where +-- TODO use confHook to set extra-libraries and extra-lib-dirs ourselves? import Distribution.PackageDescription import Distribution.Simple import Distribution.Simple.LocalBuildInfo import Language.ATS.Package.Build import Quaalude +-- | Use this in place of 'defaultMain' for a simple build. atsPolyglotBuild :: IO () atsPolyglotBuild = defaultMainWithHooks cabalHooks @@ -39,6 +41,8 @@ createDirectoryIfMissing True "dist-newstyle/lib" >> writeFile "dist-newstyle/lib/empty" "" +-- | This uses the users hooks as is @simpleUserHooks@, modified to build the +-- ATS library. cabalHooks :: UserHooks cabalHooks = let defConf = confHook simpleUserHooks in simpleUserHooks { preConf = \_ _ -> writeDummyFile >> pure emptyHookedBuildInfo diff --git a/src/Distribution/ATS/Compiler.hs b/src/Distribution/ATS/Compiler.hs deleted file mode 100644 --- a/src/Distribution/ATS/Compiler.hs +++ /dev/null @@ -1,89 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - --- | This module contains scripts to fetch the compiler. -module Distribution.ATS.Compiler - ( packageCompiler - , fetchCompiler - , setupCompiler - ) where - -import qualified Codec.Archive.Tar as Tar -import Codec.Compression.GZip (compress, decompress) -import Control.Composition -import Control.Monad (when) -import qualified Data.ByteString.Lazy as BS -import Data.Dependency -import Data.Maybe (fromMaybe) -import Data.Semigroup -import Network.HTTP.Client hiding (decompress) -import Network.HTTP.Client.TLS (tlsManagerSettings) -import System.Directory -import System.Environment (getEnv) -import System.FilePath.Find (find) -import System.Posix.Files -import System.Process -import System.Process.Ext (silentCreateProcess) - -compilerDir :: Maybe FilePath -> Version -> IO FilePath -compilerDir mp v = makeAbsolute =<< dir - where def = (++ ("/.atspkg/" ++ show v)) <$> getEnv "HOME" - dir = fromMaybe <$> def <*> pure ((<> ('/' : show v)) <$> mp) - -packageCompiler :: FilePath -> IO () -packageCompiler directory = do - files <- find (pure True) (pure True) directory - bytes <- fmap Tar.write . Tar.pack directory $ fmap (drop $ length (directory :: String) + 1) files - BS.writeFile (directory ++ ".tar.gz") (compress bytes) - -pkgUrl :: Version -> String -pkgUrl v = "https://github.com/vmchale/atspkg/raw/master/pkgs/ATS2-Postiats-" ++ show v ++ ".tar.gz" - -withCompiler :: String -> Version -> IO () -withCompiler s v = putStrLn $ s ++ " compiler v" ++ show v ++ "..." - -fetchCompiler :: Maybe FilePath -> Version -> IO () -fetchCompiler mp v = do - - cd <- compilerDir mp v - needsSetup <- not <$> doesDirectoryExist cd - - when needsSetup $ do - - withCompiler "Fetching" v - manager <- newManager tlsManagerSettings - initialRequest <- parseRequest $ pkgUrl v - response <- responseBody <$> httpLbs (initialRequest { method = "GET" }) manager - - withCompiler "Unpacking" v - Tar.unpack cd . Tar.read . decompress $ response - -make :: Version -> FilePath -> IO () -make v cd = - withCompiler "Building" v >> - silentCreateProcess ((proc "make" []) { cwd = Just cd }) - -install :: Version -> FilePath -> IO () -install v cd = - withCompiler "Installing" v >> - silentCreateProcess ((proc "make" ["install"]) { cwd = Just cd }) - -configure :: FilePath -> Version -> FilePath -> IO () -configure configurePath v cd = do - - withCompiler "Configuring" v - - setFileMode configurePath ownerModes - setFileMode (cd ++ "/autogen.sh") ownerModes - - silentCreateProcess ((proc (cd ++ "/autogen.sh") []) { cwd = Just cd }) - - silentCreateProcess ((proc configurePath ["--prefix", cd]) { cwd = Just cd }) - -setupCompiler :: Maybe FilePath -> Version -> IO () -setupCompiler mp v = do - - cd <- compilerDir mp v - - biaxe [configure (cd ++ "/configure"), make, install] v cd - - writeFile (cd ++ "/done") "" diff --git a/src/Distribution/ATS/Version.hs b/src/Distribution/ATS/Version.hs new file mode 100644 --- /dev/null +++ b/src/Distribution/ATS/Version.hs @@ -0,0 +1,9 @@ +module Distribution.ATS.Version ( atspkgVersion + ) where + + +import qualified Data.Version as V +import qualified Paths_ats_pkg as P + +atspkgVersion :: V.Version +atspkgVersion = P.version diff --git a/src/Language/ATS/Package.hs b/src/Language/ATS/Package.hs --- a/src/Language/ATS/Package.hs +++ b/src/Language/ATS/Package.hs @@ -10,6 +10,9 @@ -- * Ecosystem functionality , displayList , upgradeBin + , atspkgVersion + -- * Functions involving the compiler + , packageCompiler -- * Types , Version (..) , Pkg (..) @@ -27,6 +30,7 @@ , dirLens ) where +import Distribution.ATS.Version import Language.ATS.Package.Build import Language.ATS.Package.Compiler import Language.ATS.Package.Dependency diff --git a/src/Language/ATS/Package/Build.hs b/src/Language/ATS/Package/Build.hs --- a/src/Language/ATS/Package/Build.hs +++ b/src/Language/ATS/Package/Build.hs @@ -14,17 +14,16 @@ import Control.Concurrent.ParallelIO.Global import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL -import Data.List (nub) -import Data.Version (showVersion) import Development.Shake.ATS +import Development.Shake.C (ccFromString) import Development.Shake.Check import Development.Shake.Clean import Development.Shake.Man -import Distribution.ATS.Compiler +import Distribution.ATS.Version +import Language.ATS.Package.Compiler import Language.ATS.Package.Config import Language.ATS.Package.Dependency -import Language.ATS.Package.Type hiding (Version) -import qualified Paths_ats_pkg as P +import Language.ATS.Package.Type import Quaalude check :: Maybe FilePath -> IO Bool @@ -37,16 +36,18 @@ wants p = compiler <$> getConfig p -- | Build in current directory or indicated directory -buildAll :: Maybe FilePath -> IO () -buildAll p = on (>>) (=<< wants p) fetchDef setupDef - where fetchDef = fetchCompiler Nothing - setupDef = setupCompiler Nothing +buildAll :: Maybe String + -> Maybe FilePath + -> IO () +buildAll tgt' p = on (>>) (=<< wants p) fetchDef setupDef + where fetchDef = fetchCompiler + setupDef = setupCompiler tgt' -- | Build a set of targets build :: [String] -- ^ Targets -> IO () -build rs = bool (mkPkgEmpty [buildAll Nothing]) (mkPkgEmpty mempty) =<< check Nothing - where mkPkgEmpty ts = mkPkg False True ts rs Nothing 1 +build rs = bool (mkPkgEmpty [buildAll Nothing Nothing]) (mkPkgEmpty mempty) =<< check Nothing + where mkPkgEmpty ts = mkPkg False True False ts rs Nothing 1 -- TODO clean generated ATS mkClean :: Rules () @@ -57,18 +58,20 @@ removeFilesAfter ".atspkg" ["//*"] removeFilesAfter "ats-deps" ["//*"] -mkInstall :: Rules () -mkInstall = +mkInstall :: Maybe String -> Rules () +mkInstall tgt = "install" ~> do config <- getConfig Nothing let libs = fmap (unpack . libTarget) . libraries $ config bins = fmap (unpack . target) . bin $ config incs = ((fmap unpack . includes) =<<) . libraries $ config + libDir = maybe mempty (<> "/") tgt need (bins <> libs) home <- liftIO $ getEnv "HOME" - let binDest = ((home <> "/.local/bin/") <>) . takeFileName <$> bins - let libDest = ((home <> "/.atspkg/lib/") <>) . takeFileName <$> libs - let inclDest = ((home <> "/.atspkg/include/") <>) . takeFileName <$> incs + let g str = fmap (((home <> str) <>) . takeFileName) + binDest = g "/.local/bin" bins + libDest = ((home <> "/.atspkg/" <> libDir <> "lib/") <>) . takeFileName <$> libs + inclDest = ((home <> "/.atspkg/include/") <>) . takeFileName <$> incs zipWithM_ copyFile' (bins ++ libs ++ incs) (binDest ++ libDest ++ inclDest) pa <- pandoc case man config of @@ -98,6 +101,7 @@ cacheConfiguration :: Text -> IO Pkg cacheConfiguration = input auto +-- FIXME this should cache results at the least. getConfig :: MonadIO m => Maybe FilePath -> m Pkg getConfig dir' = liftIO $ do d <- fromMaybe <$> fmap (<> "/atspkg.dhall") getCurrentDirectory <*> pure dir' @@ -135,17 +139,21 @@ options :: Bool -- ^ Whether to rebuild all targets -> Bool -- ^ Whether to run the linter + -> Bool -- ^ Whether to display profiling information for the build -> Int -- ^ Verbosity level -> [String] -- ^ A list of targets -> ShakeOptions -options rba lint v rs = shakeOptions { shakeFiles = ".atspkg" - , shakeThreads = 4 - , shakeLint = bool Nothing (Just LintBasic) lint - , shakeVersion = showVersion P.version - , shakeRebuild = rebuildTargets rba rs - , shakeChange = ChangeModtimeAndDigestInput - , shakeVerbosity = toVerbosity v - } +options rba lint tim v rs = shakeOptions { shakeFiles = ".atspkg" + , shakeThreads = 4 + , shakeLint = bool Nothing (Just LintBasic) lint + , shakeVersion = showVersion atspkgVersion + , shakeRebuild = rebuildTargets rba rs + , shakeChange = ChangeModtimeAndDigestInput + , shakeVerbosity = toVerbosity v + , shakeTimings = tim + -- shakeLintIgnore = TODO this should + -- include generated ATS? + } rebuildTargets :: Bool -- ^ Force rebuild of all targets -> [String] -- ^ Targets @@ -161,19 +169,20 @@ mkPkg :: Bool -- ^ Force rebuild -> Bool -- ^ Run linter + -> Bool -- ^ Print build profiling information -> [IO ()] -- ^ Setup -> [String] -- ^ Targets -> Maybe String -- ^ Target triple -> Int -- ^ Verbosity -> IO () -mkPkg rba lint setup rs tgt v = do +mkPkg rba lint tim setup rs tgt v = do cfg <- cleanConfig rs - let opt = options rba lint v $ pkgToTargets cfg rs + let opt = options rba lint tim v $ pkgToTargets cfg rs shake opt $ mconcat [ want (pkgToTargets cfg rs) , mkClean - , pkgToAction setup rs tgt =<< cleanConfig rs + , pkgToAction setup rs tgt cfg ] stopGlobalPool @@ -193,8 +202,8 @@ (Just m) -> want . bool bins (manTarget m : bins) =<< pandoc Nothing -> want bins -bits :: [String] -> Rules () -bits rs = mconcat $ [ mkManpage, mkInstall, mkConfig ] <> +bits :: Maybe String -> [String] -> Rules () +bits tgt rs = mconcat $ [ mkManpage, mkInstall tgt, mkConfig ] <> sequence [ mkRun, mkTest, mkValgrind ] rs pkgToTargets :: Pkg -> [FilePath] -> [FilePath] @@ -209,7 +218,7 @@ -> Maybe String -- ^ Optional compiler triple (overrides 'ccompiler') -> Pkg -- ^ Package data type -> Rules () -pkgToAction setup rs tgt ~(Pkg bs ts libs mt _ v v' ds cds bdeps ccLocal cf as cdir) = +pkgToAction setup rs tgt ~(Pkg bs ts libs mt _ v v' ds cds bdeps ccLocal cf as) = unless (rs == ["clean"]) $ do @@ -217,7 +226,7 @@ mkUserConfig - ".atspkg/deps" %> \out -> do + specialDeps %> \out -> do (_, cfgBin') <- cfgBin need [ cfgBin', ".atspkg/config" ] liftIO $ fetchDeps (ccFromString cc') setup (unpack . fst <$> ds) (unpack . fst <$> cdps) (unpack . fst <$> bdeps) cfgBin' False >> writeFile out "" @@ -225,17 +234,17 @@ let bins = unpack . target <$> bs setTargets rs bins mt - cDepsRules >> bits rs + cDepsRules >> bits tgt rs mapM_ h libs mapM_ g (bs ++ ts) - where g (Bin s t ls hs' atg gc' cSrc extra) = - atsBin (BinaryTarget (unpack <$> cf) atsToolConfig gc' (unpack <$> ls) [unpack s] hs' (unpackBoth . asTuple <$> atg) mempty (unpack t) (unpack <$> cSrc) (deps extra) Executable) + where g (Bin s t ls hs' atg gc' extra) = + atsBin (ATSTarget (unpack <$> cf) atsToolConfig gc' (unpack <$> ls) [unpack s] hs' (unpackBoth . asTuple <$> atg) mempty (unpack t) (deps extra) Executable) - h (Lib _ s t ls _ hs' lnk atg cSrc extra sta) = - atsBin (BinaryTarget (unpack <$> cf) atsToolConfig False (unpack <$> ls) (unpack <$> s) hs' (unpackBoth . asTuple <$> atg) (both unpack <$> lnk) (unpack t) (unpack <$> cSrc) (deps extra) (k sta)) + h (Lib _ s t ls _ hs' lnk atg extra sta) = + atsBin (ATSTarget (unpack <$> cf) atsToolConfig False (unpack <$> ls) (unpack <$> s) hs' (unpackBoth . asTuple <$> atg) (both unpack <$> lnk) (unpack t) (deps extra) (k sta)) k False = SharedLibrary k True = StaticLibrary @@ -243,15 +252,14 @@ atsToolConfig = ATSToolConfig v v' False (ccFromString cc') cDepsRules = unless (null as) $ do - let cedar = unpack cdir - atsSourceDirs = nub (takeDirectory . unpack <$> as) - targets = fmap (((cedar <> "/") <>) . (-<.> "c") . takeBaseName . unpack) as - want targets - hasPF <- patsFilter - mapM_ (cgen (ATSToolConfig v v' hasPF (ccFromString cc')) [".atspkg/deps", ".atspkg/config"]) atsSourceDirs + let targets = fmap (unpack . cTarget) as + sources = fmap (unpack . atsSrc) as + zipWithM_ (cgen atsToolConfig [specialDeps, ".atspkg/config"] (fmap (unpack . ats) . atsGen =<< as)) sources targets cc' = maybe (unpack ccLocal) (<> "-gcc") tgt - deps = (".atspkg/deps":) . (".atspkg/config":) . fmap unpack + deps = (specialDeps:) . (".atspkg/config":) . fmap unpack unpackBoth :: (Text, Text, Bool) -> (String, String, Bool) unpackBoth = over _1 unpack . over _2 unpack + + specialDeps = ".atspkg/deps" ++ maybe mempty ("-" <>) tgt diff --git a/src/Language/ATS/Package/Build/IO.hs b/src/Language/ATS/Package/Build/IO.hs --- a/src/Language/ATS/Package/Build/IO.hs +++ b/src/Language/ATS/Package/Build/IO.hs @@ -5,6 +5,7 @@ ) where import Development.Shake.ATS +import Development.Shake.C import Quaalude pkgHome :: CCompiler -> IO FilePath diff --git a/src/Language/ATS/Package/Compiler.hs b/src/Language/ATS/Package/Compiler.hs --- a/src/Language/ATS/Package/Compiler.hs +++ b/src/Language/ATS/Package/Compiler.hs @@ -1,11 +1,104 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} --- | This module contains scripts to fetch the compiler. module Language.ATS.Package.Compiler - ( cleanAll + ( packageCompiler + , fetchCompiler + , setupCompiler + , cleanAll ) where +import qualified Codec.Archive.Tar as Tar +import Codec.Compression.GZip (compress, decompress) +import Control.Composition +import Control.Monad +import qualified Data.ByteString.Lazy as BS +import Data.Dependency +import Data.FileEmbed +import Network.HTTP.Client hiding (decompress) +import Network.HTTP.Client.TLS (tlsManagerSettings) import Quaalude +import System.Environment (getEnv) +import System.FilePath.Find (find) +import System.Process.Ext (silentCreateProcess) + +libatsCfg :: String +libatsCfg = $(embedStringFile "dhall/atslib.dhall") + +compilerDir :: Version -> IO FilePath +compilerDir v = makeAbsolute =<< dir + where dir = (++ ("/.atspkg/" ++ show v)) <$> getEnv "HOME" + +packageCompiler :: FilePath -> IO () +packageCompiler directory = do + files <- find (pure True) (pure True) directory + bytes <- fmap Tar.write . Tar.pack directory $ fmap (drop $ length (directory :: String) + 1) files + BS.writeFile (directory ++ ".tar.gz") (compress bytes) + +pkgUrl :: Version -> String +pkgUrl v = "https://github.com/vmchale/atspkg/releases/download/compiler/ATS2-Postiats-" ++ show v ++ ".tar.gz" + +withCompiler :: String -> Version -> IO () +withCompiler s v = putStrLn $ s ++ " compiler v" ++ show v ++ "..." + +fetchCompiler :: Version -> IO () +fetchCompiler v = do + + cd <- compilerDir v + needsSetup <- not <$> doesDirectoryExist cd + + when needsSetup $ do + + withCompiler "Fetching" v + manager <- newManager tlsManagerSettings + initialRequest <- parseRequest $ pkgUrl v + response <- responseBody <$> httpLbs (initialRequest { method = "GET" }) manager + + withCompiler "Unpacking" v + Tar.unpack cd . Tar.read . decompress $ response + +make :: Version -> FilePath -> IO () +make v cd = + withCompiler "Building" v >> + silentCreateProcess ((proc "make" []) { cwd = Just cd }) + +libInstall :: FilePath -> String -> IO () +libInstall cd triple = + unless (triple == "musl") $ mconcat + [ putStrLn "Installing cross libraries..." + , writeFile (cd ++ "/atspkg.dhall") libatsCfg + , silentCreateProcess ((proc "atspkg" ["install", "--target", triple]) { cwd = Just cd }) + ] + +install :: Maybe String + -> Version + -> FilePath + -> IO () +install tgt' v cd = + withCompiler "Installing" v >> + silentCreateProcess ((proc "make" ["install"]) { cwd = Just cd }) >> + maybe mempty (libInstall cd) tgt' + +configure :: FilePath -> Version -> FilePath -> IO () +configure configurePath v cd = do + + withCompiler "Configuring" v + + setFileMode configurePath ownerModes + setFileMode (cd ++ "/autogen.sh") ownerModes + + silentCreateProcess ((proc (cd ++ "/autogen.sh") []) { cwd = Just cd }) + + silentCreateProcess ((proc configurePath ["--prefix", cd]) { cwd = Just cd }) + +setupCompiler :: Maybe FilePath -> Version -> IO () +setupCompiler tgt' v = do + + cd <- compilerDir v + + biaxe [configure (cd ++ "/configure"), make, install tgt'] v cd + + writeFile (cd ++ "/done") "" cleanAll :: IO () cleanAll = do diff --git a/src/Language/ATS/Package/Config.hs b/src/Language/ATS/Package/Config.hs --- a/src/Language/ATS/Package/Config.hs +++ b/src/Language/ATS/Package/Config.hs @@ -15,10 +15,11 @@ data UserConfig = UserConfig { defaultPkgs :: Text , path :: Maybe Text , githubUsername :: Text + , filterErrors :: Bool } deriving (Generic, Interpret, Binary) cfgFile :: String -cfgFile = $(embedStringFile "config.dhall") +cfgFile = $(embedStringFile "dhall/config.dhall") defaultFileConfig :: FilePath -> IO () defaultFileConfig p = do diff --git a/src/Language/ATS/Package/Dependency.hs b/src/Language/ATS/Package/Dependency.hs --- a/src/Language/ATS/Package/Dependency.hs +++ b/src/Language/ATS/Package/Dependency.hs @@ -21,6 +21,11 @@ import Language.ATS.Package.Type import Quaalude +getTgt :: CCompiler -> Maybe String +getTgt (GCC x) = x +getTgt (GHC x _) = x +getTgt _ = Nothing + fetchDeps :: CCompiler -- ^ C compiler to use -> [IO ()] -- ^ Setup steps that can be performed concurrently -> [String] -- ^ ATS dependencies @@ -42,12 +47,13 @@ -- Set up actions d <- (<> "lib/") <$> pkgHome cc' - let libs' = fmap (buildHelper False) (join deps') + let tgt' = getTgt cc' + libs' = fmap (buildHelper False) (join deps') unpacked = fmap (over dirLens (pack d <>)) <$> cdeps' clibs = fmap (buildHelper False) (join unpacked) atsLibs = fmap (buildHelper False) (join atsDeps') cBuild = mapM_ (setup cc') <$> transpose unpacked - atsBuild = mapM_ atsPkgSetup <$> transpose atsDeps' + atsBuild = mapM_ (atsPkgSetup tgt') <$> transpose atsDeps' -- Fetch all packages & build compiler parallel' $ join [ setup', libs', clibs, atsLibs ] @@ -66,22 +72,26 @@ waitCreateProcess = maybeExit <=< waitForProcess <=< fmap (view _4) . createProcess -atslibSetup :: String - -> FilePath +atslibSetup :: Maybe String -- ^ Optional target triple + -> String -- ^ Library name + -> FilePath -- ^ Filepath -> IO () -atslibSetup lib' p = do +atslibSetup tgt' lib' p = do putStrLn $ "installing " ++ lib' ++ "..." subdirs <- allSubdirs p pkgPath <- fromMaybe p <$> findFile subdirs "atspkg.dhall" - waitCreateProcess ((proc "atspkg" ["install"]) { cwd = Just (takeDirectory pkgPath), std_out = Inherit }) + let installCmd = "install" : maybe mempty (("--target" :) . pure) tgt' + installDir = takeDirectory pkgPath + waitCreateProcess ((proc "atspkg" installCmd) { cwd = Just installDir, std_out = Inherit }) -atsPkgSetup :: ATSDependency +atsPkgSetup :: Maybe String + -> ATSDependency -> IO () -atsPkgSetup (ATSDependency lib' dirName' _ _ _ _ _) = do +atsPkgSetup tgt' (ATSDependency lib' dirName' _ _ _ _ _) = do lib'' <- (<> unpack lib') <$> pkgHome GCCStd b <- doesFileExist lib'' unless b $ do - atslibSetup (unpack lib') (unpack dirName') + atslibSetup tgt' (unpack lib') (unpack dirName') writeFile lib'' "" setup :: CCompiler -- ^ C compiler to use diff --git a/src/Language/ATS/Package/Dhall.hs b/src/Language/ATS/Package/Dhall.hs --- a/src/Language/ATS/Package/Dhall.hs +++ b/src/Language/ATS/Package/Dhall.hs @@ -4,7 +4,7 @@ import Language.ATS.Package.PackageSet import Quaalude -checkPkg :: FilePath -- ^ Path to @pkg.dhall@ or similar. +checkPkg :: FilePath -- ^ Path to @.dhall@ file defining a package set. -> Bool -- ^ Whether to print detailed error messages. -> IO ATSPackageSet checkPkg path d = do diff --git a/src/Language/ATS/Package/Type.hs b/src/Language/ATS/Package/Type.hs --- a/src/Language/ATS/Package/Type.hs +++ b/src/Language/ATS/Package/Type.hs @@ -15,6 +15,7 @@ , ATSDependency (..) , Bin (..) , Lib (..) + , Src (..) , Version (..) , ForeignCabal (..) , ATSConstraint (..) @@ -48,8 +49,8 @@ , url :: Text -- ^ Url pointing to tarball , description :: Maybe Text -- ^ Package description , libVersion :: Version - , libDeps :: [LibDep] -- ^ Strings containing dependencies - , libBldDeps :: [LibDep] -- ^ List of dependencies that must be built + , libDeps :: [LibDep] -- ^ Dependencies to be unpacked + , libBldDeps :: [LibDep] -- ^ Dependencies to be built } deriving (Eq, Show, Generic, Interpret, Binary) @@ -63,17 +64,23 @@ deriving instance Interpret ForeignCabal -data Bin = Bin { src :: Text -- ^ Source file (should end with @.dats@) - , target :: Text -- ^ Binary to be built - , libs :: [Text] -- ^ Libraries to link against (e.g. @[ "pthread" ]@) - , hsDeps :: [ForeignCabal] -- ^ Haskell @.cabal@ files associated with the final library we want to make - , hs2ats :: [TargetPair] -- ^ List of sources and targets for @hs2ats@ - , gcBin :: Bool -- ^ Whether to use the garbage collector - , cSources :: [Text] -- ^ C source files the build depends on - , extras :: [Text] -- ^ Extra source files the build depends on +data Src = Src { atsSrc :: Text + , cTarget :: Text + , atsGen :: [TargetPair] + , extras :: [Text] } deriving (Show, Eq, Generic, Interpret, Binary) +data Bin = Bin { src :: Text -- ^ Source file (should end with @.dats@) + , target :: Text -- ^ Binary to be built + , libs :: [Text] -- ^ Libraries to link against (e.g. @[ "pthread" ]@) + , hsDeps :: [ForeignCabal] -- ^ Haskell @.cabal@ files associated with the final library we want to make + , hs2ats :: [TargetPair] -- ^ List of sources and targets for @hs2ats@ + , gcBin :: Bool -- ^ Whether to use the garbage collector + , extras :: [Text] -- ^ Extra source files the build depends on + } + deriving (Show, Eq, Generic, Interpret, Binary) + data Lib = Lib { name :: Text -- ^ Name of library being provided , src :: [Text] -- ^ Source files (should end with @.dats@) to be compiled to object files , libTarget :: Text @@ -82,7 +89,6 @@ , hsDeps :: [ForeignCabal] -- ^ Haskell @.cabal@ files associated with object files , links :: [(Text, Text)] -- ^ Generate link files. , hs2ats :: [TargetPair] -- ^ Sources and targets for @hs2ats@ - , cSources :: [Text] -- ^ C source files the build depends on , extras :: [Text] -- ^ Other source files the build depends on , static :: Bool -- ^ Whether to make a static library } @@ -96,12 +102,11 @@ , completions :: Maybe Text -- ^ Optional @compleat@ completions to be installed alongside package. , version :: Version -- ^ Library version , compiler :: Version -- ^ Compiler version - , dependencies :: [LibDep] -- ^ List of dependencies - , clib :: [LibDep] -- ^ List of C dependencies - , buildDeps :: [LibDep] -- ^ List of ATS dependencies that should be installed as static libraries + , dependencies :: [LibDep] -- ^ List of library dependencies + , clib :: [LibDep] -- ^ List of C library dependencies + , buildDeps :: [LibDep] -- ^ List of ATS library dependencies , ccompiler :: Text -- ^ The C compiler we should use , cflags :: [Text] -- ^ List of flags to pass to the C compiler - , atsSource :: [Text] -- ^ Directory containing ATS source to be compile to C. - , cDir :: Text -- ^ Directory for generated C. + , atsSource :: [Src] -- ^ ATS source to be compile to C. } deriving (Show, Eq, Generic, Interpret, Binary) diff --git a/src/Quaalude.hs b/src/Quaalude.hs --- a/src/Quaalude.hs +++ b/src/Quaalude.hs @@ -26,6 +26,7 @@ , second , getEnv , exitWith + , showVersion , ExitCode (ExitSuccess) , MonadIO (..) -- * "System.Process.Ext" reëxports @@ -111,31 +112,32 @@ , (%~) ) where -import Control.Arrow hiding ((<+>)) -import Control.Monad.IO.Class -import Data.ByteString.Lazy (ByteString) -import Lens.Micro hiding (both) -import Lens.Micro.Extras -import Lens.Micro.TH -import Network.HTTP.Client -import Network.HTTP.Client.TLS (tlsManagerSettings) -import System.Posix.Files #if __GLASGOW_HASKELL__ < 804 import Data.Semigroup #endif +import Control.Arrow hiding ((<+>)) import Control.Composition import Control.Monad +import Control.Monad.IO.Class import Data.Binary import Data.Bool (bool) +import Data.ByteString.Lazy (ByteString) import Data.List import Data.Maybe (fromMaybe) import Data.Text.Lazy (pack, unpack) +import Data.Version (showVersion) import Development.Shake hiding (getEnv) import Development.Shake.FilePath import Dhall hiding (bool) +import Lens.Micro hiding (both) +import Lens.Micro.Extras +import Lens.Micro.TH +import Network.HTTP.Client +import Network.HTTP.Client.TLS (tlsManagerSettings) import System.Directory as X import System.Environment (getEnv) import System.Exit (ExitCode (ExitSuccess), exitWith) +import System.Posix.Files import System.Process as X import System.Process.Ext import Text.PrettyPrint.ANSI.Leijen hiding (bool, (<>)) diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -6,11 +6,10 @@ - 'dependency' extra-deps: - dhall-1.10.0 - - shake-ext-2.6.0.0 - - composition-prelude-1.3.0.3 - - language-ats-1.0.2.1 + - shake-ext-2.7.0.0 + - composition-prelude-1.3.0.4 + - language-ats-1.2.0.1 - cli-setup-0.2.0.1 - - ats-setup-0.4.0.2 - hspec-dirstream-0.3.0.0 - dirstream-1.0.3 - prettyprinter-1.2.0.1