diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -13,11 +13,9 @@ * Simplify distribution of your project * Enable Haskell builds that depend on ATS code * Enable ATS builds that depend on Haskell code - * Ensure reproducible builds via pinned compiler versions * Track all file dependencies * Make contributing to your projects easier * Run builds in parallel (like `make`) - * Handle flags and libraries for garbage collection * Install `patscc` and other ATS tooling * Install manual pages and shell completions * Install ATS libraries @@ -28,15 +26,13 @@ * Give you the full flexibility of the C/ATS ecosystem * Integrate with other ecosystems * Provide a centralized package repository - * Offer a common architecture for package builds * Cache builds locally (like `nix` or `cabal`) ### Example -As an example, the following two lines will install `polyglot`: +As an example, the following will install `polyglot`: ```bash -curl -sSl https://raw.githubusercontent.com/vmchale/atspkg/master/bash/install.sh | bash -s atspkg remote https://github.com/vmchale/polyglot/archive/master.zip ``` @@ -98,7 +94,7 @@ ## Examples You can find several examples with explanation -[here](https://github.com/vmchale/atspkg/blob/master/EXAMPLES.md) +[here](https://github.com/vmchale/atspkg/blob/master/ats-pkg/EXAMPLES.md). ## Global Configuration @@ -106,11 +102,17 @@ set a custom package set as follows: ``` -let cfg = - { defaultPkgs = "https://raw.githubusercontent.com/vmchale/atspkg/master/dhall/pkg-set.dhall" +let version = "master" +in + +let cfg = + { defaultPkgs = "https://raw.githubusercontent.com/vmchale/atspkg/${version}/ats-pkg/pkgs/pkg-set.dhall" , path = ([] : Optional Text) - , githubUsername = "YOUR_USERNAME" + , githubUsername = "vmchale" + , filterErrors = False } - in cfg ``` + +I recommend setting `version` to whichever branch your version of `atspkg` was +built from. diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -4,6 +4,7 @@ ) where import Control.Composition +import Control.Lens hiding (List, argument) import Data.Bool (bool) import Data.Maybe (fromMaybe) import Data.Semigroup (Semigroup (..)) @@ -12,7 +13,6 @@ import Development.Shake.ATS import Development.Shake.FilePath import Language.ATS.Package -import Lens.Micro import Options.Applicative import System.Directory import System.IO.Temp (withSystemTempDirectory) @@ -159,7 +159,7 @@ fetchPkg :: String -> IO () fetchPkg pkg = withSystemTempDirectory "atspkg" $ \p -> do let (lib, dirName, url') = (mempty, p, pkg) & each %~ TL.pack - buildHelper True (ATSDependency lib dirName url' undefined undefined mempty mempty) + buildHelper True (ATSDependency lib dirName url' undefined undefined mempty mempty mempty) ps <- getSubdirs p pkgDir <- fromMaybe p <$> findFile (p:ps) "atspkg.dhall" let a = withCurrentDirectory (takeDirectory pkgDir) (mkPkg False False False mempty ["install"] Nothing 0) @@ -175,7 +175,7 @@ x = [buildAll tgt Nothing] run :: Command -> IO () -run List = displayList "https://raw.githubusercontent.com/vmchale/atspkg/master/pkgs/pkg-set.dhall" +run List = displayList "https://raw.githubusercontent.com/vmchale/atspkg/master/ats-pkg/pkgs/pkg-set.dhall" run (Check p b) = print =<< checkPkg p b run Upgrade = upgradeBin "vmchale" "atspkg" run Nuke = cleanAll 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.7.0.10 +version: 2.7.0.22 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2018 Vanessa McHale @@ -13,7 +13,6 @@ category: Development, ATS build-type: Custom extra-source-files: - stack.yaml man/atspkg.1 dhall/config.dhall dhall/atslib.dhall @@ -49,12 +48,13 @@ Paths_ats_pkg Distribution.ATS.Build Language.ATS.Package.Build - Language.ATS.Package.Build.IO + Language.ATS.Package.Build.C Language.ATS.Package.Compiler Language.ATS.Package.Config Language.ATS.Package.Dependency Language.ATS.Package.Dhall Language.ATS.Package.Error + Language.ATS.Package.Generic Language.ATS.Package.PackageSet Language.ATS.Package.Type Language.ATS.Package.Upgrade @@ -79,11 +79,12 @@ text -any, directory -any, process -any, + hashable, containers -any, parallel-io -any, unix -any, - microlens -any, - microlens-th -any, + lens -any, + mtl, dhall >=1.10.0, ansi-wl-pprint -any, shake-ats >=1.3.0.0, @@ -112,7 +113,7 @@ base -any, ats-pkg -any, optparse-applicative -any, - microlens -any, + lens -any, shake-ats -any, temporary -any, directory -any, diff --git a/dhall/atslib.dhall b/dhall/atslib.dhall --- a/dhall/atslib.dhall +++ b/dhall/atslib.dhall @@ -35,7 +35,7 @@ in {- ATSPackage parts -} -let prelude = https://raw.githubusercontent.com/vmchale/atspkg/master/dhall/atspkg-prelude.dhall +let prelude = https://raw.githubusercontent.com/vmchale/atspkg/master/ats-pkg/dhall/atspkg-prelude.dhall in prelude.default // { libraries = diff --git a/dhall/config.dhall b/dhall/config.dhall --- a/dhall/config.dhall +++ b/dhall/config.dhall @@ -2,7 +2,7 @@ in let cfg = - { defaultPkgs = "https://raw.githubusercontent.com/vmchale/atspkg/${version}/pkgs/pkg-set.dhall" + { defaultPkgs = "https://raw.githubusercontent.com/vmchale/atspkg/${version}/ats-pkg/pkgs/pkg-set.dhall" , path = ([] : Optional Text) , githubUsername = "" , filterErrors = False diff --git a/man/atspkg.1 b/man/atspkg.1 --- a/man/atspkg.1 +++ b/man/atspkg.1 @@ -1,4 +1,4 @@ -.\" Automatically generated by Pandoc 2.1.1 +.\" Automatically generated by Pandoc 2.1.2 .\" .TH "atspkg (1)" "" "" "" "" .hy 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 @@ -13,6 +13,8 @@ , atspkgVersion -- * Functions involving the compiler , packageCompiler + -- * Functions for generic packaging + , atsInstallDirs -- * Types , Version (..) , Pkg (..) @@ -26,6 +28,11 @@ , LibDep , DepSelector , PackageError (..) + -- * Generic Packaging + , Package (..) + , InstallDirs (..) + -- * Typeclasses + , GenericPackage (..) -- * Lenses , dirLens ) where @@ -36,6 +43,7 @@ import Language.ATS.Package.Dependency import Language.ATS.Package.Dhall import Language.ATS.Package.Error +import Language.ATS.Package.Generic import Language.ATS.Package.PackageSet import Language.ATS.Package.Type import Language.ATS.Package.Upgrade 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,6 +20,7 @@ import Development.Shake.Clean import Development.Shake.Man import Distribution.ATS.Version +import Language.ATS.Package.Build.C import Language.ATS.Package.Compiler import Language.ATS.Package.Config import Language.ATS.Package.Dependency @@ -41,7 +42,7 @@ -> IO () buildAll tgt' p = on (>>) (=<< wants p) fetchDef setupDef where fetchDef = fetchCompiler - setupDef = setupCompiler tgt' + setupDef = setupCompiler atslibSetup tgt' -- | Build a set of targets build :: [String] -- ^ Targets @@ -62,17 +63,17 @@ mkInstall tgt = "install" ~> do config <- getConfig Nothing - let libs = fmap (unpack . libTarget) . libraries $ config + 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) + need (bins <> libs') home <- liftIO $ getEnv "HOME" let g str = fmap (((home <> str) <>) . takeFileName) - binDest = g "/.local/bin" bins - libDest = ((home <> "/.atspkg/" <> libDir <> "lib/") <>) . takeFileName <$> libs + 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) + zipWithM_ copyFile' (bins ++ libs' ++ incs) (binDest ++ libDest ++ inclDest) pa <- pandoc case man config of Just mt -> if not pa then pure () else do @@ -101,7 +102,6 @@ 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' @@ -151,8 +151,6 @@ , shakeChange = ChangeModtimeAndDigestInput , shakeVerbosity = toVerbosity v , shakeTimings = tim - -- shakeLintIgnore = TODO this should - -- include generated ATS? } rebuildTargets :: Bool -- ^ Force rebuild of all targets @@ -213,12 +211,23 @@ noConstr :: ATSConstraint noConstr = ATSConstraint Nothing Nothing +atslibSetup :: Maybe String -- ^ Optional target triple + -> String -- ^ Library name + -> FilePath -- ^ Filepath + -> IO () +atslibSetup tgt' lib' p = do + putStrLn $ "installing " ++ lib' ++ "..." + subdirs <- allSubdirs p + pkgPath <- fromMaybe p <$> findFile subdirs "atspkg.dhall" + let installDir = takeDirectory pkgPath + buildAll tgt' (Just installDir) + pkgToAction :: [IO ()] -- ^ Setup actions to be performed -> [String] -- ^ Targets -> 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) = +pkgToAction setup rs tgt ~(Pkg bs ts lbs mt _ v v' ds cds bdeps ccLocal cf as) = unless (rs == ["clean"]) $ do @@ -229,14 +238,14 @@ 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 "" + liftIO $ fetchDeps (ccFromString cc') setup (unpack . fst <$> ds) (unpack . fst <$> cdps) (unpack . fst <$> bdeps) cfgBin' atslibSetup False >> writeFile out "" let bins = unpack . target <$> bs setTargets rs bins mt cDepsRules >> bits tgt rs - mapM_ h libs + mapM_ h lbs mapM_ g (bs ++ ts) @@ -249,7 +258,7 @@ k False = SharedLibrary k True = StaticLibrary - atsToolConfig = ATSToolConfig v v' False (ccFromString cc') + atsToolConfig = ATSToolConfig v v' False (ccFromString cc') False cDepsRules = unless (null as) $ do let targets = fmap (unpack . cTarget) as @@ -259,7 +268,7 @@ cc' = maybe (unpack ccLocal) (<> "-gcc") tgt deps = (specialDeps:) . (".atspkg/config":) . fmap unpack - unpackBoth :: (Text, Text, Bool) -> (String, String, Bool) - unpackBoth = over _1 unpack . over _2 unpack + unpackBoth :: (Text, Text, Bool) -> ATSGen + unpackBoth (t, t', b)= ATSGen (unpack t) (unpack t') b specialDeps = ".atspkg/deps" ++ maybe mempty ("-" <>) tgt diff --git a/src/Language/ATS/Package/Build/C.hs b/src/Language/ATS/Package/Build/C.hs new file mode 100644 --- /dev/null +++ b/src/Language/ATS/Package/Build/C.hs @@ -0,0 +1,52 @@ +module Language.ATS.Package.Build.C ( clibSetup + , pkgHome + , allSubdirs + ) where + +import Development.Shake.ATS +import Development.Shake.C +import Quaalude + +pkgHome :: CCompiler -> IO FilePath +pkgHome cc' = (++ ("/.atspkg/" ++ ccToDir cc')) <$> getEnv "HOME" + +allSubdirs :: FilePath -> IO [FilePath] +allSubdirs [] = pure mempty +allSubdirs d = do + d' <- listDirectory d + let d'' = ((d <> "/") <>) <$> d' + ds <- filterM doesDirectoryExist d'' + ds' <- mapM allSubdirs ds + pure $ join (ds : ds') + +clibSetup :: CCompiler -- ^ C compiler + -> String -- ^ Library name + -> FilePath -- ^ Filepath to unpack to + -> IO () +clibSetup cc' lib' p = do + + -- Find configure script and make it executable + subdirs <- allSubdirs p + configurePath <- fromMaybe (p <> "/configure") <$> findFile subdirs "configure" + setFileMode configurePath ownerModes + + -- Set environment variables for configure script + h <- pkgHome cc' + let procEnv = Just [("CC", ccToString cc'), ("CFLAGS" :: String, "-I" <> h <> "include"), ("PATH", "/usr/bin:/bin")] + + biaxe [configure h configurePath procEnv, make, install] lib' p + +configure :: FilePath -> FilePath -> Maybe [(String, String)] -> String -> FilePath -> IO () +configure prefixPath configurePath procEnv lib' p = + putStrLn ("configuring " ++ lib' ++ "...") >> + silentCreateProcess ((proc configurePath ["--prefix", prefixPath, "--host", host]) { cwd = Just p, env = procEnv }) + +make :: String -> FilePath -> IO () +make lib' p = + putStrLn ("building " ++ lib' ++ "...") >> + silentCreateProcess ((proc "make" []) { cwd = Just p }) + +install :: String -> FilePath -> IO () +install lib' p = + putStrLn ("installing " ++ lib' ++ "...") >> + silentCreateProcess ((proc "make" ["install"]) { cwd = Just p }) diff --git a/src/Language/ATS/Package/Build/IO.hs b/src/Language/ATS/Package/Build/IO.hs deleted file mode 100644 --- a/src/Language/ATS/Package/Build/IO.hs +++ /dev/null @@ -1,57 +0,0 @@ -module Language.ATS.Package.Build.IO ( clibSetup - , maybeExit - , pkgHome - , allSubdirs - ) where - -import Development.Shake.ATS -import Development.Shake.C -import Quaalude - -pkgHome :: CCompiler -> IO FilePath -pkgHome cc' = (++ ("/.atspkg/" ++ ccToDir cc')) <$> getEnv "HOME" - -allSubdirs :: FilePath -> IO [FilePath] -allSubdirs [] = pure mempty -allSubdirs d = do - d' <- listDirectory d - let d'' = ((d <> "/") <>) <$> d' - ds <- filterM doesDirectoryExist d'' - ds' <- mapM allSubdirs ds - pure $ join (ds : ds') - -maybeExit :: ExitCode -> IO () -maybeExit ExitSuccess = pure () -maybeExit x = exitWith x - -clibSetup :: CCompiler -- ^ C compiler - -> String -- ^ Library name - -> FilePath -- ^ Filepath to unpack to - -> IO () -clibSetup cc' lib' p = do - - -- Find configure script and make it executable - subdirs <- allSubdirs p - configurePath <- fromMaybe (p <> "/configure") <$> findFile subdirs "configure" - setFileMode configurePath ownerModes - - -- Set environment variables for configure script - h <- pkgHome cc' - let procEnv = Just [("CC", ccToString cc'), ("CFLAGS" :: String, "-I" <> h <> "include"), ("PATH", "/usr/bin:/bin")] - - biaxe [configure h configurePath procEnv, make, install] lib' p - -configure :: FilePath -> FilePath -> Maybe [(String, String)] -> String -> FilePath -> IO () -configure prefixPath configurePath procEnv lib' p = - putStrLn ("configuring " ++ lib' ++ "...") >> - silentCreateProcess ((proc configurePath ["--prefix", prefixPath, "--host", host]) { cwd = Just p, env = procEnv }) - -make :: String -> FilePath -> IO () -make lib' p = - putStrLn ("building " ++ lib' ++ "...") >> - silentCreateProcess ((proc "make" []) { cwd = Just p }) - -install :: String -> FilePath -> IO () -install lib' p = - putStrLn ("installing " ++ lib' ++ "...") >> - silentCreateProcess ((proc "make" ["install"]) { cwd = Just p }) 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,15 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} +-- | This module contains functions for installing the @patscc@ compiler. It +-- also includes functions for building @libatslib@. module Language.ATS.Package.Compiler ( packageCompiler , fetchCompiler , setupCompiler , cleanAll + -- * Types + , SetupScript ) where import qualified Codec.Archive.Tar as Tar @@ -62,22 +66,28 @@ withCompiler "Building" v >> silentCreateProcess ((proc "make" []) { cwd = Just cd }) -libInstall :: FilePath -> String -> IO () -libInstall cd triple = +type SetupScript = Maybe String -- ^ Optional target triple + -> String -- ^ Library name + -> FilePath -- ^ File path + -> IO () + +libInstall :: SetupScript -> FilePath -> String -> IO () +libInstall atslibSetup cd triple = unless (triple == "musl") $ mconcat [ putStrLn "Installing cross libraries..." , writeFile (cd ++ "/atspkg.dhall") libatsCfg - , silentCreateProcess ((proc "atspkg" ["install", "--target", triple]) { cwd = Just cd }) + , atslibSetup (Just triple) "atslib" cd ] install :: Maybe String + -> SetupScript -> Version -> FilePath -> IO () -install tgt' v cd = +install tgt' als v cd = withCompiler "Installing" v >> silentCreateProcess ((proc "make" ["install"]) { cwd = Just cd }) >> - maybe mempty (libInstall cd) tgt' + maybe mempty (libInstall als cd) tgt' configure :: FilePath -> Version -> FilePath -> IO () configure configurePath v cd = do @@ -91,12 +101,12 @@ silentCreateProcess ((proc configurePath ["--prefix", cd]) { cwd = Just cd }) -setupCompiler :: Maybe FilePath -> Version -> IO () -setupCompiler tgt' v = do +setupCompiler :: SetupScript -> Maybe FilePath -> Version -> IO () +setupCompiler als tgt' v = do cd <- compilerDir v - biaxe [configure (cd ++ "/configure"), make, install tgt'] v cd + biaxe [configure (cd ++ "/configure"), make, install tgt' als] v cd writeFile (cd ++ "/done") "" 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 @@ -3,6 +3,8 @@ module Language.ATS.Package.Dependency ( -- * Functions fetchDeps , buildHelper + -- * Types + , SetupScript ) where import qualified Codec.Archive.Tar as Tar @@ -14,7 +16,8 @@ import qualified Data.ByteString.Lazy as BSL import qualified Data.Text.Lazy as TL import Development.Shake.ATS -import Language.ATS.Package.Build.IO +import Language.ATS.Package.Build.C +import Language.ATS.Package.Compiler (SetupScript) import Language.ATS.Package.Config import Language.ATS.Package.Error import Language.ATS.Package.PackageSet @@ -32,9 +35,10 @@ -> [String] -- ^ C Dependencies -> [String] -- ^ ATS build dependencies -> FilePath -- ^ Path to configuration file + -> SetupScript -- ^ How to install an ATS library -> Bool -- ^ Whether to perform setup anyhow. -> IO () -fetchDeps cc' setup' deps cdeps atsBld cfgPath b' = +fetchDeps cc' setup' deps cdeps atsBld cfgPath als b' = unless (null deps && null cdeps && null atsBld && b') $ do @@ -53,7 +57,7 @@ clibs = fmap (buildHelper False) (join unpacked) atsLibs = fmap (buildHelper False) (join atsDeps') cBuild = mapM_ (setup cc') <$> transpose unpacked - atsBuild = mapM_ (atsPkgSetup tgt') <$> transpose atsDeps' + atsBuild = mapM_ (atsPkgSetup als tgt') <$> transpose atsDeps' -- Fetch all packages & build compiler parallel' $ join [ setup', libs', clibs, atsLibs ] @@ -68,36 +72,21 @@ parallel' :: [IO ()] -> IO () parallel' = parallel_ . fmap extraWorkerWhileBlocked -waitCreateProcess :: CreateProcess -> IO () -waitCreateProcess = - maybeExit <=< waitForProcess <=< fmap (view _4) . createProcess - -atslibSetup :: Maybe String -- ^ Optional target triple - -> String -- ^ Library name - -> FilePath -- ^ Filepath - -> IO () -atslibSetup tgt' lib' p = do - putStrLn $ "installing " ++ lib' ++ "..." - subdirs <- allSubdirs p - pkgPath <- fromMaybe p <$> findFile subdirs "atspkg.dhall" - let installCmd = "install" : maybe mempty (("--target" :) . pure) tgt' - installDir = takeDirectory pkgPath - waitCreateProcess ((proc "atspkg" installCmd) { cwd = Just installDir, std_out = Inherit }) - -atsPkgSetup :: Maybe String +atsPkgSetup :: SetupScript + -> Maybe String -> ATSDependency -> IO () -atsPkgSetup tgt' (ATSDependency lib' dirName' _ _ _ _ _) = do +atsPkgSetup als tgt' (ATSDependency lib' dirName' _ _ _ _ _ _) = do lib'' <- (<> unpack lib') <$> pkgHome GCCStd b <- doesFileExist lib'' unless b $ do - atslibSetup tgt' (unpack lib') (unpack dirName') + als tgt' (unpack lib') (unpack dirName') writeFile lib'' "" setup :: CCompiler -- ^ C compiler to use -> ATSDependency -- ^ ATSDependency itself -> IO () -setup cc' (ATSDependency lib' dirName' _ _ _ _ _) = do +setup cc' (ATSDependency lib' dirName' _ _ _ _ _ _) = do lib'' <- (<> unpack lib') <$> pkgHome cc' b <- doesFileExist lib'' unless b $ do @@ -124,7 +113,7 @@ extractFilesFromArchive [options] (toArchive response) buildHelper :: Bool -> ATSDependency -> IO () -buildHelper b (ATSDependency lib' dirName' url'' _ _ _ _) = do +buildHelper b (ATSDependency lib' dirName' url'' _ _ _ _ _) = do let (lib, dirName, url') = (lib', dirName', url'') & each %~ unpack isLib = bool "" "library " b diff --git a/src/Language/ATS/Package/Error.hs b/src/Language/ATS/Package/Error.hs --- a/src/Language/ATS/Package/Error.hs +++ b/src/Language/ATS/Package/Error.hs @@ -21,7 +21,7 @@ | DepErr ResolveError instance Pretty PackageError where - pretty (Unrecognized t) = red "Error:" <+> "Unrecognized archive format when unpacking" <#> hang 2 (text t) + pretty (Unrecognized t) = dullred "Error:" <+> "Unrecognized archive format when unpacking" <#> hang 2 (text t) pretty (DepErr d) = pretty d -- TODO monaderror? diff --git a/src/Language/ATS/Package/Generic.hs b/src/Language/ATS/Package/Generic.hs new file mode 100644 --- /dev/null +++ b/src/Language/ATS/Package/Generic.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Language.ATS.Package.Generic ( GenericPackage (..) + , InstallDirs (..) + , Package (..) + -- * Functions + , atsInstallDirs + ) where + +import Control.Monad.Reader (ReaderT) +import Data.Hashable (Hashable (..)) +import Quaalude + +-- | Functions containing installation information about a particular type. +data InstallDirs a = InstallDirs { binDir :: a -> FilePath + , libDir :: a -> String -> FilePath + , includeDir :: a -> FilePath + , includeDeps :: a -> [FilePath] + , libDeps :: a -> [FilePath] + } + +-- | The default set of install dirs for an ATS package. +atsInstallDirs :: Hashable a => IO (InstallDirs a) +atsInstallDirs = do + h <- getEnv "HOME" + let binDir' = h ++ "/.local/bin" + includeDir' = h ++ "/.atspkg/include" + libDeps' = ["/.atspkg/lib"] + includeDeps' = ["/.atspkg/include"] + pure $ InstallDirs (pure binDir') (\pkg n -> "/.atspkg/lib/" ++ n ++ "/" ++ hex (hash pkg)) (pure includeDir') (pure includeDeps') (pure libDeps') + +-- | The package monad provides information about the package to be installed, +-- in particular, the directory for installation and the directories for +-- dependencies. +newtype Package a b = Package { unPack :: ReaderT (InstallDirs a) IO b } + deriving (Functor) + deriving newtype (Applicative, Monad) + +-- | Any type implementing 'GenericPackage' can be depended on by other +-- packages. +class Hashable a => GenericPackage a where + + binRules :: a -> Package a () + libRules :: a -> Package a () + includeRules :: a -> Package a () diff --git a/src/Language/ATS/Package/PackageSet.hs b/src/Language/ATS/Package/PackageSet.hs --- a/src/Language/ATS/Package/PackageSet.hs +++ b/src/Language/ATS/Package/PackageSet.hs @@ -26,7 +26,7 @@ pretty v = text (show v) instance Pretty ATSDependency where - pretty (ATSDependency ln _ url md v _ _) = dullyellow (text (unpack ln)) <#> indent 4 (g md "url:" <+> text (unpack url) <#> "version:" <+> pretty v) <> hardline + pretty (ATSDependency ln _ url md v _ _ _) = dullyellow (text (unpack ln)) <#> indent 4 (g md "url:" <+> text (unpack url) <#> "version:" <+> pretty v) <> hardline where g (Just d) = ("description:" <+> text (unpack d) <#>) g Nothing = id 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 @@ -28,15 +28,17 @@ ) where import Data.Dependency +import Data.Hashable (Hashable) import Development.Shake.ATS import Quaalude data ATSConstraint = ATSConstraint { lower :: Maybe Version , upper :: Maybe Version } - deriving (Eq, Show, Generic, Binary, Interpret) + deriving (Eq, Show, Generic, Binary, Interpret, Hashable) deriving newtype instance Interpret Version +deriving newtype instance Hashable Version type LibDep = (Text, ATSConstraint) @@ -51,8 +53,9 @@ , libVersion :: Version , libDeps :: [LibDep] -- ^ Dependencies to be unpacked , libBldDeps :: [LibDep] -- ^ Dependencies to be built + , libCDeps :: [LibDep] -- ^ C dependencies to be built } - deriving (Eq, Show, Generic, Interpret, Binary) + deriving (Eq, Show, Generic, Interpret, Binary, Hashable) makeLensesFor [("dir", "dirLens")] ''ATSDependency @@ -60,7 +63,7 @@ data TargetPair = TargetPair { hs :: Text , ats :: Text , cpphs :: Bool - } deriving (Eq, Show, Generic, Interpret, Binary) + } deriving (Eq, Show, Generic, Interpret, Binary, Hashable) deriving instance Interpret ForeignCabal @@ -69,7 +72,7 @@ , atsGen :: [TargetPair] , extras :: [Text] } - deriving (Show, Eq, Generic, Interpret, Binary) + deriving (Show, Eq, Generic, Interpret, Binary, Hashable) data Bin = Bin { src :: Text -- ^ Source file (should end with @.dats@) , target :: Text -- ^ Binary to be built @@ -79,7 +82,7 @@ , gcBin :: Bool -- ^ Whether to use the garbage collector , extras :: [Text] -- ^ Extra source files the build depends on } - deriving (Show, Eq, Generic, Interpret, Binary) + deriving (Show, Eq, Generic, Interpret, Binary, Hashable) data Lib = Lib { name :: Text -- ^ Name of library being provided , src :: [Text] -- ^ Source files (should end with @.dats@) to be compiled to object files @@ -92,7 +95,7 @@ , extras :: [Text] -- ^ Other source files the build depends on , static :: Bool -- ^ Whether to make a static library } - deriving (Show, Eq, Generic, Interpret, Binary) + deriving (Show, Eq, Generic, Interpret, Binary, Hashable) -- | Data type associated with @atspkg.dhall@ file. data Pkg = Pkg { bin :: [Bin] -- ^ List of binaries to be built @@ -109,4 +112,4 @@ , cflags :: [Text] -- ^ List of flags to pass to the C compiler , atsSource :: [Src] -- ^ ATS source to be compile to C. } - deriving (Show, Eq, Generic, Interpret, Binary) + deriving (Show, Eq, Generic, Interpret, Binary, Hashable) diff --git a/src/Quaalude.hs b/src/Quaalude.hs --- a/src/Quaalude.hs +++ b/src/Quaalude.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} -module Quaalude ( bool +module Quaalude ( hex + , bool , intersperse , transpose , sortBy @@ -90,7 +91,7 @@ , (<+>) , text , punctuate - , red + , dullred , dullyellow , hardline , hang @@ -117,6 +118,7 @@ #endif import Control.Arrow hiding ((<+>)) import Control.Composition +import Control.Lens hiding (both) import Control.Monad import Control.Monad.IO.Class import Data.Binary @@ -129,11 +131,9 @@ 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 Numeric (showHex) import System.Directory as X import System.Environment (getEnv) import System.Exit (ExitCode (ExitSuccess), exitWith) @@ -143,6 +143,9 @@ import Text.PrettyPrint.ANSI.Leijen hiding (bool, (<>)) infixr 5 <#> + +hex :: Int -> String +hex = flip showHex mempty -- | Same as "Text.PrettyPrint.ANSI.Leijen"'s @<$>@, but doesn't clash with the -- prelude. diff --git a/stack.yaml b/stack.yaml deleted file mode 100644 --- a/stack.yaml +++ /dev/null @@ -1,20 +0,0 @@ ---- -resolver: lts-10.7 -packages: - - '.' - - 'shake-ats' - - 'dependency' -extra-deps: - - dhall-1.10.0 - - shake-ext-2.7.0.0 - - composition-prelude-1.3.0.4 - - language-ats-1.2.0.1 - - cli-setup-0.2.0.1 - - 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 -extra-package-dbs: []