MicroCabal 0.2.1.1 → 0.3.1.0
raw patch · 7 files changed
+184/−48 lines, 7 filesdep ~base
Dependency ranges changed: base
Files
- Makefile +1/−1
- MicroCabal.cabal +6/−2
- src/MicroCabal/Backend/GHC.hs +32/−16
- src/MicroCabal/Backend/MHS.hs +54/−15
- src/MicroCabal/Macros.hs +23/−0
- src/MicroCabal/Main.hs +61/−12
- src/MicroCabal/Unix.hs +7/−2
Makefile view
@@ -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
MicroCabal.cabal view
@@ -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,
src/MicroCabal/Backend/GHC.hs view
@@ -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
src/MicroCabal/Backend/MHS.hs view
@@ -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)
+ src/MicroCabal/Macros.hs view
@@ -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)
src/MicroCabal/Main.hs view
@@ -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\ \" -----------------------------------------
src/MicroCabal/Unix.hs view
@@ -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