Reorganize module namespace

- Remove Language.Haskell prefix from all modules
- Move 'GHCMod.*' to 'GhcMod.Exe'
- Move 'GhcModExe' to 'GhcMod.Exe'

core/GhcMod/Utils.hs

@@ -0,0 +1,165 @@
+-- ghc-mod: Happy Haskell Hacking
+-- Copyright (C) 2015  Daniel Gröber <dxld ÄT darkboxed DOT org>
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU Affero General Public License as published by
+-- the Free Software Foundation, either version 3 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-- GNU Affero General Public License for more details.
+--
+-- You should have received a copy of the GNU Affero General Public License
+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DoAndIfThenElse #-}
+
+module GhcMod.Utils (
+    module GhcMod.Utils
+  , module Utils
+  , readProcess
+  ) where
+
+import Control.Applicative
+import Data.Char
+import qualified Data.Map as M
+import Data.Maybe (fromMaybe)
+import Data.Either (rights)
+import Data.List (inits)
+import Exception
+import GhcMod.Error
+import GhcMod.Types
+import GhcMod.Monad.Types
+import System.Directory
+import System.Environment
+import System.FilePath
+import System.IO.Temp (createTempDirectory)
+import System.Process (readProcess)
+import Text.Printf
+
+import Paths_ghc_mod (getLibexecDir, getBinDir)
+import Utils
+import Prelude
+
+-- dropWhileEnd is not provided prior to base 4.5.0.0.
+dropWhileEnd :: (a -> Bool) -> [a] -> [a]
+dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) []
+
+withDirectory_ :: (MonadIO m, ExceptionMonad m) => FilePath -> m a -> m a
+withDirectory_ dir action =
+  gbracket
+    (liftIO getCurrentDirectory)
+    (liftIO . setCurrentDirectory)
+    (\_ -> liftIO (setCurrentDirectory dir) >> action)
+
+uniqTempDirName :: FilePath -> FilePath
+uniqTempDirName dir =
+  "ghc-mod" ++ map escapeDriveChar drive ++ map escapePathChar path
+  where
+    (drive, path) = splitDrive dir
+    escapeDriveChar :: Char -> Char
+    escapeDriveChar c
+      | isAlphaNum c = c
+      | otherwise     = '-'
+    escapePathChar :: Char -> Char
+    escapePathChar c
+      | c `elem` pathSeparators = '-'
+      | otherwise               = c
+
+newTempDir :: FilePath -> IO FilePath
+newTempDir _dir =
+  flip createTempDirectory "ghc-mod" =<< getTemporaryDirectory
+
+whenM :: Monad m => m Bool -> m () -> m ()
+whenM mb ma = mb >>= flip when ma
+
+-- | Returns the path to the currently running ghc-mod executable. With ghc<7.6
+-- this is a guess but >=7.6 uses 'getExecutablePath'.
+ghcModExecutable :: IO FilePath
+ghcModExecutable = do
+    exe <- getExecutablePath'
+    stack <- lookupEnv "STACK_EXE"
+    case takeBaseName exe of
+      "spec" | Just _ <- stack ->
+          (</> "ghc-mod") <$> getBinDir
+      "spec" ->
+          (</> "dist/build/ghc-mod/ghc-mod") <$> getCurrentDirectory
+      "ghc-mod" ->
+          return exe
+      _ ->
+          return $ takeDirectory exe </> "ghc-mod"
+
+getExecutablePath' :: IO FilePath
+#if __GLASGOW_HASKELL__ >= 706
+getExecutablePath' = getExecutablePath
+#else
+getExecutablePath' = getProgName
+#endif
+
+canonFilePath :: FilePath -> IO FilePath
+canonFilePath f = do
+  p <- canonicalizePath f
+  e <- doesFileExist p
+  when (not e) $ error $ "canonFilePath: not a file: " ++ p
+  return p
+
+withMappedFile :: (IOish m, GmState m, GmEnv m) =>
+                  forall a. FilePath -> (FilePath -> m a) -> m a
+withMappedFile file action = getCanonicalFileNameSafe file >>= lookupMMappedFile >>= runWithFile
+  where
+    runWithFile (Just to) = action $ fmPath to
+    runWithFile _ = action file
+
+getCanonicalFileNameSafe :: (IOish m, GmEnv m) => FilePath -> m FilePath
+getCanonicalFileNameSafe fn = do
+  let fn' = normalise fn
+  pl <- liftIO $ rights <$> (mapM ((try :: IO FilePath -> IO (Either SomeException FilePath)) . canonicalizePath . joinPath) $ reverse $ inits $ splitPath' fn')
+  return $
+    if (length pl > 0)
+    then joinPath $ (head pl):(drop (length pl - 1) (splitPath fn'))
+    else error "Current dir doesn't seem to exist?"
+  where
+#if __GLASGOW_HASKELL__ < 710
+    splitPath' = (".":) . splitPath
+#else
+    splitPath' = splitPath
+#endif
+
+mkRevRedirMapFunc :: (Functor m, GmState m, GmEnv m) => m (FilePath -> FilePath)
+mkRevRedirMapFunc = do
+  rm <- M.fromList <$> map (uncurry mf) <$> M.toList <$> getMMappedFiles
+  crdl <- cradle
+  return $ \key ->
+    fromMaybe key
+    $ makeRelative (cradleRootDir crdl)
+    <$> M.lookup key rm
+  where
+    mf :: FilePath -> FileMapping -> (FilePath, FilePath)
+    mf from to = (fmPath to, from)
+
+findFilesWith' :: (FilePath -> IO Bool) -> [FilePath] -> String -> IO [FilePath]
+findFilesWith' _ [] _ = return []
+findFilesWith' f (d:ds) fileName = do
+    let file = d </> fileName
+    exist <- doesFileExist file
+    b <- if exist then f file else return False
+    if b then do
+               files <- findFilesWith' f ds fileName
+               return $ file : files
+        else findFilesWith' f ds fileName
+
+
+-- Copyright   :  (c) The University of Glasgow 2001
+-- | Make a path absolute by prepending the current directory (if it isn't
+-- already absolute) and applying 'normalise' to the result.
+--
+-- If the path is already absolute, the operation never fails.  Otherwise, the
+-- operation may fail with the same exceptions as 'getCurrentDirectory'.
+makeAbsolute' :: FilePath -> IO FilePath
+makeAbsolute' = (normalise <$>) . absolutize
+  where absolutize path -- avoid the call to `getCurrentDirectory` if we can
+          | isRelative path = (</> path) <$> getCurrentDirectory
+          | otherwise       = return path