module Package (package, getModule, getOneModule, PackageData) where import Directory import List import Char import Maybe import Control.Monad import Flags import Error import System.FilePath data PackageData = PackageData [FilePath] package :: Flags -> FilePath -> IO PackageData package flags rootpath = do let paths = [sBasePath flags </> "lib" </> "yhc" </> "packages"] packages <- concatMapM getDirectoryListFull paths versions <- concatMapM f packages let result = pickPackages versions return $ PackageData (rootpath : sIncludes flags ++ result) where getDirectoryListFull path = do xs <- getDirectoryList path return [(x, combine path x) | x <- xs] f (pack, path) = do vers <- getDirectoryList path return [(pack, ver, combine path ver) | ver <- vers] -- decide which packages are "best" -- data structure is (package name, package version, package folder) pickPackages :: [(String, String, FilePath)] -> [FilePath] pickPackages xs = concatMap f $ groupBy eqFst3 $ sortBy cmpFst3 xs where cmpFst3 (a,_,_) (b,_,_) = a `compare` b eqFst3 (a,_,_) (b,_,_) = a == b cmpFstRev (a,_) (b,_) = b `compare` a f xs = if any (null . fst) vers then map snd vers else [snd $ head $ sortBy cmpFstRev vers] where vers = map (\(a,b,c) -> (versionNumber b, c)) xs -- return [] on nothing versionNumber :: String -> [Integer] versionNumber xs = g [] "" xs g res todo ('.':xs) | todo /= [] = g (g res todo []) "" xs g res todo ( x :xs) | isDigit x = g res (x:todo) xs g res todo [] | todo /= [] = res ++ [read (reverse todo)] g _ _ _ = [] -- | take the package data and the name of the module you want -- return the (modulepath.hs, modulepath.hi) -- if either doesn't exist, return null, at least one must exist -- if requireHi is True then the .hi file MUST exist getModule :: PackageData -> Bool -> String -> String -> IO (FilePath, FilePath) getModule (PackageData rs@(root:rest)) requireHi asker file = do local <- testPackage root res <- concatMapM testPackage rest case (local,res) of ([x], _) -> return x (_, [x]) -> return x ([], []) -> raiseError $ ErrorFileNone noErrPos askMsg file rs (as, bs) -> raiseError $ ErrorFileMany noErrPos askMsg file (map anyOne (as ++ bs)) where askMsg = if null asker then "asked for by the compiler" else "imported from " ++ asker -- for error messages only, when you find multiple items anyOne ("",x) = x anyOne (x, _) = x -- what is the location for an .hi file (in the hi dir) hiLocation = "hi" </> addExtension file "hi" hsLocation = getLocations file testPackage pkg = do bHi <- doesFileExist basehi his <- mapM (calcHi bHi) basehs hss <- mapM calcHs basehs let poss = filter isValid $ [("",basehi) | bHi] ++ concatMap power (zip hss his) (hasHs, noHs) = partition (not . null . fst) poss return $ if null hasHs then noHs else hasHs where basehi = combine pkg hiLocation basehs = map (combine pkg) hsLocation -- calculate an hi path calcHi True path = return [basehi] calcHi False path = do let s = addExtension path "hi" b <- doesFileExist s if b then return [s] else return [] calcHs path = do let slhs = addExtension path "lhs" shs = addExtension path "hs" blhs <- doesFileExist slhs bhs <- doesFileExist shs return $ [slhs | blhs] ++ [shs | bhs] power ([],xs) = map (\x -> ("",x)) xs power (xs,[]) = map (\x -> (x,"")) xs power (xs,ys) = [(x,y) | x <- xs, y <- ys] isValid (hs,hi) = not (null hi) || (not requireHi && not (null hs)) -- | Find the location of one single module getOneModule :: String -> IO FilePath getOneModule modName = do curdir <- getCurrentDirectory (res,_) <- getModule (PackageData [curdir]) False "" modName return res -- figure out where a module could roam -- obey the Haskell' proposal (http://hackage.haskell.org/trac/haskell-prime/wiki/DottedHierarchicalModules) getLocations :: String -> [FilePath] getLocations modu = reverse $ f [] modu where f prefix xs = joinPath (prefix ++ [xs]) : if null b then [] else f (prefix ++ [a]) (tail b) where (a,b) = break (=='.') xs concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b] concatMapM f xs = liftM concat $ mapM f xs getDirectoryList :: FilePath -> IO [String] getDirectoryList path = do x <- getDirectoryContents path let xfull = filter (not . isFakeDirectory) x filterM (\a -> doesDirectoryExist $ combine path a) xfull isFakeDirectory :: FilePath -> Bool isFakeDirectory x = x == "." || x == ".."