[allow selecting libraries by hash or name-version
John Meacham <john@repetae.net>**20090916092017
 Ignore-this: 791898f2515ce09fdf14bcfa55374d0f
] hunk ./src/Ho/Build.hs 382
-parseFiles :: [Either Module String]                                   -- ^ Either a module or filename to find
-               -> (CollectedHo -> Ho -> IO CollectedHo)                -- ^ Process initial ho loaded from file
-               -> (CollectedHo -> Ho -> TiData -> IO (CollectedHo,Ho)) -- ^ Process set of mutually recursive modules to produce final Ho
-               -> IO (CompNode,CollectedHo)                            -- ^ Final accumulated ho
-
-parseFiles need ifunc func = do
+parseFiles
+    :: [String]                                             -- ^ Extra libraries to load
+    -> [Either Module String]                               -- ^ Either a module or filename to find
+    -> (CollectedHo -> Ho -> IO CollectedHo)                -- ^ Process initial ho loaded from file
+    -> (CollectedHo -> Ho -> TiData -> IO (CollectedHo,Ho)) -- ^ Process set of mutually recursive modules to produce final Ho
+    -> IO (CompNode,CollectedHo)                            -- ^ Final accumulated ho
+parseFiles elibs need ifunc func = do
hunk ./src/Ho/Build.hs 390
-    (ksm,chash,cug) <- loadModules (optHls options) need
+    (ksm,chash,cug) <- loadModules (optHls options ++ elibs) need
hunk ./src/Ho/Build.hs 419
-    (es,is) <- collectLibraries
+    (es,is) <- collectLibraries libs
hunk ./src/Ho/Build.hs 430
---    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 530
-                                                "{- --ANNOTATE--", 
+                                                "{- --ANNOTATE--",
hunk ./src/Ho/Build.hs 715
-        (rnode@(CompNode lhash _ _),cho) <- parseFiles (map Left $ Set.toList allMods) ifunc func
+        (rnode@(CompNode lhash _ _),cho) <- parseFiles [] (map Left $ Set.toList allMods) ifunc func
hunk ./src/Ho/Library.hs 19
-import Data.Version(showVersion)
+import Data.Version
hunk ./src/Ho/Library.hs 27
-import GenUtil
+import Util.Gen hiding(intercalate)
hunk ./src/Ho/Library.hs 116
-
-
-
-
-
hunk ./src/Ho/Library.hs 117
---    putStrLn "SearchPath:"
---    mapM_ (putStrLn . (" - " ++)) (optHlPath options)
---    putStrLn "Libraries:"
---    let nameComp a b = compare (libName a) (libName b)
---        putStrLn " -"
---        let f n v = putStrLn ("  " ++ n ++ ": " ++ v)
---        f "Name" (libName lib)
---        f "Hash" (show $ libHash lib)
---        f "Modules" (show $ libModules lib)
-
hunk ./src/Ho/Library.hs 119
----- range queries for Data.Map
-
-range :: Ord k => k -> k -> Map.Map k v -> [(k,v)]
-range low high = Map.toList . fst . Map.split high . snd . Map.split low
hunk ./src/Ho/Library.hs 148
-fetchAllLibraries :: IO (Map.Map PackedString Library,Map.Map HoHash Library)
+fetchAllLibraries :: IO (Map.Map PackedString [Library],Map.Map HoHash Library)
hunk ./src/Ho/Library.hs 152
-        let bynames = Map.unionsWith vcomb bynames'
+        let bynames = Map.map (reverse . sortBy libVersionCompare) $ Map.unionsWith (++) bynames'
hunk ./src/Ho/Library.hs 163
-                    return (Map.singleton (libBaseName lib) lib, Map.singleton (libHash lib) lib)
+                    return (Map.singleton (libBaseName lib) [lib], Map.singleton (libHash lib) lib)
hunk ./src/Ho/Library.hs 166
-collectLibraries :: IO ([Library],[Library])
-collectLibraries = ans where
+
+splitOn' :: (a -> Bool) -> [a] -> [[a]]
+splitOn' f xs = split xs
+  where split xs = case break f xs of
+          (chunk,[])     -> chunk : []
+          (chunk,_:rest) -> chunk : split rest
+
+
+splitVersion :: String -> (String,Data.Version.Version)
+splitVersion s = ans where
+    ans = case reverse (splitOn' ('-' ==) s) of
+        (vrs:bs@(_:_)) | Just vrs <- runReadP parseVersion vrs -> (intercalate "-" (reverse bs),vrs)
+        _ -> (s,Data.Version.Version [] [])
+
+collectLibraries :: [String] -> IO ([Library],[Library])
+collectLibraries libs = ans where
hunk ./src/Ho/Library.hs 184
-        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)
+        let f (pn,vrs) = lname pn vrs `mplus` lhash pn vrs where
+                lname pn vrs = do
+                    xs <- Map.lookup (packString pn) bynames
+                    (x:_) <- return $ filter isGood xs
+                    return x
+                isGood lib = versionBranch vrs `isPrefixOf` versionBranch (libVersion lib)
+                lhash pn vrs = do
+                    [] <- return $ versionBranch vrs
+                    Map.lookup pn byhashes'
+            byhashes' = Map.fromList $ [ (show x,y) | (x,y) <- Map.toList byhashes]
+        let es' = [ (x,f $ splitVersion x) | x <- libs ]
+            es = [ l | (_,Just l) <- es' ]
+            bad = [ n | (n,Nothing) <- es' ]
+        unless (null bad) $ do
+            putErrLn "Libraries not found:"
+            forM_ bad $ \b -> putErrLn ("    " ++ b)
+            exitFailure
+
hunk ./src/Main.hs 112
-    g fs = processCollectedHo . snd =<< parseFiles fs processInitialHo processDecls
+    g fs = processCollectedHo . snd =<< parseFiles [] fs processInitialHo processDecls