mkconfig.hs

Haskell是一种程序语言。特别的

                                     ++hc++"'")
                   exitWith (ExitFailure 2)
                   return undefined -- never reached

add :: CompilerConfig -> PersonalConfig -> IO PersonalConfig
add hc config = return $
  case localConfig config of
    Just local -> config { localConfig =
                             Just (local { knownCompilers =
                                             nub (hc: knownCompilers local)})}
    Nothing -> let global = globalConfig config in
               config { globalConfig =
                          global { knownCompilers =
                                             nub (hc: knownCompilers global)}}

{-
-- | configure for each style of compiler
configure :: HC -> String -> IO CompilerConfig
configure Ghc ghcpath = do
  ghcversion <- runAndReadStdout (escape ghcpath ++ " --version 2>&1 | "
                                  ++"sed 's/^.*version[ ]*\\([0-9.]*\\).*/\\1/'"
                                 )
  let ghcsym = let v = (read (take 3 (filter isDigit ghcversion ++ "0"))) :: Int
               in if v <= 600 then v
                  else let hundreds = (v`div`100)*100 in
                       hundreds + ((v-hundreds)`div`10)
      config  = CompilerConfig
			{ compilerStyle = Ghc
			, compilerPath  = ghcpath
			, compilerVersion = ghcversion
			, includePaths  = undefined
			, cppSymbols    = ["__GLASGOW_HASKELL__="++show ghcsym]
			, extraCompilerFlags = []
			, isHaskell98   = ghcsym>=400 }
  if windows && ghcsym<500
    then do
      fullpath <- which exe ghcpath
      let incdir1 = dirname (dirname fullpath)++"/imports"
      ok <- doesDirectoryExist incdir1
      if ok
        then return config{ includePaths = ghcDirs ghcsym incdir1 }
        else do ioError (userError ("Can't find ghc includes at\n  "++incdir1))
    else if ghcsym<500
    then do
      fullpath <- which exe ghcpath
      dir <- runAndReadStdout ("grep '^\\$libdir=' "++fullpath++" | head -1 | "
                               ++ "sed 's/^\\$libdir=[^/]*\\(.*\\).;/\\1/'")
      let incdir1 = dir++"/imports"
      ok <- doesDirectoryExist incdir1
      if ok
        then return config{ includePaths = ghcDirs ghcsym incdir1 }
        else do
          let incdir2 = dir++"/lib/imports"
          ok <- doesDirectoryExist incdir2
          if ok
            then return config{ includePaths = ghcDirs ghcsym incdir2 }
            else do ioError (userError ("Can't find ghc includes at\n  "
                                        ++incdir1++"\n  "++incdir2))
    else do -- 5.00 and above
      pkgcfg <- runAndReadStdout (escape ghcpath++" --print-libdir")
      let libdir  = escape pkgcfg
          incdir1 = libdir++"/imports"
      ok <- doesDirectoryExist incdir1
      if ok
        then do
          fullpath <- fmap escape (which exe ghcpath)
          let ghcpkg0 = dirname fullpath++"/ghc-pkg-"++ghcversion
          ok <- doesFileExist ghcpkg0
          let ghcpkg = if ok then ghcpkg0 else dirname fullpath++"/ghc-pkg"
       -- pkgs <- runAndReadStdout (ghcpkg++" --list-packages")
          pkgs <- runAndReadStdout (ghcpkg++" -l")
          let pkgsOK = filter (\p-> any (`isPrefixOf` p)
                                        ["std","base","haskell98"])
                              (deComma pkgs)
          idirs <- mapM (\p-> runAndReadStdout
                                  (ghcpkg++" --show-package="
                                   ++deVersion (ghcsym>=604) p
                                   ++" --field=import_dirs"))
                        pkgsOK
          return config{ includePaths = pkgDirs libdir (nub idirs) }
        else do ioError (userError ("Can't find ghc includes at "++incdir1))
 where
    -- ghcDirs only static for ghc < 500; for later versions found dynamically
    ghcDirs n root | n < 400   = [root]
                   | n < 406   = map ((root++"/")++) ["std","exts","misc"
                                                     ,"posix"]
                   | otherwise = map ((root++"/")++) ["std","lang","data","net"
                                                     ,"posix","num","text"
                                                     ,"util","hssource"
                                                     ,"win32","concurrent"]
    pkgDirs libdir dirs =
        map (\dir-> if "$libdir" `isPrefixOf` dir
                    then libdir++drop 7 dir
                    else if "[\"" `isPrefixOf` dir
                    then drop 2 (init (init dir))
                    else dir)
            (concatMap words dirs)
    deComma pkgs = map (\p-> if last p==',' then init p else p) (words pkgs)
    deVersion False pkg = pkg
    deVersion True  pkg = let (suf,pref) = span (/='-') (reverse pkg)
                          in case pref of "" -> pkg; _ -> reverse (tail pref)

configure Nhc98 nhcpath = do
  fullpath <- which id nhcpath
  nhcversion <- runAndReadStdout (escape nhcpath
                                  ++" --version 2>&1 | cut -d' ' -f2 | head -1")
  dir <- runAndReadStdout ("grep '^NHC98INCDIR' "++escape fullpath
                           ++ "| cut -c27- | cut -d'}' -f1 | head -1")
  return CompilerConfig { compilerStyle = Nhc98
			, compilerPath  = nhcpath
			, compilerVersion = nhcversion
			, includePaths = [dir]
			, cppSymbols    = ["__NHC__="++
                                           take 3 (filter isDigit nhcversion)]
			, extraCompilerFlags = []
			, isHaskell98   = True
			}
configure Hbc hbcpath = do
  let field n = "| cut -d' ' -f"++show n++" | head -1"
  wibble <- runAndReadStdout (hbcpath ++ " -v 2>&1 " ++ field 2)
  hbcversion <-
      case wibble of
        "version" -> runAndReadStdout (hbcpath ++ " -v 2>&1 " ++ field 3)
        _         -> runAndReadStdout (hbcpath ++ " -v 2>&1 " ++ field 4)
  dir <- catch (getEnv "HBCDIR")
               (\e-> catch (getEnv "LMLDIR")
                           (\e-> return "/usr/local/lib/lmlc"))
  return CompilerConfig { compilerStyle = Hbc
			, compilerPath  = hbcpath
			, compilerVersion = hbcversion
			, includePaths = map ((dir++"/")++)
                                              ["hlib1.3","hbc_library1.3"]
			, cppSymbols    = ["__HBC__"]
			, extraCompilerFlags = []
			, isHaskell98   = ((hbcversion!!7) >= '5')
			}
configure (Unknown hc) hcpath = do
    hPutStrLn stderr ("hmake-config: the compiler\n  '"++hcpath
                      ++"'\n  does not look like a Haskell compiler.")
    exitWith (ExitFailure 4)
    return undefined  -- never reached

-- | Work out which basic compiler.
hcStyle :: String -> HC
hcStyle path = toCompiler (basename path)
  where
    toCompiler :: String -> HC
    toCompiler hc | "gcc" `isPrefixOf` hc = Nhc98
                  | "nhc" `isPrefixOf` hc = Nhc98
                  | "ghc" `isPrefixOf` hc = Ghc
                  | "hbc" `isPrefixOf` hc = Hbc
                  | otherwise             = Unknown hc

-- | Emulate the shell `which` command.
which :: (String->String) -> String -> IO String
which exe cmd =
  let dir = dirname cmd
  in case dir of
    "" -> do -- search the shell environment PATH variable for candidates
             val <- getEnv "PATH"
             let psep = pathSep val
                 dirs = splitPath psep "" val
             search <- foldM (\a dir-> testFile a (dir++'/': exe cmd))
                             Nothing dirs
             case search of
               Just x  -> return x
               Nothing -> ioError (userError (cmd++" not found"))
    _  -> do f <- testFile Nothing (exe cmd)
             case f of
               Just x  -> return x
               Nothing -> ioError (userError (cmd++" is not executable"))
  where
    splitPath :: Char -> String -> String -> [String]
    splitPath sep acc []                 = [reverse acc]
    splitPath sep acc (c:path) | c==sep  = reverse acc : splitPath sep "" path
    splitPath sep acc (c:path)           = splitPath sep (c:acc) path

    pathSep s = if length (filter (==';') s) >0 then ';' else ':'

    testFile :: Maybe String -> String -> IO (Maybe String)
    testFile gotit@(Just _) path = return gotit
    testFile Nothing path = do
        ok <- doesFileExist path
        if ok then perms path else return Nothing

    perms file = do
        p <- getPermissions file
        return (if executable p then Just file else Nothing)
-}