[commit: hsc2hs] ghc-7.6: Use filepath's function instead of own (fixes #7191) (67b8c66)

Repository : ssh://darcs.haskell.org//srv/darcs/hsc2hs

On branch  : ghc-7.6

http://hackage.haskell.org/trac/ghc/changeset/67b8c663216690150b6f762e09b32ebbe6334ddd

>---------------------------------------------------------------

commit 67b8c663216690150b6f762e09b32ebbe6334ddd
Author: shelarcy <[email protected]>
Date:   Wed Oct 3 13:33:48 2012 +0900

    Use filepath's function instead of own (fixes #7191)
    
    MERGED from commit 2f1d9d3009d6193cc664d85ec24de20ce0380db4

>---------------------------------------------------------------

 C.hs             |    6 +++---
 Common.hs        |   35 -----------------------------------
 DirectCodegen.hs |    3 ++-
 Main.hs          |   13 +++++++------
 hsc2hs.cabal     |    1 +
 5 files changed, 13 insertions(+), 45 deletions(-)

diff --git a/C.hs b/C.hs
index 537d77a..11d31f2 100644
--- a/C.hs
+++ b/C.hs
@@ -8,9 +8,9 @@ compiled and run; the output of that program is the .hs file.
 
 import Data.Char                ( isSpace, intToDigit, ord )
 import Data.List                ( intersperse )
-import HSCParser                ( SourcePos(..), Token(..) )
+import System.FilePath          ( splitFileName )
 
-import Common
+import HSCParser                ( SourcePos(..), Token(..) )
 import Flags
 
 outTemplateHeaderCProg :: FilePath -> String
@@ -181,7 +181,7 @@ conditional _         = False
 
 outCLine :: SourcePos -> String
 outCLine (SourcePos name line) =
-    "#line "++show line++" \""++showCString (snd (splitName name))++"\"\n"
+    "#line "++show line++" \""++showCString (snd (splitFileName name))++"\"\n"
 
 outHsLine :: SourcePos -> String
 outHsLine (SourcePos name line) =
diff --git a/Common.hs b/Common.hs
index 0c60ca1..120f744 100644
--- a/Common.hs
+++ b/Common.hs
@@ -22,24 +22,6 @@ default_compiler = "gcc"
 ------------------------------------------------------------------------
 -- Write the output files.
 
-splitName :: String -> (String, String)
-splitName name =
-    case break (== '/') name of
-        (file, [])       -> ([], file)
-        (dir,  sep:rest) -> (dir++sep:restDir, restFile)
-            where
-            (restDir, restFile) = splitName rest
-
-splitExt :: String -> (String, String)
-splitExt name =
-    case break (== '.') name of
-        (base, [])         -> (base, [])
-        (base, sepRest@(sep:rest))
-            | null restExt -> (base,               sepRest)
-            | otherwise    -> (base++sep:restBase, restExt)
-            where
-            (restBase, restExt) = splitExt rest
-
 writeBinaryFile :: FilePath -> String -> IO ()
 writeBinaryFile fp str = withBinaryFile fp WriteMode $ \h -> hPutStr h str
 
@@ -87,20 +69,3 @@ catchIO = Exception.catch
 onlyOne :: String -> IO a
 onlyOne what = die ("Only one "++what++" may be specified\n")
 
------------------------------------------
--- Modified version from ghc/compiler/SysTools
--- Convert paths foo/baz to foo\baz on Windows
-
-subst :: Char -> Char -> String -> String
-#if defined(mingw32_HOST_OS) || defined(__CYGWIN32__)
-subst a b = map (\x -> if x == a then b else x)
-#else
-subst _ _ = id
-#endif
-
-dosifyPath :: String -> String
-dosifyPath = subst '/' '\\'
-
-unDosifyPath :: String -> String
-unDosifyPath = subst '\\' '/'
-
diff --git a/DirectCodegen.hs b/DirectCodegen.hs
index deec791..42b31a5 100644
--- a/DirectCodegen.hs
+++ b/DirectCodegen.hs
@@ -10,6 +10,7 @@ import Data.Char                ( isAlphaNum, toUpper )
 import Control.Monad            ( when, forM_ )
 
 import System.Exit              ( ExitCode(..), exitWith )
+import System.FilePath          ( normalise )
 
 import C
 import Common
@@ -35,7 +36,7 @@ outputDirect config outName outDir outBase name toks = do
         outCName     = outDir++outBase++"_hsc.c"
 
     let execProgName
-            | null outDir = dosifyPath ("./" ++ progName)
+            | null outDir = normalise ("./" ++ progName)
             | otherwise   = progName
 
     let specials = [(pos, key, arg) | Special pos key arg <- toks]
diff --git a/Main.hs b/Main.hs
index 48aede9..30b3a2d 100644
--- a/Main.hs
+++ b/Main.hs
@@ -25,6 +25,7 @@ import Foreign.C.String
 import System.Directory         ( doesFileExist, findExecutable )
 import System.Environment       ( getProgName, getArgs )
 import System.Exit              ( ExitCode(..), exitWith )
+import System.FilePath          ( normalise, splitFileName, splitExtension )
 import System.IO
 
 #ifdef BUILD_NHC
@@ -117,14 +118,14 @@ processFiles configM files usage = do
                             then return (dir++base++"_out.hs", dir, base)
                             else return (dir++base++".hs",     dir, base)
                    where
-                    (dir,  file) = splitName name
-                    (base, ext)  = splitExt  file
+                    (dir,  file) = splitFileName  name
+                    (base, ext)  = splitExtension file
              [f] -> let
-                 (dir,  file) = splitName f
-                 (base, _)    = splitExt file
+                 (dir,  file) = splitFileName  f
+                 (base, _)    = splitExtension file
                  in return (f, dir, base)
              _ -> onlyOne "output file"
-        let file_name = dosifyPath name
+        let file_name = normalise name
         toks <- parseFile file_name
         outputter config outName outDir outBase file_name toks)
 
@@ -218,7 +219,7 @@ getExecDir :: String -> IO (Maybe String)
 getExecDir cmd =
     getExecPath >>= maybe (return Nothing) removeCmdSuffix
     where initN n = reverse . drop n . reverse
-          removeCmdSuffix = return . Just . initN (length cmd) . unDosifyPath
+          removeCmdSuffix = return . Just . initN (length cmd) . normalise
 
 getExecPath :: IO (Maybe String)
 #if defined(mingw32_HOST_OS)
diff --git a/hsc2hs.cabal b/hsc2hs.cabal
index c5a13be..36323b2 100644
--- a/hsc2hs.cabal
+++ b/hsc2hs.cabal
@@ -39,5 +39,6 @@ Executable hsc2hs
     Build-Depends: base       >= 4   && < 5,
                    containers >= 0.2 && < 0.6,
                    directory  >= 1   && < 1.3,
+                   filepath   >= 1   && < 1.4,
                    process    >= 1   && < 1.2