Merge branch 'master' into release

Language/Haskell/GhcMod/Browse.hs

@@ -61,13 +61,23 @@ splitPkgMdl pkgmdl = case break (==':') pkgmdl of
     (mdl,"")    -> (Nothing,mdl)
     (pkg,_:mdl) -> (Just pkg,mdl)
 
+-- Haskell 2010:
+-- small -> ascSmall | uniSmall | _
+-- ascSmall -> a | b | ... | z
+-- uniSmall -> any Unicode lowercase letter
+-- varid -> (small {small | large | digit | ' })
+
+isNotOp :: String -> Bool
+isNotOp (h:_) = isAlpha h || (h == '_')
+isNotOp _ = error "isNotOp"
+
 processExports :: IOish m => ModuleInfo -> GhcModT m [String]
 processExports minfo = do
   opt <- options
   let
     removeOps
       | operators opt = id
-      | otherwise = filter (isAlpha . head . getOccString)
+      | otherwise = filter (isNotOp . getOccString)
   mapM (showExport opt minfo) $ removeOps $ G.modInfoExports minfo
 
 showExport :: IOish m => Options -> ModuleInfo -> Name -> GhcModT m String
@@ -87,10 +97,10 @@ showExport opt minfo e = do
           typeName <- tyResult >>= showThing dflag
           (" :: " ++ typeName) `justIf` detailed opt
       | otherwise = return Nothing
-    formatOp nm@(n:_)
-      | isAlpha n = nm
-      | otherwise = "(" ++ nm ++ ")"
-    formatOp "" = error "formatOp"
+    formatOp nm
+      | null nm    = error "formatOp"
+      | isNotOp nm = nm
+      | otherwise  = "(" ++ nm ++ ")"
     inOtherModule :: IOish m => Name -> GhcModT m (Maybe TyThing)
     inOtherModule nm = G.getModuleInfo (G.nameModule nm) >> G.lookupGlobalName nm
     justIf :: a -> Bool -> Maybe a

Language/Haskell/GhcMod/Monad.hs

@@ -77,7 +77,10 @@ import Data.Monoid (Monoid)
 
 import Control.Applicative (Alternative)
 import Control.Arrow (first)
-import Control.Monad (MonadPlus, void, liftM)
+import Control.Monad (MonadPlus, void)
+#if !MIN_VERSION_monad_control(1,0,0)
+import Control.Monad (liftM)
+#endif
 import Control.Monad.Base (MonadBase, liftBase)
 
 -- Monad transformer stuff
@@ -270,16 +273,18 @@ runGhcModT :: IOish m
            => Options
            -> GhcModT m a
            -> m (Either GhcModError a, GhcModLog)
-runGhcModT opt action = do
-    env <- liftBase $ newGhcModEnv opt =<< getCurrentDirectory
+runGhcModT opt action = gbracket newEnv delEnv $ \env -> do
     r <- first (fst <$>) <$> (runGhcModT' env defaultState $ do
         dflags <- getSessionDynFlags
         defaultCleanupHandler dflags $ do
             initializeFlagsWithCradle opt (gmCradle env)
             action)
-    liftBase $ cleanupGhcModEnv env
     return r
 
+ where
+   newEnv = liftBase $ newGhcModEnv opt =<< getCurrentDirectory
+   delEnv = liftBase . cleanupGhcModEnv
+
 -- | @hoistGhcModT result@. Embed a GhcModT computation's result into a GhcModT
 -- computation. Note that if the computation that returned @result@ modified the
 -- state part of GhcModT this cannot be restored.
@@ -366,6 +371,23 @@ withOptions changeOpt action = local changeEnv action
 instance (MonadBaseControl IO m) => MonadBase IO (GhcModT m) where
     liftBase = GhcModT . liftBase
 
+#if MIN_VERSION_monad_control(1,0,0)
+
+instance (MonadBaseControl IO m) => MonadBaseControl IO (GhcModT m) where
+    type StM (GhcModT m) a =
+          StM (StateT GhcModState
+                (ErrorT GhcModError
+                  (JournalT GhcModLog
+                    (ReaderT GhcModEnv m) ) ) ) a
+    liftBaseWith f = GhcModT . liftBaseWith $ \runInBase ->
+        f $ runInBase . unGhcModT
+
+    restoreM = GhcModT . restoreM
+    {-# INLINE liftBaseWith #-}
+    {-# INLINE restoreM #-}
+
+#else
+
 instance (MonadBaseControl IO m) => MonadBaseControl IO (GhcModT m) where
     newtype StM (GhcModT m) a = StGhcMod {
           unStGhcMod :: StM (StateT GhcModState
@@ -379,6 +401,8 @@ instance (MonadBaseControl IO m) => MonadBaseControl IO (GhcModT m) where
     {-# INLINE liftBaseWith #-}
     {-# INLINE restoreM #-}
 
+#endif
+
 -- GHC cannot prove the following instances to be decidable automatically using
 -- the FlexibleContexts extension as they violate the second Paterson Condition,
 -- namely that: The assertion has fewer constructors and variables (taken

Language/Haskell/GhcMod/Utils.hs

@@ -54,8 +54,7 @@ withDirectory_ dir action =
                 (\_ -> liftIO (setCurrentDirectory dir) >> action)
 
 uniqTempDirName :: FilePath -> FilePath
-uniqTempDirName dir =
-    uncurry (++)
+uniqTempDirName dir = ("ghc-mod"++) $ uncurry (++)
         $ map escapeDriveChar *** map escapePathChar
         $ splitDrive dir
  where