Minor fixes.

Author: augustss

MicroCabal.cabal

@@ -1,6 +1,6 @@
 cabal-version:         3.0
 name:                  MicroCabal
-version:               0.5.7.0
+version:               0.5.8.0
                        -- Update src/MicroCabal/Main.hs with version
 synopsis:              A partial Cabal replacement
 license:               Apache-2.0

src/MicroCabal/Backend/GHC.hs

@@ -31,8 +31,8 @@ ghcBackend env = do
     compiler = ghcVersion,
     compilerExe = exe,
     doesPkgExist = ghcExists,
-    patchDepends = id,
-    patchName = id,
+    patchDepends = \ _ x -> x,
+    patchName = \ _ x -> x,
     buildPkgExe = ghcBuildExe,
     buildPkgLib = ghcBuildLib,
     buildPkgForLib = ghcBuildForeignLib,

src/MicroCabal/Backend/MHS.hs

@@ -215,27 +215,26 @@ stripSuffix :: String -> String -> Maybe String
 stripSuffix suf str = reverse <$> stripPrefix (reverse suf) (reverse str)
 
 -- Update build-depends for packages that have a special mhs version, also add ghc-compat.
-mhsPatchDepends :: Cabal -> Cabal
-mhsPatchDepends cbl@(Cabal sects) = Cabal (map patchSect sects)
+mhsPatchDepends :: Env -> Cabal -> Cabal
+mhsPatchDepends env cbl@(Cabal sects) = Cabal (map patchSect sects)
   where
     patchSect (Section styp sname flds) = Section styp sname (map patchField flds)
     patchField (Field "build-depends" (VPkgs ds)) = Field "build-depends" (VPkgs (mhsExtraPkgs cbl ++ map patchDep ds))
     patchField fld = fld
     patchDep d@(pkg, xs, _mv) | n /= pkg = (n, xs, Just (VEQ v))
                               | otherwise = d
-      where (n, v) = mhsPatchName (pkg, undefined)
+      where (n, v) = mhsPatchName env (pkg, undefined)
 
 -- Add a dependency on ghc-compat
 mhsExtraPkgs :: Cabal -> [(Item, [Item], Maybe VersionRange)]
 mhsExtraPkgs cbl | forMhs (getCabalName cbl) = []
                  | otherwise = [ ("ghc-compat", [], Nothing) ]
   where forMhs n = n `elem` ["base", "ghc-compat", "MicroHs", "MicroCabal"]
 
-mhsPatchName :: (Name, Version) -> (Name, Version)
-mhsPatchName (n, _) | Just nv <- lookup n mhsPackages =
-  trace ("Changing package " ++ n ++ " to " ++ n ++ "-mhs") $
-  nv
-mhsPatchName nv = nv
+mhsPatchName :: Env -> (Name, Version) -> (Name, Version)
+mhsPatchName env (n, _) | Just nv <- lookup n mhsPackages =
+  if verbose env >= 0 then trace ("Changing package " ++ n ++ " to " ++ n ++ "-mhs") nv else nv
+mhsPatchName _ nv = nv
 
 mhsPackages :: [(Name, (Name, Version))]
 mhsPackages =

src/MicroCabal/Env.hs

@@ -34,8 +34,8 @@ data Backend = Backend {
   compiler       :: String,                                 -- name&version, e.g., "ghc-9.8.2"
   compilerExe    :: String,                                 -- name of binary
   doesPkgExist   :: Env -> PackageName        -> IO Bool,   -- is the package available in the database?
-  patchDepends   :: Cabal -> Cabal,                         -- patch dependencies
-  patchName      :: (Name, Version) -> (Name, Version),     -- patch package name
+  patchDepends   :: Env -> Cabal -> Cabal,                  -- patch dependencies
+  patchName      :: Env -> (Name, Version) -> (Name, Version), -- patch package name
   buildPkgExe    :: Env -> Section -> Section -> IO (),     -- build executable the current directory
   buildPkgLib    :: Env -> Section -> Section -> IO (),     -- build the package in the current directory
   buildPkgForLib :: Env -> Section -> Section -> IO (),     -- build the foreign-library in the current directory

src/MicroCabal/Main.hs

@@ -21,7 +21,7 @@ import MicroCabal.Unix
 
 -- Update cabal file when this changes
 version :: String
-version = "MicroCabal 0.5.7.0"
+version = "MicroCabal 0.5.8.0"
 
 main :: IO ()
 main = do
@@ -142,7 +142,7 @@ cmdUpdate env [] = do
   let yml = parseYAML stk file
       pkgs = map hackName $ yamlToStackageList yml ++ dist
       ghcVersion = yamlToGHCVersion yml
-      hackName s = s{ stName = n, stVersion = v } where (n, v) = patchName (backend env) (stName s, stVersion s)
+      hackName s = s{ stName = n, stVersion = v } where (n, v) = patchName (backend env) env (stName s, stVersion s)
 --  putStrLn $ "==== " ++ ghcVersion
 --  putStrLn $ showYAML yml
 --  putStrLn $ show pkgs
@@ -210,21 +210,24 @@ cmdFetch env [pkg] = do
       pkgz = pkgs ++ ".tar.gz"
       pdir = dirForPackage env st
       file = pdir ++ ".tar.gz"
-  b <- doesDirectoryExist pdir
-  if b then
-    message env 1 $ "Already in " ++ pdir
-   else do
-    mkdir env pdir
-    message env 1 $ "Fetching package " ++ pkgs
-    case gitRepo env of
-      Nothing -> do
+  case gitRepo env of
+    Nothing -> do
+      -- Doing a regular hackage fetch.
+      b <- doesDirectoryExist pdir
+      if b then
+        message env 1 $ "No fetch, directory already exists " ++ pdir
+       else do
         message env 1 $ "Fetching from Hackage " ++ pkgz
+        mkdir env pdir
         wget env url file
         message env 1 $ "Unpacking " ++ pkgz ++ " in " ++ pdir
         tarx env (dirPackage env) file
-      Just repo -> do
-        message env 1 $ "Fetching from git repo " ++ pkg
-        gitClone env pdir (URL repo)
+    Just repo -> do
+      -- Doing a git fetch.
+      -- With --git we will always fetch, blowing away the old repo.
+      rmrf env pdir
+      message env 1 $ "Fetching from git repo " ++ pkg
+      gitClone env pdir (URL repo)
 cmdFetch _ _ = usage
 
 -----------------------------------------
@@ -240,13 +243,13 @@ findCabalFile _env = do
 cmdBuild :: Env -> [String] -> IO ()
 cmdBuild env [] = build env
 cmdBuild env [apkg] = do
-  let pkg = fst $ patchName (backend env) (apkg, undefined)
+  let pkg = fst $ patchName (backend env) env (apkg, undefined)
   message env 0 $ "Build package " ++ pkg
   st <- getPackageInfo env pkg
   let dir = dirForPackage env st
   b <- doesDirectoryExist dir
-  when (not b) $ do
-    message env 0 $ "Package not found, running 'fetch " ++ pkg ++ "'"
+  when (not b || isJust (gitRepo env)) $ do
+    message env 0 $ "Running 'fetch " ++ pkg ++ "'"
     cmdFetch env [pkg]
   message env 0 $ "Building in " ++ dir
   let dir' = maybe dir (dir </>) (subDir env)
@@ -508,4 +511,4 @@ cmdParse env [fn] = do
 cmdParse _ _ = error "cmdParse"
 
 normalizeAndPatch :: Env -> FlagInfo -> Cabal -> Cabal
-normalizeAndPatch env flags = patchDepends (backend env) . normalize flags
+normalizeAndPatch env flags = patchDepends (backend env) env . normalize flags