[hoc-cvs] [hoc commit] r320 - trunk/hoc/Tools

[<cod...@go...>]

Author: wol...@gm...
Date: Mon Sep 29 13:12:09 2008
New Revision: 320

Added:
    trunk/hoc/Tools/HOC-Tools.cabal
    trunk/hoc/Tools/Setup.hs
Modified:
    trunk/hoc/Tools/HOCWrap.hs

Log:
Add cabal file for HOCWrap


Added: trunk/hoc/Tools/HOC-Tools.cabal
==============================================================================
--- (empty file)
+++ trunk/hoc/Tools/HOC-Tools.cabal	Mon Sep 29 13:12:09 2008
@@ -0,0 +1,10 @@
+name: HOC-Tools
+version: 1.0
+build-type: Simple
+
+-- containers, bytestring, mtl, pretty, parsec, fgl,
+ --              template-haskell, binary >= 0.2, old-time, directory
+
+executable: hoc-wrap
+main-is: HOCWrap.hs
+build-depends: base, unix, HOC, HOC-Foundation, process, filepath

Modified: trunk/hoc/Tools/HOCWrap.hs
==============================================================================
--- trunk/hoc/Tools/HOCWrap.hs	(original)
+++ trunk/hoc/Tools/HOCWrap.hs	Mon Sep 29 13:12:09 2008
@@ -1,18 +1,21 @@
  module Main where

  import Prelude                  hiding ( init )
+import qualified Prelude

  import Control.Exception        ( handle, throw, handleJust, userErrors )
  import Control.Monad            ( when )
  import Data.List                ( isSuffixOf )
  import System.Console.GetOpt
  import System.Environment       ( getArgs, getProgName )
-import System.IO                ( hPutStrLn, hClose )
+import System.IO                ( hPutStrLn, hClose, hGetContents )
  import System.IO.Unsafe         ( unsafePerformIO )
  import System.Exit              ( exitWith, ExitCode(..) )
  import System.Posix             ( createPipe, dupTo, stdInput, closeFd,
                                    fdToHandle, forkProcess, executeFile,
                                    getProcessStatus )
+import System.Process           ( runInteractiveCommand, waitForProcess )
+import System.FilePath          ( (</>), takeFileName, takeBaseName )

  import HOC
  import Foundation.NSFileManager
@@ -20,6 +23,16 @@
  import Foundation.NSDictionary
  import Foundation.NSObject

+backquote :: String -> IO String
+
+backquote cmd = do
+    (inp,out,err,pid) <- runInteractiveCommand cmd
+    hClose inp
+    text <- hGetContents out
+    waitForProcess pid
+    hClose err
+    return text
+
  data Option = OutputApp String
              | Contents String
              | Interpret
@@ -78,7 +91,7 @@

                  appName def = forceDotApp $
                                head $ [ s | OutputApp s <- opts ]
-                                  ++ [def]
+                                  ++ [takeBaseName def]

                  forceDotApp x | ".app" `isSuffixOf` x = x
                                | otherwise = x ++ ".app"
@@ -147,9 +160,8 @@

      let executableInApp = take (length appName - length ".app") appName

-
-    let ghcLib = "/usr/local/lib/ghc-6.4"
-        ghcExecutable = ghcLib ++ "/ghc-6.4"
+    ghcLib <- fmap Prelude.init $ backquote "ghc --print-libdir"
+    let ghcExecutable =  ghcLib </> takeFileName ghcLib

      wrapApp' True False ghcExecutable appName contents


Added: trunk/hoc/Tools/Setup.hs
==============================================================================
--- (empty file)
+++ trunk/hoc/Tools/Setup.hs	Mon Sep 29 13:12:09 2008
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain