[redo libraries such that only names from explicitly imported libraries are visible to the program being compiled.
John Meacham <john@repetae.net>**20090819035236
 Ignore-this: 7eeb43ddaf2f975309b38190ca266150
] hunk ./src/Ho/Binary.hs 23
-current_version = 3
+current_version = 4
hunk ./src/Ho/Binary.hs 150
-    put (HoLib aa ab ac) = do
+    put (HoLib aa ab ac ad) = do
hunk ./src/Ho/Binary.hs 154
+	    Data.Binary.put ad
hunk ./src/Ho/Binary.hs 159
-    return (HoLib aa ab ac)
+    ad <- get
+    return (HoLib aa ab ac ad)
hunk ./src/Ho/Build.hs 12
-import Data.Binary
hunk ./src/Ho/Build.hs 18
-import Debug.Trace
hunk ./src/Ho/Build.hs 23
-import System.Posix.Files
hunk ./src/Ho/Build.hs 24
-import qualified Data.ByteString as BS
hunk ./src/Ho/Build.hs 57
-import Support.CFF
hunk ./src/Ho/Build.hs 113
-    | ModLibrary ModuleGroup Library
+    | ModLibrary Bool ModuleGroup Library
hunk ./src/Ho/Build.hs 126
-fileOrModule f = case reverse f of
-                   ('s':'h':'.':_)     -> Right f
-                   ('s':'h':'l':'.':_) -> Right f
-                   _                   -> Left $ Module f
-
hunk ./src/Ho/Build.hs 197
-    if isJust $ m `mlookup` modEncountered done then return () else do
-    fetchSource done_ref (map fst $ searchPaths (show m)) (Just m)
-    return ()
+    case m `mlookup` modEncountered done of
+        Just (ModLibrary False _ lib) -> putErrDie $ printf  "ERROR: Attempt to import module '%s' which is a member of the library '%s'." (show m) (libName lib)
+        Just _ -> return ()
+        Nothing -> fetchSource done_ref (map fst $ searchPaths (show m)) (Just m) >> return ()
hunk ./src/Ho/Build.hs 274
-libModMap (Library _ libr _ _) = hoModuleMap libr
hunk ./src/Ho/Build.hs 280
-        foundMods' = Map.elems $ Map.fromList [ (mg,((mg,Right lib),fs' mg lib)) | (_,ModLibrary mg lib) <- Map.toList (modEncountered done)]
+        foundMods' = Map.elems $ Map.fromList [ (mg,((mg,Right lib),fs' mg lib)) | (_,ModLibrary _ mg lib) <- Map.toList (modEncountered done)]
hunk ./src/Ho/Build.hs 285
-        lmods = Map.mapMaybe ( \ x -> case x of ModLibrary mg lib -> Just (mg,lib) ; _ -> Nothing) (modEncountered done)
hunk ./src/Ho/Build.hs 317
-                let Just mgs = Map.lookup mg (hoModuleDeps libr)
-                    Just hob = Map.lookup mg mhob
+                let Just hob = Map.lookup mg mhob
hunk ./src/Ho/Build.hs 372
-libHash (Library hoh _ _ _) = hohHash hoh
-libMgHash mg lib = MD5.md5String $ show (libHash lib,mg)
-libProvides mg (Library _ lib _ _) = [ m | (m,mg') <- Map.toList (hoModuleMap lib), mg == mg']
-libName (Library HoHeader { hohName = Right (name,vers) } _ _ _) = unpackPS name ++ "-" ++ showVersion vers
hunk ./src/Ho/Build.hs 408
-    unless (null libs) $ putProgressLn $ "Loading libraries:" <+> show libs
-    forM_ (optHls options) $ \l -> do
-        (n',fn) <- findLibrary l
-        lib@(Library hoh libr _ _)  <- catch (readHlFile fn) $ \_ ->
-            fail $ "Error loading library file: " ++ fn
-        let Right (libName,libVers) = hohName hoh
-        putProgressLn $ printf "Library: %-15s <%s>" n' fn
-        modifyIORef done_ref (modEncountered_u $ Map.union (Map.fromList [ (m,ModLibrary mg lib) | (m,mg) <- Map.toList (hoModuleMap libr) ]))
-        modifyIORef done_ref (loadedLibraries_u $ Map.insert libName lib)
+    (es,is) <- collectLibraries
+    let combModMap es = Map.unions [ Map.map ((,) l) mm | l@(Library _ HoLib { hoModuleMap = mm } _ _) <- es]
+        explicitModMap = combModMap es
+        implicitModMap = combModMap is
+        reexported  = Set.fromList [ m | l <- es, (m,_) <- Map.toList $ hoReexports (libHoLib l) ]
+        modEnc exp emap = Map.fromList [ (m,ModLibrary (exp || Set.member m reexported)  mg l) | (m,(l,mg)) <- Map.toList emap ]
+
+    modifyIORef done_ref (loadedLibraries_u $ Map.union $ Map.fromList [ (libBaseName lib,lib) | lib <- es ++ is])
+    modifyIORef done_ref (modEncountered_u $ Map.union (modEnc True explicitModMap))
+    modifyIORef done_ref (modEncountered_u $ Map.union (modEnc False implicitModMap))
+
+--    unless (null libs) $ putProgressLn $ "Loading libraries:" <+> show libs
+--    forM_ (optHls options) $ \l -> do
+--        (n',fn) <- findLibrary l
+--        lib@(Library hoh libr _ _)  <- catch (readHlFile fn) $ \_ ->
+--            fail $ "Error loading library file: " ++ fn
+--        let Right (libName,_libVers) = hohName hoh
+--        putProgressLn $ printf "Library: %-15s <%s>" n' fn
+--        modifyIORef done_ref (modEncountered_u $ Map.union (Map.fromList [ (m,ModLibrary mg lib) | (m,mg) <- Map.toList (hoModuleMap libr) ]))
+--        modifyIORef done_ref (loadedLibraries_u $ Map.insert libName lib)
hunk ./src/Ho/Build.hs 464
--- take the list of CompNodes and what modules we want and create a root node
--- that will reach all dependencies when compiled.
-
-mkPhonyCompNode :: [Module] -> [CompNode] -> IO CompNode
-mkPhonyCompNode need cs = do
-    xs <- forM cs $ \cn@(CompNode _ _ cu) -> readIORef cu >>= \u -> return $ if null $ providesModules u `intersect` need then [] else [cn]
-    let hash = MD5.md5String $ show [ h | CompNode h _ _ <- concat xs ]
-    CompNode hash (concat xs) `fmap` newIORef (CompLinkUnit CompDummy)
hunk ./src/Ho/Build.hs 696
-        let allmods = snub (emods ++ hmods)
+        let allMods = emodSet `Set.union` hmodSet
+            emodSet = Set.fromList emods
+            hmodSet = Set.fromList hmods
+
hunk ./src/Ho/Build.hs 701
-        (rnode@(CompNode lhash _ _),cho) <- parseFiles (map Left allmods) ifunc func
+        (rnode@(CompNode lhash _ _),cho) <- parseFiles (map Left $ Set.toList allMods) ifunc func
hunk ./src/Ho/Build.hs 726
-        let unknownMods = Set.toList $ Set.filter (`notElem` allmods) prvds
-        mapM_ ((putStrLn . ("*** Module included in library that is not in export list: " ++)) . show) unknownMods
+        let unknownMods = Set.toList $ Set.filter (`Set.notMember` allMods) prvds
+        mapM_ ((putStrLn . ("*** Module depended on in library that is not in export list: " ++)) . show) unknownMods
+        mapM_ ((putStrLn . ("*** We are re-exporting the following modules from other libraries: " ++)) . show) $ Set.toList (allMods Set.\\ prvds)
hunk ./src/Ho/Build.hs 739
-        let pdesc = [(n, packString v) | (n,v) <- ("jhc-hl-filename",outName):("jhc-description-file",fp):("jhc-compiled-by",versionString):desc, n /= "exposed-modules" ]
+        let pdesc = [(packString n, packString v) | (n,v) <- ("jhc-hl-filename",outName):("jhc-description-file",fp):("jhc-compiled-by",versionString):desc, n /= "exposed-modules" ]
hunk ./src/Ho/Build.hs 741
+                hoReexports = Map.fromList [ (m,m) | m <- Set.toList $ allMods Set.\\ prvds],
hunk ./src/Ho/Build.hs 762
---collectLibraries :: IO [FilePath]
---collectLibraries = concat `fmap` mapM f (optHlPath options) where
---    f fp = do
---        fs <- flip catch (\_ -> return []) $ getDirectoryContents fp
---        flip mapM fs $ \e -> case reverse e of
---            ('l':'h':'.':r)  -> do
---                (fn',hoh,mp) <- readHFile (fp++"/"++e)
---
---        _               -> []
-
hunk ./src/Ho/Build.hs 799
-        showList "MetaInfo" (sort [text k <> char ':' <+> show v | (k,v) <- hoMetaInfo libr])
+        showList "MetaInfo" (sort [text (unpackPS k) <> char ':' <+> show v | (k,v) <- hoMetaInfo libr])
hunk ./src/Ho/Build.hs 802
+        showList "ModuleReexports" (map pprint . sortUnder fst $ Map.toList $ hoReexports libr)
hunk ./src/Ho/Library.hs 4
-    libraryList
+    collectLibraries,
+    libModMap,
+    libHash,
+    libMgHash,
+    libProvides,
+    libName,
+    libBaseName,
+    libHoLib,
+    listLibraries
hunk ./src/Ho/Library.hs 17
-import System.IO
+import Data.List
+import Data.Maybe
+import Data.Version(showVersion)
hunk ./src/Ho/Library.hs 21
+import System.IO
+import Text.Printf
hunk ./src/Ho/Library.hs 24
-import Data.List
+import qualified Data.Set as Set
hunk ./src/Ho/Library.hs 26
+import Data.Monoid
hunk ./src/Ho/Library.hs 28
+import Ho.Binary
+import Ho.Type
hunk ./src/Ho/Library.hs 31
+import PackedString(PackedString,packString,unpackPS)
hunk ./src/Ho/Library.hs 34
+import qualified Support.MD5 as MD5
+
+libModMap (Library _ libr _ _) = hoModuleMap libr
+libHash (Library hoh _ _ _) = hohHash hoh
+libMgHash mg lib = MD5.md5String $ show (libHash lib,mg)
+libProvides mg (Library _ lib _ _) = [ m | (m,mg') <- Map.toList (hoModuleMap lib), mg == mg']
+libName (Library HoHeader { hohName = ~(Right (name,vers)) } _ _ _) = unpackPS name ++ "-" ++ showVersion vers
+libBaseName (Library HoHeader { hohName = ~(Right (name,vers)) } _ _ _) = name
+libModules (Library _ lib _ _) = ([ m | (m,_) <- Map.toList (hoModuleMap lib)],Map.toList (hoReexports lib))
+libHoLib (Library _ lib _ _) = lib
+
+libVersionCompare ~(Library HoHeader { hohName = Right (_,v1) } _ _ _ ) ~(Library HoHeader { hohName =  Right (_,v2) } _ _ _) = compare v1 v2
hunk ./src/Ho/Library.hs 101
-{-
-collectLibraries :: IO [FilePath]
-collectLibraries ms = concat `fmap` mapM f (optHlPath options) where
-    f fp = flip catch (\_ -> return []) $ do
-        fs <- getDirectoryContents fp
-        return $ flip concatMap fs $ \e ->
-            case reverse e of
-              ('l':'h':'.':r) | good e -> [(fp++"/"++e)]
-              _               -> []
-    good e = case ms of
-        Nothing -> True
-        Just rs -> any (`isPrefixOf` e) rs
-
-collectPotentialLibraries :: Maybe [String] -> IO [FilePath]
-collectPotentialLibraries ms = concat `fmap` mapM f (optHlPath options) where
-    f fp = flip catch (\_ -> return []) $ do
-        fs <- getDirectoryContents fp
-        return $ flip concatMap fs $ \e ->
-            case reverse e of
-              ('l':'h':'.':r) | good e -> [(fp++"/"++e)]
-              _               -> []
-    good e = case ms of
-        Nothing -> True
-        Just rs -> any (`isPrefixOf` e) rs
hunk ./src/Ho/Library.hs 102
-    -}
+listLibraries :: IO ()
+listLibraries = do
+    putStrLn "Search path:"
+    mapM_ putStrLn (optHlPath options)
+    putStrLn "Libraries found:"
+    (_,byhashes) <- fetchAllLibraries
+    let nameComp a b = compare (libName a) (libName b)
+    forM_ (sortBy nameComp $ Map.elems byhashes) $ \ lib -> putStrLn (libName lib)
hunk ./src/Ho/Library.hs 113
-
-libraryList :: IO [(LibraryName,FilePath)]
-libraryList = Map.toList `fmap` getLibraryMap (optHlPath options)
-
hunk ./src/Ho/Library.hs 129
+maxBy c x1 x2 = case x1 `c` x2 of
+    LT -> x2
+    _ -> x1
+
+-- Collect all libraries and return those which are explicitly and implicitly imported.
+--
+-- The basic process is:
+--    - Find all libraries and create two indexes, a map of named libraries to
+--      the newest version of them, and a map of library hashes to the libraries
+--      themselves.
+--
+--    - For all the libraries listed on the command line, find the newest
+--      version of each of them, flag these as the explicitly imported libraries.
+--
+--    - recursively find the dependencies by the hash's listed in the library deps. if the names
+--      match a library already loaded, ensure the hash matches up. flag these libraries as 'implicit' unless
+--      already flaged 'explicit'
+--
+--    - perform sanity checks on final lists of implicit and explicit libraries.
+--
+-- Library Checks needed:
+--    - We have found versions of all libraries listed on the command line
+--    - We have all dependencies of all libraries and the hash matches the proper library name
+--    - no libraries directly export the same modules, (but re-exporting the same module is fine)
+--    - conflicting versions of any particular library are not required due to dependencies
+--
+
+fetchAllLibraries :: IO (Map.Map PackedString Library,Map.Map HoHash Library)
+fetchAllLibraries = ans where
+    ans = do
+        (bynames',byhashes') <- unzip `fmap` concatMapM f (optHlPath options)
+        let bynames = Map.unionsWith vcomb bynames'
+            byhashes = Map.unions byhashes'
+            vcomb = maxBy libVersionCompare
+        return (bynames,byhashes)
+
+    f fp = do
+        fs <- flip catch (\_ -> return [] ) $ getDirectoryContents fp
+        flip mapM fs $ \e -> case reverse e of
+            ('l':'h':'.':r)  -> do
+                flip catch (\_ -> return mempty) $ do
+                    lib <- readHlFile  (fp ++ "/" ++ e)
+                    return (Map.singleton (libBaseName lib) lib, Map.singleton (libHash lib) lib)
+            _               -> return mempty
+
+collectLibraries :: IO ([Library],[Library])
+collectLibraries = ans where
+    ans = do
+        (bynames,byhashes) <- fetchAllLibraries
+        let f pn | Just x <- Map.lookup pn bynames = return x
+                 | otherwise = putErrDie $ printf "Library was not found '%s'\n" (unpackPS pn)
+        es <- mapM f ( map packString $ optHls options)
+        checkForModuleConficts es
+        let f lmap _ [] = return lmap
+            f lmap lset ((ei,l):ls)
+                | libHash l `Set.member` lset = f lmap lset ls
+                | otherwise = case Map.lookup (libBaseName l) lmap of
+                    Nothing -> f (Map.insert (libBaseName l) (ei,l) lmap) (Set.insert (libHash l) lset) (ls ++ newdeps)
+                    Just (ei',l') | libHash l == libHash l' -> f  (Map.insert (libBaseName l) (ei || ei',l) lmap) lset ls
+                    Just (_,l')  -> putErrDie $ printf  "Conflicting versions of library '%s' are required. [%s]\n" (libName l) (show (libHash l,libHash l'))
+              where newdeps = [ (False,fromMaybe (error $ printf "Dependency '%s' with hash '%s' needed by '%s' was not found" (unpackPS p) (show h) (libName l)) (Map.lookup h byhashes)) | let Library HoHeader { hohLibDeps = ldeps } _ _ _ = l , (p,h) <- ldeps ]
+        finalmap <- f Map.empty Set.empty [ (True,l) | l <- es ]
+        checkForModuleConficts [ l | (_,l) <- Map.elems finalmap ]
+        when verbose $ forM_ (Map.toList finalmap) $ \ (n,(e,l)) -> do
+            printf "-- Base: %s Exported: %s Hash: %s Name: %s\n" (unpackPS n) (show e) (show $ libHash l) (libName l)
+
+        return ([ l | (True,l) <- Map.elems finalmap ],[ l | (False,l) <- Map.elems finalmap ])
+
+    checkForModuleConficts ms = do
+        let mbad = Map.toList $ Map.filter (\c -> case c of [_] -> False; _ -> True)  $ Map.fromListWith (++) [ (m,[l]) | l <- ms, m <- fst $ libModules l]
+        forM_ mbad $ \ (m,l) -> putErrLn $ printf "Module '%s' is exported by multiple libraries: %s" (show m) (show $ map libName l)
+        unless (null mbad) $ putErrDie "There were conflicting modules!"
+
+
hunk ./src/Ho/Type.hs 104
-    hoMetaInfo   :: [(String,PackedString)],
hunk ./src/Ho/Type.hs 105
-    hoModuleDeps :: Map.Map ModuleGroup [ModuleGroup]
+    hoReexports  :: Map.Map Module Module,
+    hoModuleDeps :: Map.Map ModuleGroup [ModuleGroup],
+    hoMetaInfo   :: [(PackedString,PackedString)]
hunk ./src/Main.hs 91
-        BuildHl hl    -> darg >> buildLibrary processInitialHo processDecls hl
-        ListLibraries -> do
-            when (optVerbose options > 0) $ do
-                putStrLn "Search path:"
-                mapM_ putStrLn (optHlPath options)
-                putStrLn "Libraries found:"
-            ll <- libraryList
-            sequence_ [ putStrLn name | (name,_) <- ll ]
+        BuildHl hl      -> darg >> buildLibrary processInitialHo processDecls hl
+        ListLibraries   -> listLibraries