module GHCSearch (findModule, explicitFilename) where

import Data.Maybe
import Data.Char

-- This source file embodies GHC's file searching strategy.  There are
-- two entry points:
--
--   * findModule takes a module name and returns a list of (path,location)
--     pairs: if the file named in the first component exists, then the
--     location in the second component is used for that module.  It is an
--     error (currently unchecked by GHC) for more than one of the locations
--     to be valid.
--
--   * explicitFilenmae takes a string passed as an argument on the GHC
--     command-line (either one-shot or --make), or an argument from the
--     :load command in GHC.  It returns a list of the same form as findModule.
--
-- This module is basically a standalone version of 
-- ghc/compiler/main/Finder.lhs in the compiler itself.

-- Extensions relative to GHC:
--    - for a module A.B.C, we search for files named <patch>/A.B.C.<ext>
--	as well as <path>/A/B/C.<ext>.  This applies both to package and
--	home locations.
--
--    - the .hi file for an explicitly-named source file is now the
--	full module name rather than just the last component.
--

-- Tunables:
search_paths = [".", "D1","D2"]  	-- modified by the -i option
src_sufs     = [ ".hs", ".lhs" ]	-- (not tunable in GHC)
hi_suf       = ".hi" 			-- or value of -hisuf flag
obj_suf      = ".o"			-- or value of -osuf flag
hi_dir       = Nothing 			-- set to (Just d) for -hidir d.
obj_dir	     = Nothing  		-- set to (Just d) for -odir d.

-- For each package, we list the package name and its import path.
packages :: [(String, [FilePath])]
packages = [
  ("package1", ["P1"]),
  ("package1", ["P2"])
  ]

package_hi_suf = ".hi"	-- not affected by the -hisuf flag, but changed
			-- by -prof to ".p_hi", and similarly for other "ways".

type Module = String

-- Information about the files associated with a module.
data ModLocation
  = ModLocation {
	locSource :: Maybe FilePath,
		-- the source, if it exists.  Modules in a package don't
		-- normally have source files.

	locHi     :: FilePath,
		-- The interface file.  This might not exist (eg. in GHCi
		-- we don't normally write out interface files), but if we
		-- do create one, this is where it goes.

	locObj    :: Maybe FilePath
		-- The object file.  Again, this might not exist, but if
		-- it does exist, its timestamp is used in deciding whether
		-- to recompile or not.
		-- 
		-- Modules in a package don't normally have separate object
		-- files, so in that case this field is set to Nothing.
  }
  deriving Show


findModule :: Module -> [(FilePath,ModLocation)]
findModule mod = home_locs mod ++ package_locs mod

explicitFilename :: FilePath -> [(FilePath,ModLocation)]
explicitFilename str
  | looks_like_a_module       = findModule str
  | looks_like_a_src_filename = [mk_src_loc (Just module_name) p m ext]
  | otherwise                 = []
  where 
	looks_like_a_module = isUpper (head str) && all isModId (tail str)
	isModId c = isAlphaNum c || c == '\''

        (p,m,e) = splitFilename3 str  
	ext = '.':e

	looks_like_a_src_filename = ext `elem` src_sufs
	module_name = getModuleName str

-- Should return the module name for a given source file by peeking in
-- the file.  XXX bogus for now.
getModuleName str = "A.B.C"

-- The possible locations in the "home package" for a given module
home_locs mod = 
  [ mk_src_loc Nothing p m e
  | p <- search_paths, 
    m <- [mod, dots_to_slashes mod],
    e <- src_sufs
  ]
  where dots_to_slashes = map f
	  where f '.' = '/'
		f c   = c

-- The possible locations in other packages for a given module
package_locs mod =
  [ mk_hi_loc p m hi_suf
  | (pkg_name, paths) <- packages,
    p <- paths,
    m <- [mod, dots_to_slashes mod]
  ]
  where dots_to_slashes = map f
	  where f '.' = '/'
		f c   = c

-- Make a ModLocation given the name of the source file.
mk_src_loc
	:: Maybe Module		-- Just mod <=> use mod as the basename for
				-- the .hi file.
	-> String		-- The directory containing the source file
	-> String		-- The basename of the source file
	-> String		-- The suffix of the source file
	-> (FilePath, ModLocation)
mk_src_loc maybe_mod path basename suf = 
    (src_file, 
     ModLocation {
	locSource = Just src_file,
	locHi     = hi_file,
	locObj    = Just obj_file
     }
    )
 where src_file = path ++ '/':basename ++ suf

       hi_file  = hi_path ++ '/':hi_basename ++ hi_suf
       hi_path 
	  | isJust hi_dir = fromJust hi_dir
	  | otherwise     = path
       hi_basename 
	  | isJust maybe_mod = fromJust maybe_mod
	  | otherwise        = basename

       obj_file = obj_path ++ '/':basename ++ obj_suf
       obj_path 
	  | isJust obj_dir = fromJust obj_dir
	  | otherwise      = path

mk_hi_loc path basename suf =
     (hi_file,
      ModLocation {
	locSource = Nothing,
	locHi	  = hi_file,
	locObj    = Nothing
      }
     )
  where hi_file = path ++ '/':basename ++ package_hi_suf

-- -----------------------------------------------------------------------------
-- Utils

type Suffix = String

-- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy", ".ext")
splitFilename3 :: String -> (String,String,Suffix)
splitFilename3 str
   = let (dir, rest) = split_longest_prefix str (=='/')
	 (name, ext) = splitFilename rest
	 real_dir | null dir  = "."
		  | otherwise = dir
     in  (real_dir, name, ext)

splitFilename :: String -> (String,Suffix)
splitFilename f = split_longest_prefix f (=='.')

-- split a string at the last character where 'pred' is True,
-- returning a pair of strings. The first component holds the string
-- up (but not including) the last character for which 'pred' returned
-- True, the second whatever comes after (but also not including the
-- last character).
--
-- If 'pred' returns False for all characters in the string, the original
-- string is returned in the second component (and the first one is just
-- empty).
split_longest_prefix :: String -> (Char -> Bool) -> (String,String)
split_longest_prefix s pred
  = case pre of
	[]      -> ([], reverse suf)
	(_:pre) -> (reverse pre, reverse suf)
  where (suf,pre) = break pred (reverse s)