diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -4,7 +4,6 @@ ) where import Control.Composition -import Control.Lens hiding (List, argument) import Data.Bool (bool) import Data.Maybe (fromMaybe) import Data.Semigroup (Semigroup (..)) @@ -13,6 +12,7 @@ import Development.Shake.ATS import Development.Shake.FilePath import Language.ATS.Package +import Lens.Micro import Options.Applicative import qualified Paths_ats_pkg as P import System.Directory 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.11 +version: 2.6.1.16 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2018 Vanessa McHale @@ -42,21 +42,23 @@ library exposed-modules: Language.ATS.Package - build-tools: cpphs -any + Distribution.ATS hs-source-dirs: src other-modules: Paths_ats_pkg - Language.ATS.Package.Error - Language.ATS.Package.Type - Language.ATS.Package.Dependency - Language.ATS.Package.Compiler + Distribution.ATS.Build + Distribution.ATS.Compiler Language.ATS.Package.Build - Language.ATS.Package.Build.Cabal Language.ATS.Package.Build.IO - Language.ATS.Package.Upgrade + Language.ATS.Package.Compiler Language.ATS.Package.Config - Language.ATS.Package.PackageSet + Language.ATS.Package.Dependency Language.ATS.Package.Dhall + Language.ATS.Package.Error + Language.ATS.Package.PackageSet + Language.ATS.Package.Type + Language.ATS.Package.Upgrade + System.Process.Ext Quaalude default-language: Haskell2010 ghc-options: -Wall -Wincomplete-uni-patterns @@ -79,17 +81,18 @@ containers -any, parallel-io -any, unix -any, - lens -any, - dhall >=1.9.0, + microlens -any, + microlens-th -any, + dhall >=1.10.0, ansi-wl-pprint -any, shake-ats >=1.3.0.0, - shake-ext >=2.3.0.0, + shake-ext >=2.6.0.0, composition-prelude >=1.3.0.0, zip-archive -any, ansi-wl-pprint -any, binary -any, dependency -any, - ats-setup >=0.3.1.1 + filemanip -any if flag(development) ghc-options: -Werror @@ -102,17 +105,19 @@ default-language: Haskell2010 ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat - build-depends: - base -any, - ats-pkg -any, - optparse-applicative -any, - lens -any, - shake-ats -any, - temporary -any, - directory -any, - composition-prelude -any, - text -any, - shake -any + + if !flag(no-executable) + build-depends: + base -any, + ats-pkg -any, + optparse-applicative -any, + microlens -any, + shake-ats -any, + temporary -any, + directory -any, + composition-prelude -any, + text -any, + shake -any if flag(no-executable) buildable: False diff --git a/src/Distribution/ATS.hs b/src/Distribution/ATS.hs new file mode 100644 --- /dev/null +++ b/src/Distribution/ATS.hs @@ -0,0 +1,138 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Distribution.ATS ( cleanATSCabal + , atsUserHooks + , atsLibUserHooks + , fetchDependencies + -- * Types + , Version + , ATSDependency (..) + -- * Libraries + , libgmp + , intinf + , atsPrelude + , atsContrib + -- * Cabal helper functions + , cabalHooks + , atsPolyglotBuild + -- * Functions involving the compiler + , fetchCompiler + , setupCompiler + , packageCompiler + ) where + +import qualified Codec.Archive.Tar as Tar +import Codec.Compression.GZip (decompress) +import Control.Concurrent.ParallelIO.Global +import Control.Monad +import Data.Bool +import qualified Data.Dependency as Dep +import Distribution.ATS.Build +import Distribution.ATS.Compiler +import Distribution.PackageDescription +import Distribution.Simple +import Distribution.Simple.LocalBuildInfo +import Distribution.Simple.Setup +import Network.HTTP.Client hiding (decompress) +import Network.HTTP.Client.TLS (tlsManagerSettings) +import System.Directory + + +data ATSDependency = ATSDependency { _libName :: String -- ^ Library name + , _filepath :: FilePath -- ^ Directory to unpack library into + , _url :: String -- ^ URL of tarball containing ATS library. + } + +maybeCleanBuild :: LocalBuildInfo -> IO () +maybeCleanBuild li = + let cf = configConfigurationsFlags (configFlags li) in + + unless ((mkFlagName "development", True) `elem` cf) $ + 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) +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 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" + +-- | 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" + +-- | ATS prelude +atsPrelude :: Dep.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 + +fetchDependencies :: ConfigFlags -> [ATSDependency] -> IO () +fetchDependencies cfs = + bool act nothing cond + where act = (>> stopGlobalPool) . parallel_ . fmap fetchDependency + nothing = pure mempty + cond = (mkFlagName "with-atsdeps", False) `elem` configConfigurationsFlags cfs + +fetchDependency :: ATSDependency -> IO () +fetchDependency (ATSDependency libNameATS dirName url) = do + + needsSetup <- not <$> doesFileExist (dirName ++ "/unpacked") + + when needsSetup $ do + + let doing str = putStrLn (str ++ " library " ++ libNameATS ++ "...") + doing "Fetching" + manager <- newManager tlsManagerSettings + initialRequest <- parseRequest url + response <- responseBody <$> httpLbs (initialRequest { method = "GET" }) manager + + doing "Unpacking" + Tar.unpack dirName . Tar.read . decompress $ response + + doing "Setting up" + writeFile (dirName ++ "/unpacked") "" + needsMove <- doesDirectoryExist (dirName ++ "/package") + when needsMove $ do + renameDirectory (dirName ++ "/package") "tempdir" + removeDirectoryRecursive dirName + renameDirectory "tempdir" dirName diff --git a/src/Distribution/ATS/Build.hs b/src/Distribution/ATS/Build.hs new file mode 100644 --- /dev/null +++ b/src/Distribution/ATS/Build.hs @@ -0,0 +1,45 @@ +-- | Integration with @Cabal@. +module Distribution.ATS.Build ( cabalHooks + , atsPolyglotBuild + ) where + +import Distribution.PackageDescription +import Distribution.Simple +import Distribution.Simple.LocalBuildInfo +import Language.ATS.Package.Build +import Quaalude + +atsPolyglotBuild :: IO () +atsPolyglotBuild = defaultMainWithHooks cabalHooks + +configureCabal :: IO LocalBuildInfo -> IO LocalBuildInfo +configureCabal = (<*>) $ do + build mempty + libDir <- (<> "/") <$> getCurrentDirectory + pure (modifyConf libDir) + +modifyBuildInfo :: String -> BuildInfo -> BuildInfo +modifyBuildInfo libDir bi = let olds = extraLibDirs bi + in bi { extraLibDirs = (libDir <>) <$> olds } + +modifyConf :: String -> LocalBuildInfo -> LocalBuildInfo +modifyConf libDir bi = let old = localPkgDescr bi + in bi { localPkgDescr = modifyPkgDescr libDir old } + +modifyPkgDescr :: String -> PackageDescription -> PackageDescription +modifyPkgDescr libDir pd = let old = library pd + in pd { library = fmap (modifyLibrary libDir) old } + +modifyLibrary :: String -> Library -> Library +modifyLibrary libDir lib = let old = libBuildInfo lib + in lib { libBuildInfo = modifyBuildInfo libDir old } + +writeDummyFile :: IO () +writeDummyFile = + createDirectoryIfMissing True "dist-newstyle/lib" >> + writeFile "dist-newstyle/lib/empty" "" + +cabalHooks :: UserHooks +cabalHooks = let defConf = confHook simpleUserHooks + in simpleUserHooks { preConf = \_ _ -> writeDummyFile >> pure emptyHookedBuildInfo + , confHook = configureCabal .* defConf } diff --git a/src/Distribution/ATS/Compiler.hs b/src/Distribution/ATS/Compiler.hs new file mode 100644 --- /dev/null +++ b/src/Distribution/ATS/Compiler.hs @@ -0,0 +1,89 @@ +{-# 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/Language/ATS/Package.hs b/src/Language/ATS/Package.hs --- a/src/Language/ATS/Package.hs +++ b/src/Language/ATS/Package.hs @@ -10,9 +10,6 @@ -- * Ecosystem functionality , displayList , upgradeBin - -- * Cabal helper functions - , cabalHooks - , atsPolyglotBuild -- * Types , Version (..) , Pkg (..) @@ -31,7 +28,6 @@ ) where import Language.ATS.Package.Build -import Language.ATS.Package.Build.Cabal import Language.ATS.Package.Compiler import Language.ATS.Package.Dependency import Language.ATS.Package.Dhall 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 @@ -20,7 +20,7 @@ import Development.Shake.Check import Development.Shake.Clean import Development.Shake.Man -import Language.ATS.Package.Compiler +import Distribution.ATS.Compiler import Language.ATS.Package.Config import Language.ATS.Package.Dependency import Language.ATS.Package.Type hiding (Version) @@ -38,7 +38,9 @@ -- | Build in current directory or indicated directory buildAll :: Maybe FilePath -> IO () -buildAll p = on (>>) (=<< wants p) fetchCompiler setupCompiler +buildAll p = on (>>) (=<< wants p) fetchDef setupDef + where fetchDef = fetchCompiler Nothing + setupDef = setupCompiler Nothing -- | Build a set of targets build :: [String] -- ^ Targets @@ -137,19 +139,21 @@ -> [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 - } + , shakeThreads = 4 + , shakeLint = bool Nothing (Just LintBasic) lint + , shakeVersion = showVersion P.version + , shakeRebuild = rebuildTargets rba rs + , shakeChange = ChangeModtimeAndDigestInput + , shakeVerbosity = toVerbosity v + } rebuildTargets :: Bool -- ^ Force rebuild of all targets - -> [a] -- ^ Targets - -> [(Rebuild, a)] -rebuildTargets rba rs = foldMap g [ (rba, (RebuildNow ,) <$> rs) ] + -> [String] -- ^ Targets + -> [(Rebuild, String)] +rebuildTargets rba rs = foldMap g [ (rba, (RebuildNow ,) <$> patterns rs) ] where g (b, ts) = bool mempty ts b + patterns = thread (mkPattern <$> ["c", "o", "so", "a"]) + mkPattern ext = ("//*." <> ext :) cleanConfig :: (MonadIO m) => [String] -> m Pkg cleanConfig ["clean"] = pure undefined diff --git a/src/Language/ATS/Package/Build/Cabal.hs b/src/Language/ATS/Package/Build/Cabal.hs deleted file mode 100644 --- a/src/Language/ATS/Package/Build/Cabal.hs +++ /dev/null @@ -1,45 +0,0 @@ --- | Integration with @Cabal@. -module Language.ATS.Package.Build.Cabal ( cabalHooks - , atsPolyglotBuild - ) where - -import Distribution.PackageDescription -import Distribution.Simple -import Distribution.Simple.LocalBuildInfo -import Language.ATS.Package.Build -import Quaalude - -atsPolyglotBuild :: IO () -atsPolyglotBuild = defaultMainWithHooks cabalHooks - -configureCabal :: IO LocalBuildInfo -> IO LocalBuildInfo -configureCabal = (<*>) $ do - build mempty - libDir <- (<> "/") <$> getCurrentDirectory - pure (modifyConf libDir) - -modifyBuildInfo :: String -> BuildInfo -> BuildInfo -modifyBuildInfo libDir bi = let olds = extraLibDirs bi - in bi { extraLibDirs = (libDir <>) <$> olds } - -modifyConf :: String -> LocalBuildInfo -> LocalBuildInfo -modifyConf libDir bi = let old = localPkgDescr bi - in bi { localPkgDescr = modifyPkgDescr libDir old } - -modifyPkgDescr :: String -> PackageDescription -> PackageDescription -modifyPkgDescr libDir pd = let old = library pd - in pd { library = fmap (modifyLibrary libDir) old } - -modifyLibrary :: String -> Library -> Library -modifyLibrary libDir lib = let old = libBuildInfo lib - in lib { libBuildInfo = modifyBuildInfo libDir old } - -writeDummyFile :: IO () -writeDummyFile = - createDirectoryIfMissing True "dist-newstyle/lib" >> - writeFile "dist-newstyle/lib/empty" "" - -cabalHooks :: UserHooks -cabalHooks = let defConf = confHook simpleUserHooks - in simpleUserHooks { preConf = \_ _ -> writeDummyFile >> pure emptyHookedBuildInfo - , confHook = configureCabal .* defConf } 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 @@ -3,12 +3,8 @@ -- | This module contains scripts to fetch the compiler. module Language.ATS.Package.Compiler ( cleanAll - , fetchCompiler - , setupCompiler ) where -import Data.Dependency -import qualified Distribution.ATS as X import Quaalude cleanAll :: IO () @@ -18,9 +14,3 @@ when b $ do putStrLn "Cleaning everything..." removeDirectoryRecursive d - -fetchCompiler :: Version -> IO () -fetchCompiler = X.fetchCompiler Nothing - -setupCompiler :: Version -> IO () -setupCompiler = X.setupCompiler Nothing diff --git a/src/Quaalude.hs b/src/Quaalude.hs --- a/src/Quaalude.hs +++ b/src/Quaalude.hs @@ -38,6 +38,7 @@ , biaxe , (.*) , (.**) + , thread -- * Dhall reëxports , Interpret , Generic @@ -111,9 +112,11 @@ ) where import Control.Arrow hiding ((<+>)) -import Control.Lens hiding (both) 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 diff --git a/src/System/Process/Ext.hs b/src/System/Process/Ext.hs new file mode 100644 --- /dev/null +++ b/src/System/Process/Ext.hs @@ -0,0 +1,9 @@ +module System.Process.Ext ( silentCreateProcess + ) where + +import Control.Monad +import System.Process + +silentCreateProcess :: CreateProcess -> IO () +silentCreateProcess proc' = + void $ readCreateProcess (proc' { std_err = CreatePipe }) "" diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,10 +1,9 @@ --- -resolver: lts-10.6 +resolver: lts-10.7 packages: - '.' - - 'dependency' - 'shake-ats' - - 'hs2ats' + - 'dependency' extra-deps: - dhall-1.10.0 - shake-ext-2.6.0.0 @@ -15,6 +14,7 @@ - hspec-dirstream-0.3.0.0 - dirstream-1.0.3 - prettyprinter-1.2.0.1 + - hs2ats-0.2.1.7 flags: ats-pkg: development: false