shithub: MicroHs

Download patch

ref: 03ca35304c8ded114ffca1929e9f83d5cc68a897
parent: 3336e0765c952f6fa7435b216e93b96fb038b414
author: Lennart Augustsson <lennart@augustsson.net>
date: Sat Mar 30 18:36:12 EDT 2024

Fix package handling

--- a/src/MicroHs/Compile.hs
+++ b/src/MicroHs/Compile.hs
@@ -8,7 +8,7 @@
   validateCache,
   Cache, emptyCache, deleteFromCache,
   moduleToFile,
-  packageDir, packageSuffix,
+  packageDir, packageSuffix, packageTxtSuffix,
   ) where
 import Prelude
 import Data.List
@@ -93,13 +93,14 @@
   cash <- get
   case lookupCache mn cash of
     Nothing -> do
-      modify $ addWorking mn
       when (verbosityGT flags 0) $
         liftIO $ putStrLn $ "importing " ++ showIdent mn
       mres <- liftIO (readModulePath flags mn)
       case mres of
         Nothing -> findPkgModule flags mn
-        Just (pathfn, file) -> compileModule flags mn pathfn file
+        Just (pathfn, file) -> do
+          modify $ addWorking mn
+          compileModule flags mn pathfn file
     Just tm -> do
       when (verbosityGT flags 0) $
         liftIO $ putStrLn $ "importing cached " ++ showIdent mn
@@ -280,17 +281,19 @@
 packageDir = "packages"
 packageSuffix :: String
 packageSuffix = ".pkg"
+packageTxtSuffix :: String
+packageTxtSuffix = ".txt"
 
 findPkgModule :: Flags -> IdentModule -> StateIO Cache (TModule [LDef], Time)
 findPkgModule flags mn = do
-  let fn = moduleToFile mn
+  let fn = moduleToFile mn ++ packageTxtSuffix
   mres <- liftIO $ openFilePath (pkgPath flags) fn
   case mres of
     Just (pfn, hdl) -> do
-      pkg <- liftIO $ hGetContents hdl
-      liftIO $ hClose hdl
+      -- liftIO $ putStrLn $ "findPkgModule " ++ pfn
+      pkg <- liftIO $ hGetContents hdl  -- this closes the handle
       let dir = take (length pfn - length fn) pfn  -- directory where the file was found
-      loadPkg flags (dir ++ "/" ++ packageDir ++ "/" ++ fn)
+      loadPkg flags (dir ++ "/" ++ packageDir ++ "/" ++ pkg)
       cash <- get
       case lookupCache mn cash of
         Nothing -> error $ "package does not contain module " ++ pkg ++ " " ++ showIdent mn
--- a/src/MicroHs/Main.hs
+++ b/src/MicroHs/Main.hs
@@ -92,7 +92,7 @@
       pkg = Package { pkgName = mkIdent name, pkgVersion = ver
                     , pkgExported = exported, pkgOther = other
                     , pkgDepends = pkgDeps }
-  print (map tModuleName $ pkgOther pkg)
+  --print (map tModuleName $ pkgOther pkg)
   when (verbose flags > 0) $
     putStrLn $ "Writing package " ++ namever ++ " to " ++ output flags
   writeSerializedCompressed (output flags) pkg
@@ -182,7 +182,7 @@
   createDirectoryIfMissing True pdir
   copyFile pkgfn (pdir ++ "/" ++ pkgout)
   let mk tm = do
-        let fn = dir ++ "/" ++ moduleToFile (tModuleName tm)
+        let fn = dir ++ "/" ++ moduleToFile (tModuleName tm) ++ packageTxtSuffix
             d = dropWhileEnd (/= '/') fn
         when (verbosityGT flags 1) $
           putStrLn $ "create " ++ fn
--- a/src/MicroHs/Package.hs
+++ b/src/MicroHs/Package.hs
@@ -17,9 +17,9 @@
 -- So if we have a package foo, exporting modules Foo.Bar and Foo.baz
 -- we would have the following directory structure
 --   packages/foo.pkg
---   Foo/Bar
---   Foo/Baz
--- The files Foo/Bar and Foo/Baz will contain simply "foo".
+--   Foo/Bar.txt
+--   Foo/Baz.txt
+-- The files Foo/Bar.txt and Foo/Baz.txt will contain simply "foo".
 -- 
 
 type IdentPackage = Ident
--