diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -3,7 +3,7 @@ bin/mcabal: src/MicroCabal/*.hs src/MicroCabal/*/*.hs @mkdir -p bin - MHSDIR=$(MHSDIR) $(MHS) -C -isrc -obin/mcabal MicroCabal.Main + MHSDIR=$(MHSDIR) $(MHS) -isrc -obin/mcabal MicroCabal.Main bin/gmcabal: src/MicroCabal/*.hs src/MicroCabal/*/*.hs @mkdir -p bin diff --git a/MicroCabal.cabal b/MicroCabal.cabal --- a/MicroCabal.cabal +++ b/MicroCabal.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: MicroCabal -version: 0.2.1.1 +version: 0.3.1.0 synopsis: A partial Cabal replacement license: Apache-2.0 license-file: LICENSE @@ -32,6 +32,7 @@ MicroCabal.Cabal MicroCabal.Env MicroCabal.Glob + MicroCabal.Macros MicroCabal.Normalize MicroCabal.Parse MicroCabal.Regex @@ -39,6 +40,9 @@ MicroCabal.Unix MicroCabal.YAML Text.ParserComb - build-depends: base >= 4.10 && < 4.25, + if impl(ghc) + build-depends: base >= 4.10 && < 4.25, directory >= 1.3 && < 1.6, process >= 1.6 && < 1.9, + if impl(mhs) + build-depends: base >= 0.1 && < 10.0, diff --git a/src/MicroCabal/Backend/GHC.hs b/src/MicroCabal/Backend/GHC.hs --- a/src/MicroCabal/Backend/GHC.hs +++ b/src/MicroCabal/Backend/GHC.hs @@ -5,6 +5,7 @@ import System.Directory import MicroCabal.Cabal import MicroCabal.Env +import MicroCabal.Macros import MicroCabal.Parse(readVersion) import MicroCabal.Unix @@ -74,14 +75,22 @@ deps = getBuildDependsPkg flds lang = maybe [] (\ s -> ["-X" ++ s]) mlang buildDir <- getBuildDir env - return $ [ "-package-env=-", "-package-db=" ++ db, "-outputdir=" ++ buildDir, "-w"] ++ - map ("-i" ++) srcDirs ++ - ["-i" ++ pathModuleDir env] ++ - map ("-I" ++) incDirs ++ - map ("-X" ++) exts ++ - lang ++ - map ("-package " ++) deps ++ - opts ++ cppOpts + depvers <- mapM (getPackageVersion env) deps + let macros = genPkgVersionMacros (zip deps depvers) + return $ + [ "-package-env=-", + "-package-db=" ++ db, + "-outputdir=" ++ buildDir, + "-w"] ++ + map ("-i" ++) srcDirs ++ + ["-i" ++ pathModuleDir env] ++ + map ("-I" ++) incDirs ++ + map ("-X" ++) exts ++ + lang ++ + map ("-package " ++) deps ++ + opts ++ + macros ++ + cppOpts binGhc :: FilePath binGhc = "bin" "ghc" @@ -143,16 +152,23 @@ let bin = distDir env ++ binGhc ++ name binDir = cabalDir env "bin" mkdir env binDir - cp env bin (binDir name) + cpr env bin (binDir name) +getPackageField :: String -> Env -> PackageName -> IO PackageName +getPackageField fld env n = do + mr <- tryCmdOut env $ "ghc-pkg field " ++ n ++ " " ++ fld ++ " 2>/dev/null" -- returns "fld: val" + last . words <$> + case mr of + Just r -> return r + Nothing -> do + dir <- getGhcDir env + cmdOut env ("ghc-pkg field --package-db=" ++ dir ++ " " ++ n ++ " " ++ fld) -- returns "fld: val" + getPackageId :: Env -> PackageName -> IO PackageName -getPackageId env n = do - mr <- tryCmdOut env $ "ghc-pkg field " ++ n ++ " id 2>/dev/null" -- returns "id: pkg-id" - case mr of - Just r -> return $ last $ words r - Nothing -> do - dir <- getGhcDir env - last . words <$> cmdOut env ("ghc-pkg field --package-db=" ++ dir ++ " " ++ n ++ " id") -- returns "id: pkg-id" +getPackageId = getPackageField "id" + +getPackageVersion :: Env -> PackageName -> IO Version +getPackageVersion env n = readVersion <$> getPackageField "version" env n ghcInstallLib :: Env -> Section -> Section -> IO () ghcInstallLib env (Section _ _ glob) (Section _ name flds) = do diff --git a/src/MicroCabal/Backend/MHS.hs b/src/MicroCabal/Backend/MHS.hs --- a/src/MicroCabal/Backend/MHS.hs +++ b/src/MicroCabal/Backend/MHS.hs @@ -1,10 +1,11 @@ module MicroCabal.Backend.MHS(mhsBackend) where import Control.Monad -import Data.List(dropWhileEnd, (\\)) +import Data.List(dropWhileEnd, (\\), stripPrefix) import Data.Version import System.Directory import MicroCabal.Cabal import MicroCabal.Env +import MicroCabal.Macros import MicroCabal.Parse(readVersion) import MicroCabal.Unix @@ -43,7 +44,7 @@ mkdir env (dir "packages") mhsExists :: Env -> PackageName -> IO Bool -mhsExists _ pkgname | pkgname `elem` builtinPackages = return True +mhsExists _ pkgname | Just _ <- lookup pkgname builtinPackages = return True mhsExists env pkgname = do initDB env dir <- getMhsDir env @@ -51,11 +52,34 @@ return $ any ((== pkgname) . init . dropWhileEnd (/= '-')) pkgs -- XXX These packages are part of mhs. -builtinPackages :: [String] -builtinPackages = ["array", "base", "deepseq", "directory", "process", "bytestring", "text", "fail"] +-- The version numbers are totally fake. +-- The version numbers are from GHC 9.8.2 +builtinPackages :: [(String, Version)] +builtinPackages = [ + ("array", makeVersion [0,5,6,0]), + ("base", makeVersion [4,19,1,0]), + ("deepseq", makeVersion [1,5,0,0]), + ("directory", makeVersion [1,3,8,1]), + ("hashable", makeVersion [1,0,0,0]), -- very rudimentary + ("process", makeVersion [1,6,18,0]), + ("bytestring",makeVersion [0,12,1,0]), + ("text", makeVersion [2,1,1]) + ] -setupStdArgs :: Env -> [Field] -> [String] -setupStdArgs _env flds = +getPackageVersion :: Env -> String -> IO Version +getPackageVersion _ pkgName | Just v <- lookup pkgName builtinPackages = return v +getPackageVersion env pkgName = do + dir <- getMhsDir env + pkgs <- listDirectory (dir "packages") + let n = pkgName ++ "-" + case [ readVersion vers | p <- pkgs, Just verspkg <- [stripPrefix n p], Just vers <- [stripSuffix ".pkg" verspkg] ] of + [v] -> return v + [] -> error $ "Not installed: " ++ pkgName + _ -> error $ "Multiple version: " ++ pkgName + +setupStdArgs :: Env -> [Field] -> IO [String] +setupStdArgs env flds = do + -- db <- getMhsDir env let srcDirs = getFieldStrings flds ["."] "hs-source-dirs" defExts = getFieldStrings flds [] "default-extensions" exts = getFieldStrings flds defExts "extensions" @@ -64,12 +88,18 @@ cppOpts = getFieldStrings flds [] "cpp-options" incs = getFieldStrings flds [] "include-dirs" exts' = filter (`elem` mhsX) (exts ++ oexts) + deps = getBuildDependsPkg flds mhsX = ["CPP"] - in -- ["-i"] ++ - map ("-i" ++) srcDirs ++ - map ("-X" ++) exts' ++ - map ("-I" ++) incs ++ - opts ++ cppOpts + depvers <- mapM (getPackageVersion env) deps + let macros = genPkgVersionMacros (zip deps depvers) + return $ -- ["-i"] ++ + map ("-i" ++) srcDirs ++ + ["-i" ++ pathModuleDir env] ++ + map ("-X" ++) exts' ++ + map ("-I" ++) incs ++ + opts ++ + macros ++ + cppOpts binMhs :: String binMhs = "bin" "mhs" @@ -82,7 +112,8 @@ bin = distDir env binMhs name mkdir env $ distDir env binMhs mainIs' <- findMainIs env srcDirs mainIs - let args = unwords $ setupStdArgs env flds ++ + stdArgs <- setupStdArgs env flds + let args = unwords $ stdArgs ++ ["-a." ,"-o" ++ bin, mainIs'] when (verbose env >= 0) $ @@ -112,13 +143,15 @@ mhsBuildLib :: Env -> Section -> Section -> IO () mhsBuildLib env (Section _ _ glob) (Section _ name flds) = do initDB env + stdArgs <- setupStdArgs env flds let mdls = getFieldStrings flds (error "no exposed-modules") "exposed-modules" omdls = getFieldStrings flds [] "other-modules" vers = getVersion glob "version" namever = name ++ "-" ++ showVersion vers pkgfn = namever ++ ".pkg" - args = unwords $ ["-P" ++ namever, "-o" ++ pkgfn] ++ - setupStdArgs env flds ++ + args = unwords $ ["-P" ++ namever, + "-o" ++ pkgfn] ++ + stdArgs ++ ["-a."] ++ mdls isMdl (' ':_) = True -- Relies on -L output format @@ -134,7 +167,8 @@ mhsInstallExe env (Section _ _ _glob) (Section _ name _) = do let bin = distDir env binMhs name binDir = cabalDir env "bin" - cp env bin (binDir name) + mkdir env binDir + cpr env bin (binDir name) mhsInstallLib :: Env -> Section -> Section -> IO () mhsInstallLib env (Section _ _ glob) (Section _ name _) = do @@ -142,3 +176,8 @@ let vers = getVersion glob "version" namever = name ++ "-" ++ showVersion vers mhs env $ "-Q " ++ namever ++ ".pkg" + +--- +-- XXX +stripSuffix :: String -> String -> Maybe String +stripSuffix suf str = reverse <$> stripPrefix (reverse suf) (reverse str) diff --git a/src/MicroCabal/Macros.hs b/src/MicroCabal/Macros.hs new file mode 100644 --- /dev/null +++ b/src/MicroCabal/Macros.hs @@ -0,0 +1,23 @@ +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +module MicroCabal.Macros(genPkgVersionMacros) where +import Data.Version + +genPkgVersionMacros :: [(String, Version)] -> [String] +genPkgVersionMacros pkgs = + concatMap (\ (name, vers) -> generateMacros (map fixchar name) vers) pkgs + where + fixchar '-' = '_' + fixchar c = c + +generateMacros :: String -> Version -> [String] +generateMacros name version = + [ concat [ "'-DVERSION_", name, "=", show (showVersion version), "'" ] + , concat [ "'-DMIN_VERSION_", name, "(x,y,z)=(" + , "(x)<", major1, "||" + , "(x)==", major1, "&&(y)<", major2, "||" + , "(x)==", major1, "&&(y)==", major2, "&&(z)<=", minor + , ")'" + ] + ] + where + (major1:major2:minor:_) = map show (versionBranch version ++ repeat 0) diff --git a/src/MicroCabal/Main.hs b/src/MicroCabal/Main.hs --- a/src/MicroCabal/Main.hs +++ b/src/MicroCabal/Main.hs @@ -20,7 +20,7 @@ --import MicroCabal.YAML version :: String -version = "MicroCabal 0.2.1.0" +version = "MicroCabal 0.3.1.0" main :: IO () main = do @@ -40,8 +40,9 @@ setupEnv :: IO Env setupEnv = do + cdirm <- lookupEnv "CABALDIR" home <- getEnv "HOME" - let cdir = home ".mcabal" + let cdir = fromMaybe (home ".mcabal") cdirm env = Env{ cabalDir = cdir, distDir = "dist-mcabal", verbose = 0, depth = 0, backend = undefined, recursive = False, targets = [TgtLib, TgtExe] } be <- mhsBackend env @@ -223,19 +224,28 @@ getGlobal (Cabal sects) = fromMaybe (error "no global section") $ listToMaybe [ s | s@(Section "global" _ _) <- sects ] +makeDataPrefix :: Env -> Section -> Section -> FilePath +makeDataPrefix env (Section _ _ glob) (Section _ name _) = + let vers = getVersion glob "version" + pkgVers = name ++ "-" ++ showVersion vers + dataPrefix = cabalDir env compiler (backend env) "data" pkgVers + in dataPrefix + createPathFile :: Env -> Section -> Section -> IO () -createPathFile env (Section _ _ glob) (Section _ name _) = do - let mdlName = "Paths_" ++ map (\ c -> if c == '-' then '_' else c) name +createPathFile env gsect@(Section _ _ glob) sect = do + let vers = getVersion glob "version" + name = getFieldString glob "name" + mdlName = "Paths_" ++ map (\ c -> if c == '-' then '_' else c) name pathName = pathModuleDir env mdlName ++ ".hs" - vers = getVersion glob "version" --- dataDir = "???" -- cabalDir env "COMPILER-VERSION" "data" pkgVers "data" + dataPrefix = makeDataPrefix env gsect sect + dataDir = dataPrefix "data" message env 1 $ "Creating path module " ++ pathName mkdir env (pathModuleDir env) writeFile pathName $ "module " ++ mdlName ++ " where\n" ++ "import Data.Version\n" ++ - "version :: Version; version = make" ++ show vers ++ "\n" --- ++ "getDataDir :: IO FilePath; getDataDir = return " ++ show dataDir ++ "\n" + "version :: Version; version = makeVersion " ++ show (versionBranch vers) ++ "\n" ++ + "getDataDir :: IO FilePath; getDataDir = return " ++ show dataDir ++ "\n" build :: Env -> IO () build env = do @@ -317,24 +327,62 @@ installExe env glob sect@(Section _ name _) = do message env 0 $ "Installing executable " ++ name installDataFiles env glob sect + installIncludeFiles env glob sect + installCFiles env glob sect installPkgExe (backend env) env glob sect installLib :: Env -> Section -> Section -> IO () installLib env glob sect@(Section _ name _) = do message env 0 $ "Installing library " ++ name installDataFiles env glob sect + installIncludeFiles env glob sect + installCFiles env glob sect installPkgLib (backend env) env glob sect installDataFiles :: Env -> Section -> Section -> IO () -installDataFiles env _glob _sect@(Section _ _ flds) = do - case getFieldStrings flds [] "data-files" of +installDataFiles env glob@(Section _ _ gflds) sect@(Section _ _ flds) = do + let gdatas = getFieldStrings gflds [] "data-files" + datas = getFieldStrings flds [] "data-files" + dataPrefix = makeDataPrefix env glob sect + dataDir = dataPrefix "data" + --print ("installDataFiles", gdatas ++ datas, dataDir) + case gdatas ++ datas of [] -> return () pats -> do files <- matchFiles "." pats message env 1 $ "Installing data files " ++ unwords files - let tgt = undefined - copyFiles env "." files tgt + mkdir env dataDir + copyFiles env "." files dataDir +installIncludeFiles :: Env -> Section -> Section -> IO () +installIncludeFiles env glob@(Section _ _ gflds) sect@(Section _ _ flds) = do + let gincs = getFieldStrings gflds [] "install-includes" + incs = getFieldStrings flds [] "install-includes" + dataPrefix = makeDataPrefix env glob sect + incDir = dataPrefix "include" + case gincs ++ incs of + [] -> return () + pats -> do + let inc = head $ getFieldStrings flds ["."] "include-dirs" + files <- matchFiles inc pats + -- print (pats, files) + message env 1 $ "Installing include files " ++ unwords files + mkdir env incDir + copyFiles env inc files incDir + +installCFiles :: Env -> Section -> Section -> IO () +installCFiles env glob@(Section _ _ gflds) sect@(Section _ _ flds) = do + let gcs = getFieldStrings gflds [] "c-sources" + cs = getFieldStrings flds [] "c-sources" + dataPrefix = makeDataPrefix env glob sect + cDir = dataPrefix "cbits" + case gcs ++ cs of + [] -> return () + files -> do + message env 1 $ "Installing C files " ++ unwords files + mkdir env cDir + mapM_ (\ f -> cp env f cDir) files + ----------------------------------------- cmdHelp :: Env -> [String] -> IO () @@ -356,6 +404,7 @@ \ --ghc compile using ghc\n\ \ --mhs compile using mhs (default)\n\ \\n\ + \Installs go to $CABALDIR if set, otherwise $HOME/.mcabal.\n\ \" ----------------------------------------- diff --git a/src/MicroCabal/Unix.hs b/src/MicroCabal/Unix.hs --- a/src/MicroCabal/Unix.hs +++ b/src/MicroCabal/Unix.hs @@ -4,7 +4,7 @@ wget, URL(..), tarx, rmrf, - cp, + cp, cpr, copyFiles, preserveCurrentDirectory, (), @@ -82,8 +82,13 @@ -- Copy a file to a directory cp :: Env -> FilePath -> FilePath -> IO () cp env s d = do - cmd env $ "rm -f " ++ d cmd env $ "cp " ++ s ++ " " ++ d + +-- Copy a file to a directory, delete first +cpr :: Env -> FilePath -> FilePath -> IO () +cpr env s d = do + cmd env $ "rm -f " ++ d + cp env s d copyFiles :: Env -> FilePath -> [FilePath] -> FilePath -> IO () copyFiles env src fns tgt = do