packages feed

hsdev 0.2.2.2 → 0.2.3.0

raw patch · 16 files changed

+176/−169 lines, 16 filesdep +mmorphdep ~hformatdep ~simple-log

Dependencies added: mmorph

Dependency ranges changed: hformat, simple-log

Files

hsdev.cabal view
@@ -1,5 +1,5 @@ name:                hsdev
-version:             0.2.2.2
+version:             0.2.3.0
 synopsis:            Haskell development library
 description:
   Haskell development library and tool with support of autocompletion, symbol info, go to declaration, find references, hayoo search etc.
@@ -131,20 +131,21 @@     ghc-syb-utils >= 0.2.3,
     haskell-src-exts >= 1.18.0 && < 1.20.0,
     hdocs >= 0.5.0,
-    hformat == 0.1.*,
+    hformat == 0.2.*,
     hlint >= 1.9.13 && < 2.0.0,
     HTTP >= 4000.2.0,
     lens >= 4.8,
     lifted-base >= 0.2,
     monad-control >= 1.0,
     monad-loops >= 0.4,
+    mmorph == 1.0.*,
     mtl >= 2.2.0,
     network >= 2.6.0,
     optparse-applicative >= 0.11,
     process >= 1.2.0,
     regex-pcre-builtin >= 0.94,
     scientific >= 0.3,
-    simple-log >= 0.5 && < 0.6,
+    simple-log == 0.8.*,
     syb >= 0.5.1,
     template-haskell,
     text >= 1.2.0,
@@ -209,6 +210,7 @@   hs-source-dirs: tools
   ghc-options: -Wall -fno-warn-tabs
   other-modules:
+    Tool
   build-depends:
     base >= 4.7 && < 5,
     hsdev,
@@ -302,7 +304,7 @@     directory,
     filepath >= 1.4.0,
     containers >= 0.5.0,
-    hformat == 0.1.*,
+    hformat == 0.2.*,
     hspec,
     lens >= 4.8,
     mtl >= 2.2.0,
src/HsDev/Client/Commands.hs view
@@ -19,11 +19,12 @@ import Data.Maybe
 import qualified Data.Map as M
 import Data.String (fromString)
-import Data.Text (unpack)
+import Data.Text (pack, unpack)
 import qualified Data.Text as T (isInfixOf, isPrefixOf, isSuffixOf)
 import System.Directory
 import System.FilePath
 import qualified System.Log.Simple as Log
+import qualified System.Log.Simple.Base as Log
 import Text.Regex.PCRE ((=~))
 
 import qualified System.Directory.Watcher as W
@@ -67,13 +68,17 @@ 
 runCommand :: ServerMonadBase m => Command -> ClientM m Value
 runCommand Ping = toValue $ return $ object ["message" .= ("pong" :: String)]
-runCommand (Listen (Just r)) = bracket (serverSetLogRules ["/: {}" ~~ r]) serverSetLogRules $ \_ -> runCommand (Listen Nothing)
+runCommand (Listen (Just l)) = case Log.level (pack l) of
+	Nothing -> hsdevError $ OtherError $ "invalid log level: {}" ~~ l
+	Just lev -> bracket (serverSetLogLevel lev) serverSetLogLevel $ \_ -> runCommand (Listen Nothing)
 runCommand (Listen Nothing) = toValue $ do
 	serverListen >>= mapM_ (\msg -> commandNotify (Notification $ object ["message" .= msg]))
-runCommand (SetLogConfig rs) = toValue $ do
-	rules' <- serverSetLogRules rs
-	Log.log Log.Debug $ "log rules switched from '{}' to '{}'" ~~ intercalate ", " rules' ~~ intercalate ", " rs
-	Log.log Log.Info $ "log rules updated to: {}" ~~ intercalate ", " rs
+runCommand (SetLogLevel l) = case Log.level (pack l) of
+	Nothing -> hsdevError $ OtherError $ "invalid log level: {}" ~~ l
+	Just lev -> toValue $ do
+		lev' <- serverSetLogLevel lev
+		Log.sendLog Log.Debug $ "log level changed from '{}' to '{}'" ~~ show lev' ~~ show lev
+		Log.sendLog Log.Info $ "log level updated to: {}" ~~ show lev
 runCommand (AddData cts) = toValue $ mapM_ updateData cts where
 	updateData (AddedDatabase db) = toValue $ serverUpdateDB db
 	updateData (AddedModule m) = toValue $ serverUpdateDB $ fromModule m
@@ -279,7 +284,7 @@ 	TargetPackageDb pdb -> return $ inPackageDb pdb
 	TargetCabal -> return $ inPackageDbStack userDb
 	TargetSandbox sbox -> liftM inPackageDbStack $ findSandbox sbox >>= sandboxPackageDbStack
-	TargetPackage pack -> liftM inPackage $ refinePackage pack
+	TargetPackage pkg -> liftM inPackage $ refinePackage pkg
 	TargetSourced -> return byFile
 	TargetStandalone -> return standalone
 
@@ -325,11 +330,11 @@ 
 -- | Ensure package exists
 refinePackage :: CommandMonad m => String -> m String
-refinePackage pack = do
+refinePackage pkg = do
 	db' <- getDb
-	if pack `elem` (allPackages db' ^.. each . packageName)
-		then return pack
-		else hsdevError (PackageNotFound pack)
+	if pkg `elem` (allPackages db' ^.. each . packageName)
+		then return pkg
+		else hsdevError (PackageNotFound pkg)
 
 -- | Get list of enumerated sandboxes
 getSandboxes :: CommandMonad m => [FilePath] -> m [Sandbox]
@@ -395,11 +400,11 @@ updateProcess :: ServerMonadBase m => Update.UpdateOptions -> [Update.UpdateM m ()] -> ClientM m ()
 updateProcess uopts acts = Update.runUpdate uopts $ mapM_ runAct acts where
 	runAct act = catch act onError
-	onError e = Log.log Log.Error $ "{}" ~~ (e :: HsDevError)
+	onError e = Log.sendLog Log.Error $ "{}" ~~ (e :: HsDevError)
 
 -- | Ensure file is up to date
-ensureUpToDate :: ServerMonadBase m => Update.UpdateOptions -> [FileSource] -> ClientM m ()
-ensureUpToDate uopts fs = updateProcess uopts [Update.scanFileContents (view Update.updateGhcOpts uopts) f mcts | FileSource f mcts <- fs]
+-- ensureUpToDate :: ServerMonadBase m => Update.UpdateOptions -> [FileSource] -> ClientM m ()
+-- ensureUpToDate uopts fs = updateProcess uopts [Update.scanFileContents (view Update.updateGhcOpts uopts) f mcts | FileSource f mcts <- fs]
 
 -- | Filter declarations with prefix and infix
 filterMatch :: Symbol a => SearchQuery -> [a] -> [a]
src/HsDev/Database/Update.hs view
@@ -102,10 +102,10 @@ 					db' <- liftIO $ readAsync db
 					return $ filter ((`elem` mlocs') . view inspectedId) $ toList $ databaseModules db'
 			when (view updateDocs uopts) $ do
-				Log.log Log.Trace "forking inspecting source docs"
+				Log.sendLog Log.Trace "forking inspecting source docs"
 				void $ fork (getMods >>= waiter . mapM_ scanDocs_)
 			when (view updateInfer uopts) $ do
-				Log.log Log.Trace "forking inferring types"
+				Log.sendLog Log.Trace "forking inferring types"
 				void $ fork (getMods >>= waiter . mapM_ inferModTypes_)
 			return r
 		scanDocs_ :: UpdateMonad m => InspectedModule -> m ()
@@ -253,7 +253,7 @@ 		scannedDbs = databasePackageDbs dbval
 		unscannedDbs = filter ((`notElem` scannedDbs) . topPackageDb) $ reverse $ packageDbStacks userDb
 	if null unscannedDbs
-		then Log.log Log.Trace $ "cabal (global-db and user-db) already scanned"
+		then Log.sendLog Log.Trace $ "cabal (global-db and user-db) already scanned"
 		else runTasks $ map (scanPackageDb opts) unscannedDbs
 
 -- | Prepare sandbox for scanning. This is used for stack project to build & configure.
@@ -275,7 +275,7 @@ 		scannedDbs = databasePackageDbs dbval
 		unscannedDbs = filter ((`notElem` scannedDbs) . topPackageDb) $ reverse $ packageDbStacks pdbs
 	if null unscannedDbs
-		then Log.log Log.Trace $ "sandbox already scanned"
+		then Log.sendLog Log.Trace $ "sandbox already scanned"
 		else runTasks $ map (scanPackageDb opts) unscannedDbs
 
 -- | Scan top of package-db stack, usable for rescan
@@ -305,7 +305,7 @@ scanProjectStack opts cabal = do
 	proj <- scanProjectFile opts cabal
 	scanProject opts cabal
-	sbox <- liftIO $ searchSandbox (view projectPath proj)
+	sbox <- liftIO $ projectSandbox (view projectPath proj)
 	maybe (scanCabal opts) (scanSandbox opts) sbox
 
 -- | Scan project
@@ -337,12 +337,12 @@ 		srcs = standSrcs ^.. each . _1 . moduleFile
 		inSrcs src = src `elem` srcs && src `notElem` files
 		inFiles = maybe False inSrcs . preview (moduleIdLocation . moduleFile)
-	mapMOf_ (each . _1 . projectCabal) (\p -> Log.log Log.Trace ("scanning project: {}" ~~ p)) projSrcs
+	mapMOf_ (each . _1 . projectCabal) (\p -> Log.sendLog Log.Trace ("scanning project: {}" ~~ p)) projSrcs
 	runTasks [scanProject opts (view projectCabal p) | (p, _) <- projSrcs, view projectCabal p `notElem` projs]
-	mapMOf_ (each . _1 . moduleFile) (\f -> Log.log Log.Trace ("scanning file: {}" ~~ f)) standSrcs
+	mapMOf_ (each . _1 . moduleFile) (\f -> Log.sendLog Log.Trace ("scanning file: {}" ~~ f)) standSrcs
 	mapMOf_ (each . _1) (watch . flip watchModule) standSrcs
 	scan (Cache.loadFiles inSrcs) (filterDB inFiles (const False) . standaloneDB) standSrcs opts $ scanModules opts
-	mapMOf_ each (\s -> Log.log Log.Trace ("scanning package-db: {}" ~~ topPackageDb s)) pdbss
+	mapMOf_ each (\s -> Log.sendLog Log.Trace ("scanning package-db: {}" ~~ topPackageDb s)) pdbss
 	runTasks [scanPackageDb opts pdbs' | pdbs' <- pdbss, topPackageDb pdbs' `notElem` pdbs]
 
 -- | Scan docs for inspected modules
@@ -354,14 +354,14 @@ 	where
 		scanDocs' im
 			| not $ hasTag RefinedDocsTag im = runTask "scanning docs" (view inspectedId im) $ Log.scope "docs" $ do
-				Log.log Log.Trace $ "Scanning docs for {}" ~~  view inspectedId im
+				Log.sendLog Log.Trace $ "Scanning docs for {}" ~~  view inspectedId im
 				im' <- (liftM (setTag RefinedDocsTag) $ S.scanModify doScan im)
 					<|> return im
-				Log.log Log.Trace $ "Docs for {} updated: documented {} declarations" ~~
+				Log.sendLog Log.Trace $ "Docs for {} updated: documented {} declarations" ~~
 					view inspectedId im' ~~
 					length (im' ^.. inspectionResult . _Right . moduleDeclarations . each . declarationDocs . _Just)
 				updater $ fromModule im'
-			| otherwise = Log.log Log.Trace $ "Docs for {} already scanned" ~~ view inspectedId im
+			| otherwise = Log.sendLog Log.Trace $ "Docs for {} already scanned" ~~ view inspectedId im
 		doScan _ _ m = do
 			w <- askSession sessionGhc
 			liftIO $ inWorker w $ do
@@ -374,13 +374,13 @@ 	inferModTypes' im
 		| not $ hasTag InferredTypesTag im = runTask "inferring types" (view inspectedId im) $ Log.scope "docs" $ do
 			w <- askSession sessionGhc
-			Log.log Log.Trace $ "Inferring types for {}" ~~ view inspectedId im
+			Log.sendLog Log.Trace $ "Inferring types for {}" ~~ view inspectedId im
 			im' <- (liftM (setTag InferredTypesTag) $
 				S.scanModify (\opts _ m -> liftIO (inWorker w (targetSession opts m >> inferTypes opts m Nothing))) im)
 				<|> return im
-			Log.log Log.Trace $ "Types for {} inferred" ~~ view inspectedId im
+			Log.sendLog Log.Trace $ "Types for {} inferred" ~~ view inspectedId im
 			updater $ fromModule im'
-		| otherwise = Log.log Log.Trace $ "Types for {} already inferred" ~~ view inspectedId im
+		| otherwise = Log.sendLog Log.Trace $ "Types for {} already inferred" ~~ view inspectedId im
 
 -- | Generic scan function. Reads cache only if data is not already loaded, removes obsolete modules and rescans changed modules.
 scan :: UpdateMonad m
@@ -406,9 +406,9 @@ updateEvent :: ServerMonadBase m => Watched -> Event -> UpdateM m ()
 updateEvent (WatchedProject proj projOpts) e
 	| isSource e = do
-		Log.log Log.Info $ "File '{file}' in project {proj} changed"
-			~~ ("file" %= view eventPath e)
-			~~ ("proj" %= view projectName proj)
+		Log.sendLog Log.Info $ "File '{file}' in project {proj} changed"
+			~~ ("file" ~% view eventPath e)
+			~~ ("proj" ~% view projectName proj)
 		dbval <- readDB
 		let
 			opts = fromMaybe [] $ do
@@ -416,20 +416,20 @@ 				preview (inspection . inspectionOpts) $ getInspected dbval m
 		scanFile opts $ view eventPath e
 	| isCabal e = do
-		Log.log Log.Info $ "Project {proj} changed"
-			~~ ("proj" %= view projectName proj)
+		Log.sendLog Log.Info $ "Project {proj} changed"
+			~~ ("proj" ~% view projectName proj)
 		scanProject projOpts $ view projectCabal proj
 	| otherwise = return ()
 updateEvent (WatchedPackageDb pdbs opts) e
 	| isConf e = do
-		Log.log Log.Info $ "Package db {package} changed"
-			~~ ("package" %= topPackageDb pdbs)
+		Log.sendLog Log.Info $ "Package db {package} changed"
+			~~ ("package" ~% topPackageDb pdbs)
 		scanPackageDb opts pdbs
 	| otherwise = return ()
 updateEvent WatchedModule e
 	| isSource e = do
-		Log.log Log.Info $ "Module {file} changed"
-			~~ ("file" %= view eventPath e)
+		Log.sendLog Log.Info $ "Module {file} changed"
+			~~ ("file" ~% view eventPath e)
 		dbval <- readDB
 		let
 			opts = fromMaybe [] $ do
src/HsDev/Database/Update/Types.hs view
@@ -12,6 +12,7 @@ import Control.Monad.Base
 import Control.Monad.Catch
 import Control.Monad.Except
+import Control.Monad.Morph
 import Control.Monad.Reader
 import Control.Monad.Writer
 import Control.Monad.Trans.Control
@@ -96,6 +97,7 @@ 
 instance (MonadIO m, MonadMask m) => Log.MonadLog (UpdateM m) where
 	askLog = UpdateM $ lift $ lift Log.askLog
+	localLog fn = UpdateM . hoist (hoist (Log.localLog fn)) . runUpdateM
 
 instance ServerMonadBase m => SessionMonad (UpdateM m) where
 	getSession = UpdateM $ lift $ lift getSession
src/HsDev/Error.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE FlexibleContexts #-}
+
 module HsDev.Error (
 	hsdevError, hsdevOtherError, hsdevLift, hsdevLiftWith, hsdevCatch, hsdevExcept, hsdevLiftIO, hsdevLiftIOWith, hsdevIgnore,
 	hsdevHandle, hsdevLog,
@@ -11,7 +13,7 @@ import Control.Monad.Catch
 import Control.Monad.Except
 import Data.String (fromString)
-import System.Log.Simple (MonadLog(..), log, Level)
+import System.Log.Simple (MonadLog, sendLog, Level)
 
 import HsDev.Types
 
@@ -58,4 +60,4 @@ -- | Log hsdev exception and rethrow
 hsdevLog :: MonadLog m => Level -> m a -> m a
 hsdevLog lev act = hsdevCatch act >>= either logError return where
-	logError e = log lev (fromString $ show e) >> hsdevError e
+	logError e = sendLog lev (fromString $ show e) >> hsdevError e
src/HsDev/Sandbox.hs view
@@ -3,7 +3,7 @@ module HsDev.Sandbox (
 	SandboxType(..), Sandbox(..), sandboxType, sandbox,
 	isSandbox, guessSandboxType, sandboxFromPath,
-	findSandbox, searchSandbox, sandboxPackageDbStack, searchPackageDbStack, restorePackageDbStack,
+	findSandbox, searchSandbox, projectSandbox, sandboxPackageDbStack, searchPackageDbStack, restorePackageDbStack,
 
 	-- * cabal-sandbox util
 	cabalSandboxLib, cabalSandboxPackageDb,
@@ -11,15 +11,15 @@ 	getModuleOpts
 	) where
 
+import Control.Applicative
 import Control.Arrow
 import Control.DeepSeq (NFData(..))
 import Control.Monad.Trans.Maybe
 import Control.Monad.Except
 import Control.Lens (view, makeLenses)
 import Data.Aeson
+import Data.List (find)
 import Data.Maybe (isJust, fromMaybe)
-import Data.List ((\\))
-import Data.String (fromString)
 import qualified Data.Text as T (unpack)
 import Distribution.Compiler
 import Distribution.System
@@ -27,7 +27,6 @@ import System.FilePath
 import System.Directory
 import System.Log.Simple (MonadLog(..))
-import qualified System.Log.Simple as Log
 
 import System.Directory.Paths
 import HsDev.PackageDb
@@ -36,7 +35,7 @@ import HsDev.Symbols (moduleOpts)
 import HsDev.Symbols.Types (Module(..), ModuleLocation(..), moduleLocation)
 import HsDev.Tools.Ghc.Compat as Compat
-import HsDev.Util (searchPath, directoryContents)
+import HsDev.Util (searchPath, directoryContents, cabalFile)
 
 import qualified Packages as GHC
 
@@ -98,6 +97,15 @@ searchSandbox :: FilePath -> IO (Maybe Sandbox)
 searchSandbox p = runMaybeT $ searchPath p (MaybeT . findSandbox)
 
+-- | Get project sandbox: search up for .cabal, then search for stack.yaml in current directory and cabal sandbox in current + parents
+projectSandbox :: FilePath -> IO (Maybe Sandbox)
+projectSandbox fpath = runMaybeT $ do
+	p <- searchPath fpath (MaybeT . getCabalFile)
+	MaybeT (findSandbox p) <|> searchPath p (MaybeT . findSbox')
+	where
+		getCabalFile = directoryContents >=> return . find cabalFile
+		findSbox' = directoryContents >=> return . msum . map sandboxFromPath
+
 -- | Get package-db stack for sandbox
 sandboxPackageDbStack :: MonadLog m => Sandbox -> m PackageDbStack
 sandboxPackageDbStack (Sandbox CabalSandbox fpath) = do
@@ -108,7 +116,7 @@ -- | Search package-db stack with user-db as default
 searchPackageDbStack :: MonadLog m => FilePath -> m PackageDbStack
 searchPackageDbStack p = do
-	mbox <- liftIO $ searchSandbox p
+	mbox <- liftIO $ projectSandbox p
 	case mbox of
 		Nothing -> return userDb
 		Just sbox -> sandboxPackageDbStack sbox
@@ -143,7 +151,7 @@ getModuleOpts :: MonadLog m => [String] -> Module -> m [String]
 getModuleOpts opts m = do
 	pdbs <- case view moduleLocation m of
-		FileModule fpath p -> searchPackageDbStack fpath
+		FileModule fpath _ -> searchPackageDbStack fpath
 		InstalledModule pdb _ _ -> restorePackageDbStack pdb
 		ModuleSource _ -> return userDb
 	pkgs <- browsePackages opts pdbs
src/HsDev/Server/Base.hs view
@@ -21,16 +21,15 @@ import Data.String
 import Data.Text (Text)
 import qualified Data.Text as T (pack, unpack)
-import System.Log.Simple hiding (Level(..), Message(..), Command(..), (%=))
+import System.Log.Simple hiding (Level(..), Message)
 import qualified System.Log.Simple.Base as Log
-import qualified System.Log.Simple as Log
 import System.Directory (removeDirectoryRecursive, createDirectoryIfMissing)
 import System.FilePath
 
 import qualified Control.Concurrent.FiniteChan as F
 import System.Directory.Paths (canonicalize)
 import qualified System.Directory.Watcher as Watcher
-import Text.Format ((~~), FormatBuild(..), (%=))
+import Text.Format ((~~), FormatBuild(..), (~%))
 
 import qualified HsDev.Cache as Cache
 import qualified HsDev.Cache.Structured as SC
@@ -52,58 +51,46 @@ initLog :: ServerOpts -> IO SessionLog
 initLog sopts = do
 	msgs <- F.newChan
-	rulesVar <- newMVar [ruleStr]
-	let
-		getRules = do
-			rs <- readMVar rulesVar
-			return $ map (parseRule_ . fromString) rs
-	l <- newLog (return getRules) $ concat [
-		[logger text console | not $ serverSilent sopts],
-		[logger text (chaner msgs)],
-		maybeToList $ (logger text . file) <$> serverLog sopts]
-	Log.writeLog l Log.Info ("Log politics: low = {}, high = {}" ~~ logLow ~~ logHigh)
+	l <- newLog (logCfg [("", Log.level_ . T.pack . serverLogLevel $ sopts)]) $ concat [
+		[handler text console | not $ serverSilent sopts],
+		[handler text (chaner msgs)],
+		[handler text (file f) | f <- maybeToList (serverLog sopts)]]
 	let
 		listenLog = F.dupChan msgs >>= F.readChan
-	return $ SessionLog l rulesVar listenLog (stopLog l)
-	where
-		ruleStr :: String
-		ruleStr = "/: {}" ~~ serverLogConfig sopts
-		(Log.Politics logLow logHigh) = Log.rulePolitics (parseRule_ (fromString ruleStr)) Log.defaultPolitics
+	return $ SessionLog l listenLog (stopLog l)
 
 instance FormatBuild Log.Level where
 
 -- | Run server
 runServer :: ServerOpts -> ServerM IO () -> IO ()
-runServer sopts act = bracket (initLog sopts) sessionLogWait $ \slog -> Log.scopeLog (sessionLogger slog) (T.pack "hsdev") $ Watcher.withWatcher $ \watcher -> do
-	waitSem <- newQSem 0
-	db <- DB.newAsync
-	let
-		outputStr = Log.writeLog (sessionLogger slog)
+runServer sopts act = bracket (initLog sopts) sessionLogWait $ \slog -> Watcher.withWatcher $ \watcher -> withLog (sessionLogger slog) $ do
+	waitSem <- liftIO $ newQSem 0
+	db <- liftIO $ DB.newAsync
 	withCache sopts () $ \cdir -> do
-		outputStr Log.Trace $ "Checking cache version in {}" ~~ cdir 
-		ver <- Cache.readVersion $ cdir </> Cache.versionCache
-		outputStr Log.Debug $ "Cache version: {}" ~~ strVersion ver
+		sendLog Log.Trace $ "Checking cache version in {}" ~~ cdir 
+		ver <- liftIO $ Cache.readVersion $ cdir </> Cache.versionCache
+		sendLog Log.Debug $ "Cache version: {}" ~~ strVersion ver
 		unless (sameVersion (cutVersion version) (cutVersion ver)) $ ignoreIO $ do
-			outputStr Log.Info $ "Cache version ({cache}) is incompatible with hsdev version ({hsdev}), removing cache ({dir})" ~~
-				("cache" %= strVersion ver) ~~
-				("hsdev" %= strVersion version) ~~
-				("dir" %= cdir)
+			sendLog Log.Info $ "Cache version ({cache}) is incompatible with hsdev version ({hsdev}), removing cache ({dir})" ~~
+				("cache" ~% strVersion ver) ~~
+				("hsdev" ~% strVersion version) ~~
+				("dir" ~% cdir)
 			-- drop cache
-			removeDirectoryRecursive cdir
-		outputStr Log.Debug $ "Writing new cache version: {}" ~~ strVersion version
-		createDirectoryIfMissing True cdir
-		Cache.writeVersion $ cdir </> Cache.versionCache
+			liftIO $ removeDirectoryRecursive cdir
+		sendLog Log.Debug $ "Writing new cache version: {}" ~~ strVersion version
+		liftIO $ createDirectoryIfMissing True cdir
+		liftIO $ Cache.writeVersion $ cdir </> Cache.versionCache
 	when (serverLoad sopts) $ withCache sopts () $ \cdir -> do
-		outputStr Log.Info $ "Loading cache from {}" ~~ cdir
-		dbCache <- liftA merge <$> SC.load cdir
+		sendLog Log.Info $ "Loading cache from {}" ~~ cdir
+		dbCache <- liftA merge <$> liftIO (SC.load cdir)
 		case dbCache of
-			Left err -> outputStr Log.Error $ "Failed to load cache: {}" ~~ err
+			Left err -> sendLog Log.Error $ "Failed to load cache: {}" ~~ err
 			Right dbCache' -> DB.update db (return dbCache')
 #if mingw32_HOST_OS
-	mmapPool <- Just <$> createPool "hsdev"
+	mmapPool <- Just <$> liftIO (createPool "hsdev")
 #endif
-	ghcw <- withLog (sessionLogger slog) $ ghcWorker
-	defs <- getDefines
+	ghcw <- ghcWorker
+	defs <- liftIO getDefines
 	let
 		session = Session
 			db
@@ -116,13 +103,13 @@ #endif
 			ghcw
 			(do
-				outputStr Log.Trace "stopping server"
+				withLog (sessionLogger slog) $ sendLog Log.Trace "stopping server"
 				signalQSem waitSem)
 			(waitQSem waitSem)
 			defs
-	_ <- forkIO $ Update.onEvent watcher $ \w e -> withSession session $
+	_ <- liftIO $ forkIO $ Update.onEvent watcher $ \w e -> withSession session $
 		void $ Client.runClient def $ Update.processEvent def w e
-	runReaderT (runServerM act) session
+	liftIO $ runReaderT (runServerM act) session
 
 type Server = Worker (ServerM IO)
 
@@ -135,8 +122,7 @@ 	inWorker srv (Client.runClient copts $ Client.runCommand c')
 
 chaner :: F.Chan String -> Consumer Text
-chaner ch = Consumer withChan where
-	withChan f = f (F.putChan ch . T.unpack)
+chaner ch = return $ F.putChan ch . T.unpack
 
 -- | Perform action on cache
 withCache :: Monad m => ServerOpts -> a -> (FilePath -> m a) -> m a
@@ -146,17 +132,17 @@ 
 writeCache :: SessionMonad m => ServerOpts -> Database -> m ()
 writeCache sopts db = withCache sopts () $ \cdir -> do
-	Log.log Log.Info $ "writing cache to {}" ~~ cdir
-	logIO "cache writing exception: " (Log.log Log.Error . fromString) $ do
+	sendLog Log.Info $ "writing cache to {}" ~~ cdir
+	logIO "cache writing exception: " (sendLog Log.Error . fromString) $ do
 		let
 			sd = structurize db
 		liftIO $ SC.dump cdir sd
-		forM_ (M.keys (structuredPackageDbs sd)) $ \c -> Log.log Log.Debug ("cache write: cabal {}" ~~ show c)
-		forM_ (M.keys (structuredProjects sd)) $ \p -> Log.log Log.Debug ("cache write: project {}" ~~ p)
+		forM_ (M.keys (structuredPackageDbs sd)) $ \c -> sendLog Log.Debug ("cache write: cabal {}" ~~ show c)
+		forM_ (M.keys (structuredProjects sd)) $ \p -> sendLog Log.Debug ("cache write: project {}" ~~ p)
 		case allModules (structuredFiles sd) of
 			[] -> return ()
-			ms -> Log.log Log.Debug $ "cache write: {} files" ~~ length ms
-	Log.log Log.Info $ "cache saved to {}" ~~ cdir
+			ms -> sendLog Log.Debug $ "cache write: {} files" ~~ length ms
+	sendLog Log.Info $ "cache saved to {}" ~~ cdir
 
 readCache :: SessionMonad m => ServerOpts -> (FilePath -> ExceptT String IO Structured) -> m (Maybe Database)
 readCache sopts act = do
@@ -165,11 +151,11 @@ 		res <- liftIO $ runExceptT $ act fpath
 		either cacheErr cacheOk res
 	where
-		cacheErr e = Log.log Log.Error ("Error reading cache: {}" ~~ e) >> return Nothing
+		cacheErr e = sendLog Log.Error ("Error reading cache: {}" ~~ e) >> return Nothing
 		cacheOk s = do
-			forM_ (M.keys (structuredPackageDbs s)) $ \c -> Log.log Log.Debug ("cache read: cabal {}" ~~ show c)
-			forM_ (M.keys (structuredProjects s)) $ \p -> Log.log Log.Debug ("cache read: project {}" ~~ p)
+			forM_ (M.keys (structuredPackageDbs s)) $ \c -> sendLog Log.Debug ("cache read: cabal {}" ~~ show c)
+			forM_ (M.keys (structuredProjects s)) $ \p -> sendLog Log.Debug ("cache read: project {}" ~~ p)
 			case allModules (structuredFiles s) of
 				[] -> return ()
-				ms -> Log.log Log.Debug $ "cache read: {} files" ~~ length ms
+				ms -> sendLog Log.Debug $ "cache read: {} files" ~~ length ms
 			return $ Just $ merge s
src/HsDev/Server/Commands.hs view
@@ -38,7 +38,7 @@ import Control.Concurrent.Util
 import qualified Control.Concurrent.FiniteChan as F
 import Data.Lisp
-import Text.Format ((~~), (%=))
+import Text.Format ((~~), (~%))
 import System.Directory.Paths
 
 import qualified HsDev.Client.Commands as Client
@@ -120,9 +120,9 @@ 		-- start-process foo '"bar baz"' ⇒ foo "bar baz" -- ok
 		biescape = escape quote . escape quoteDouble
 		script = "try {{ start-process {process} {args} -WindowStyle Hidden -WorkingDirectory {dir} }} catch {{ $_.Exception, $_.InvocationInfo.Line }}"
-			~~ ("process" %= escape quote myExe)
-			~~ ("args" %= intercalate ", " (map biescape args))
-			~~ ("dir" %= escape quote curDir)
+			~~ ("process" ~% escape quote myExe)
+			~~ ("args" ~% intercalate ", " (map biescape args))
+			~~ ("dir" ~% escape quote curDir)
 	r <- runTool_ "powershell" [
 		"-Command",
 		script]
@@ -166,13 +166,13 @@ 				addr' <- inet_addr "127.0.0.1"
 				bind s (sockAddr (serverPort sopts) addr')
 				listen s maxListenQueue
-			forever $ logAsync (Log.log Log.Fatal . fromString) $ logIO "exception: " (Log.log Log.Error . fromString) $ do
-				Log.log Log.Trace "accepting connection..."
+			forever $ logAsync (Log.sendLog Log.Fatal . fromString) $ logIO "exception: " (Log.sendLog Log.Error . fromString) $ do
+				Log.sendLog Log.Trace "accepting connection..."
 				liftIO $ signalQSem q
 				(s', addr') <- liftIO $ accept s
-				Log.log Log.Trace $ "accepted {}" ~~ show addr'
+				Log.sendLog Log.Trace $ "accepted {}" ~~ show addr'
 				void $ liftIO $ forkIO $ withSession session $ Log.scope (T.pack $ show addr') $
-					logAsync (Log.log Log.Fatal . fromString) $ logIO "exception: " (Log.log Log.Error . fromString) $
+					logAsync (Log.sendLog Log.Fatal . fromString) $ logIO "exception: " (Log.sendLog Log.Error . fromString) $
 						flip finally (liftIO $ close s') $
 							bracket (liftIO newEmptyMVar) (liftIO . (`putMVar` ())) $ \done -> do
 								me <- liftIO myThreadId
@@ -180,7 +180,7 @@ 									timeoutWait = withSession session $ do
 										notDone <- liftIO $ isEmptyMVar done
 										when notDone $ do
-											Log.log Log.Trace $ "waiting for {} to complete" ~~ show addr'
+											Log.sendLog Log.Trace $ "waiting for {} to complete" ~~ show addr'
 											waitAsync <- liftIO $ async $ do
 												threadDelay 1000000
 												killThread me
@@ -188,17 +188,17 @@ 								liftIO $ F.putChan clientChan timeoutWait
 								processClientSocket (show addr') s'
 
-	Log.log Log.Trace "waiting for starting accept thread..."
+	Log.sendLog Log.Trace "waiting for starting accept thread..."
 	liftIO $ waitQSem q
-	Log.log Log.Info $ "Server started at port {}" ~~ serverPort sopts
-	Log.log Log.Trace "waiting for accept thread..."
+	Log.sendLog Log.Info $ "Server started at port {}" ~~ serverPort sopts
+	Log.sendLog Log.Trace "waiting for accept thread..."
 	serverWait
-	Log.log Log.Trace "accept thread stopped"
+	Log.sendLog Log.Trace "accept thread stopped"
 	liftIO $ unlink (serverPort sopts)
 	askSession sessionDatabase >>= liftIO . DB.readAsync >>= writeCache sopts
-	Log.log Log.Trace "waiting for clients..."
+	Log.sendLog Log.Trace "waiting for clients..."
 	liftIO (F.stopChan clientChan) >>= sequence_
-	Log.log Log.Info "server stopped"
+	Log.sendLog Log.Info "server stopped"
 runServerCommand (Stop copts) = runServerCommand (Remote copts False Exit)
 runServerCommand (Connect copts) = do
 	curDir <- getCurrentDirectory
@@ -222,8 +222,8 @@ 			Right m -> do
 				Response r' <- unMmap $ view (msg . message) m
 				putStrLn $ "{id}: {response}"
-					~~ ("id" %= fromMaybe "_" (view (msg . messageId) m))
-					~~ ("response" %= fromUtf8 (encodeMsg $ set msg (Response r') m))
+					~~ ("id" ~% fromMaybe "_" (view (msg . messageId) m))
+					~~ ("response" ~% fromUtf8 (encodeMsg $ set msg (Response r') m))
 				case unResponse (view (msg . message) m) of
 					Left _ -> waitResp h
 					_ -> return ()
@@ -290,7 +290,7 @@ -- | Process client, listen for requests and process them
 processClient :: SessionMonad m => String -> F.Chan ByteString -> (ByteString -> IO ()) -> m ()
 processClient name rchan send' = do
-	Log.log Log.Info "connected"
+	Log.sendLog Log.Info "connected"
 	respChan <- liftIO newChan
 	liftIO $ void $ forkIO $ getChanContents respChan >>= mapM_ (send' . encodeMessage)
 	linkVar <- liftIO $ newMVar $ return ()
@@ -300,7 +300,7 @@ 		answer :: SessionMonad m => Msg (Message Response) -> m ()
 		answer m = do
 			unless (isNotification $ view (msg . message) m) $
-				Log.log Log.Trace $ "responsed << {}" ~~ ellipsis (fromUtf8 (encode $ view (msg . message) m))
+				Log.sendLog Log.Trace $ "responsed << {}" ~~ ellipsis (fromUtf8 (encode $ view (msg . message) m))
 			liftIO $ writeChan respChan m
 			where
 				ellipsis :: String -> String
@@ -311,10 +311,10 @@ 	reqs <- liftIO $ F.readChan rchan
 	flip finally (disconnected linkVar) $
 		forM_ reqs $ \req' -> do
-			Log.log Log.Trace $ "received >> {}" ~~ fromUtf8 req'
+			Log.sendLog Log.Trace $ "received >> {}" ~~ fromUtf8 req'
 			case decodeMessage req' of
 				Left em -> do
-					Log.log Log.Warning $ "Invalid request {}" ~~ fromUtf8 req'
+					Log.sendLog Log.Warning $ "Invalid request {}" ~~ fromUtf8 req'
 					answer $ set msg (Message Nothing $ responseError $ RequestError "invalid request" $ fromUtf8 req') em
 				Right m -> void $ liftIO $ forkIO $ withSession s $ Log.scope (T.pack name) $ Log.scope "req" $
 					Log.scope (T.pack $ fromMaybe "_" (view (msg . messageId) m)) $ do
@@ -323,7 +323,7 @@ 								onNotify n
 									| silent = return ()
 									| otherwise = traverseOf (msg . message) (const $ mmap' noFile (Response $ Left n)) m >>= answer
-							Log.log Log.Trace $ "requested >> {}" ~~ fromUtf8 (encode c)
+							Log.sendLog Log.Trace $ "requested >> {}" ~~ fromUtf8 (encode c)
 							resp <- liftIO $ fmap (Response . Right) $ handleTimeout tm $ hsdevLiftIO $ withSession s $
 								processRequest
 									CommandOptions {
@@ -352,7 +352,7 @@ 		-- Call on disconnected, either no action or exit command
 		disconnected :: SessionMonad m => MVar (IO ()) -> m ()
 		disconnected var = do
-			Log.log Log.Info "disconnected"
+			Log.sendLog Log.Info "disconnected"
 			liftIO $ join $ takeMVar var
 
 -- | Process client by socket
src/HsDev/Server/Types.hs view
@@ -5,7 +5,7 @@ 	ServerMonadBase,
 	SessionLog(..), Session(..), SessionMonad(..), askSession, ServerM(..),
 	CommandOptions(..), CommandMonad(..), askOptions, ClientM(..),
-	withSession, serverListen, serverSetLogRules, serverWait, serverUpdateDB, serverWriteCache, serverReadCache, inSessionGhc, serverExit, commandRoot, commandNotify, commandLink, commandHold,
+	withSession, serverListen, serverSetLogLevel, serverWait, serverUpdateDB, serverWriteCache, serverReadCache, inSessionGhc, serverExit, commandRoot, commandNotify, commandLink, commandHold,
 	ServerCommand(..), ConnectionPort(..), ServerOpts(..), silentOpts, ClientOpts(..), serverOptsArgs, Request(..),
 
 	Command(..), AddedContents(..),
@@ -15,9 +15,8 @@ 	) where
 
 import Control.Applicative
-import Control.Concurrent.MVar (MVar, swapMVar)
 import Control.Concurrent.Worker
-import Control.Lens (each)
+import Control.Lens (each, view, set)
 import Control.Monad.Base
 import Control.Monad.Catch
 import Control.Monad.Except
@@ -27,10 +26,11 @@ import qualified Data.Aeson.Types as A
 import qualified Data.ByteString.Lazy.Char8 as L
 import Data.Default
+import Data.Maybe (fromMaybe)
 import Data.Monoid
 import Data.Foldable (asum)
 import Options.Applicative
-import System.Log.Simple hiding (Command)
+import System.Log.Simple
 
 import System.Directory.Paths
 import Text.Format (FormatBuild(..))
@@ -56,7 +56,6 @@ 
 data SessionLog = SessionLog {
 	sessionLogger :: Log,
-	sessionLogRules :: MVar [String],
 	sessionListenLog :: IO [String],
 	sessionLogWait :: IO () }
 
@@ -85,6 +84,8 @@ 
 instance (MonadIO m, MonadMask m) => MonadLog (ServerM m) where
 	askLog = ServerM $ asks (sessionLogger . sessionLog)
+	localLog fn = ServerM . local setLog' . runServerM where
+		setLog' sess = sess { sessionLog = (sessionLog sess) { sessionLogger = fn (sessionLogger (sessionLog sess)) } }
 
 instance ServerMonadBase m => SessionMonad (ServerM m) where
 	getSession = ask
@@ -120,6 +121,7 @@ 
 instance (MonadIO m, MonadMask m) => MonadLog (ClientM m) where
 	askLog = ClientM askLog
+	localLog fn = ClientM . localLog fn . runClientM
 
 instance ServerMonadBase m => SessionMonad (ClientM m) where
 	getSession = ClientM getSession
@@ -144,10 +146,11 @@ serverListen = join . liftM liftIO $ askSession (sessionListenLog . sessionLog)
 
 -- | Set server's log config
-serverSetLogRules :: SessionMonad m => [String] -> m [String]
-serverSetLogRules rs = do
-	rvar <- askSession (sessionLogRules . sessionLog)
-	liftIO $ swapMVar rvar rs
+serverSetLogLevel :: SessionMonad m => Level -> m Level
+serverSetLogLevel lev = do
+	l <- askSession (sessionLogger . sessionLog)
+	cfg <- updateLogConfig l (set (componentCfg "hsdev") (Just lev))
+	return $ fromMaybe def $ view (componentCfg "hsdev") cfg
 
 -- | Wait for server
 serverWait :: SessionMonad m => m ()
@@ -219,7 +222,7 @@ 	serverPort :: ConnectionPort,
 	serverTimeout :: Int,
 	serverLog :: Maybe FilePath,
-	serverLogConfig :: String,
+	serverLogLevel :: String,
 	serverCache :: Maybe FilePath,
 	serverLoad :: Bool,
 	serverSilent :: Bool }
@@ -259,7 +262,7 @@ 		(connectionArg <|> pure (serverPort def)) <*>
 		(timeoutArg <|> pure (serverTimeout def)) <*>
 		optional logArg <*>
-		(logConfigArg <|> pure (serverLogConfig def)) <*>
+		(logLevelArg <|> pure (serverLogLevel def)) <*>
 		optional cacheArg <*>
 		loadFlag <*>
 		serverSilentFlag
@@ -276,7 +279,7 @@ connectionArg :: Parser ConnectionPort
 timeoutArg :: Parser Int
 logArg :: Parser FilePath
-logConfigArg :: Parser String
+logLevelArg :: Parser String
 cacheArg :: Parser FilePath
 noFileFlag :: Parser Bool
 loadFlag :: Parser Bool
@@ -295,7 +298,7 @@ #endif
 timeoutArg = option auto (long "timeout" <> metavar "msec" <> help "query timeout")
 logArg = strOption (long "log" <> short 'l' <> metavar "file" <> help "log file")
-logConfigArg = strOption (long "log-config" <> metavar "rule" <> help "log config: low [low], high [high], set [low] [high], use [default/debug/trace/silent/supress]")
+logLevelArg = strOption (long "log-level" <> metavar "level" <> help "log level: trace/debug/info/warning/error/fatal")
 cacheArg = strOption (long "cache" <> metavar "path" <> help "cache directory")
 noFileFlag = switch (long "no-file" <> help "don't use mmap files")
 loadFlag = switch (long "load" <> help "force load all data from cache on startup")
@@ -309,7 +312,7 @@ 	portArgs (serverPort sopts),
 	["--timeout", show $ serverTimeout sopts],
 	marg "--log" (serverLog sopts),
-	["--log-config", serverLogConfig sopts],
+	["--log-level", serverLogLevel sopts],
 	marg "--cache" (serverCache sopts),
 	["--load" | serverLoad sopts],
 	["--silent" | serverSilent sopts]]
@@ -344,7 +347,7 @@ data Command =
 	Ping |
 	Listen (Maybe String) |
-	SetLogConfig [String] |
+	SetLogLevel String |
 	AddData { addedContents :: [AddedContents] } |
 	Scan {
 		scanProjects :: [FilePath],
@@ -483,8 +486,8 @@ instance FromCmd Command where
 	cmdP = subparser $ mconcat [
 		cmd "ping" "ping server" (pure Ping),
-		cmd "listen" "listen server log" (Listen <$> optional ruleArg),
-		cmd "set-log" "set log config rules" (SetLogConfig <$> many (strArgument idm)),
+		cmd "listen" "listen server log" (Listen <$> optional logLevelArg),
+		cmd "set-log" "set log level" (SetLogLevel <$> strArgument idm),
 		cmd "add" "add info to database" (AddData <$> option readJSON idm),
 		cmd "scan" "scan sources" $ Scan <$>
 			many projectArg <*>
@@ -585,7 +588,6 @@ pathArg :: Mod OptionFields String -> Parser FilePath
 projectArg :: Parser String
 pureFlag :: Parser Bool
-ruleArg :: Parser String
 sandboxArg :: Parser FilePath
 wideFlag :: Parser Bool
 
@@ -611,14 +613,13 @@ pathArg f = strOption (long "path" <> metavar "path" <> short 'p' <> f)
 projectArg = strOption (long "project" <> long "proj" <> metavar "project")
 pureFlag = switch (long "pure" <> help "don't modify actual file, just return result")
-ruleArg = strOption (long "config" <> metavar "rule" <> help "set new log rules while in listen command")
 sandboxArg = strOption (long "sandbox" <> metavar "path" <> help "path to cabal sandbox")
 wideFlag = switch (long "wide" <> short 'w' <> help "wide mode - complete as if there were no import lists")
 
 instance ToJSON Command where
 	toJSON Ping = cmdJson "ping" []
 	toJSON (Listen r) = cmdJson "listen" ["rule" .= r]
-	toJSON (SetLogConfig rs) = cmdJson "set-log" ["rules" .= rs]
+	toJSON (SetLogLevel lev) = cmdJson "set-log" ["level" .= lev]
 	toJSON (AddData cts) = cmdJson "add" ["data" .= cts]
 	toJSON (Scan projs cabal sboxes fs ps ghcs docs' infer') = cmdJson "scan" [
 		"projects" .= projs,
@@ -664,7 +665,7 @@ 	parseJSON = withObject "command" $ \v -> asum [
 		guardCmd "ping" v *> pure Ping,
 		guardCmd "listen" v *> (Listen <$> v .::? "rule"),
-		guardCmd "set-log" v *> (SetLogConfig <$> v .:: "rules"),
+		guardCmd "set-log" v *> (SetLogLevel <$> v .:: "level"),
 		guardCmd "add" v *> (AddData <$> v .:: "data"),
 		guardCmd "scan" v *> (Scan <$>
 			v .::?! "projects" <*>
src/HsDev/Stack.hs view
@@ -28,7 +28,6 @@ import System.Directory
 import System.Environment
 import System.FilePath
-import System.Process
 import System.Log.Simple (MonadLog(..))
 
 import qualified Packages as GHC
src/HsDev/Tools/Ghc/MGhc.hs view
@@ -11,6 +11,7 @@ 	) where
 
 import Control.Lens
+import Control.Monad.Morph
 import Control.Monad.Catch
 import Control.Monad.Reader
 import Control.Monad.State
@@ -20,7 +21,7 @@ import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe, isJust)
-import System.Log.Simple
+import System.Log.Simple.Monad (MonadLog(..))
 
 import DynFlags
 import Exception hiding (catch, mask, uninterruptibleMask, bracket)
@@ -28,7 +29,6 @@ import GhcMonad
 import HscTypes
 import Outputable
-import Packages
 import SysTools
 
 data SessionState s = SessionState {
@@ -67,6 +67,9 @@ instance MonadTrans GhcT where
 	lift = liftGhcT
 
+instance MFunctor GhcT where
+	hoist fn = GhcT . (fn .) . unGhcT
+
 instance MonadState st m => MonadState st (GhcT m) where
 	get = lift get
 	put = lift . put
@@ -87,9 +90,6 @@ 		q g' act = GhcT $ g' . unGhcT act
 	uninterruptibleMask f = GhcT $ \s -> uninterruptibleMask $ \g -> unGhcT (f $ q g) s where
 		q g' act = GhcT $ g' . unGhcT act
-
-instance MonadLog m => MonadLog (GhcT m) where
-	askLog = lift askLog
 
 -- | Run multi-session ghc
 runMGhcT :: (MonadIO m, ExceptionMonad m, Ord s) => Maybe FilePath -> MGhcT s m a -> m a
src/HsDev/Tools/Ghc/Worker.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE PatternGuards, OverloadedStrings #-}
+{-# LANGUAGE PatternGuards, OverloadedStrings, FlexibleContexts #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module HsDev.Tools.Ghc.Worker (
@@ -95,26 +95,26 @@ 
 runGhcM :: MonadLog m => Maybe FilePath -> GhcM a -> m a
 runGhcM dir act = do
-	l <- askLog
+	l <- Log.askLog
 	liftIO $ withLog l $ runMGhcT dir act
 
 -- | Multi-session ghc worker
 ghcWorker :: MonadLog m => m GhcWorker
 ghcWorker = do
-	l <- askLog
+	l <- Log.askLog
 	liftIO $ startWorker (withLog l . runGhcM (Just libdir)) id (Log.scope "ghc")
 
 -- | Create session with options
 workerSession :: SessionTarget -> GhcM ()
 workerSession SessionGhci = do
-	Log.log Log.Trace $ "session: {}" ~~ SessionGhci
+	Log.sendLog Log.Trace $ "session: {}" ~~ SessionGhci
 	switchSession_ SessionGhci $ Just $ ghcRun [] (importModules preludeModules)
 workerSession s@(SessionGhc opts) = do
 	ms <- findSessionBy isGhcSession
 	forM_ ms $ \s'@(SessionGhc opts') -> when (opts /= opts') $ do
-		Log.log Log.Trace $ "killing session: {}" ~~ s'
+		Log.sendLog Log.Trace $ "killing session: {}" ~~ s'
 		deleteSession s'
-	Log.log Log.Trace $ "session: {}" ~~ s
+	Log.sendLog Log.Trace $ "session: {}" ~~ s
 	switchSession_ s $ Just $ ghcRun opts (return ())
 	where
 		isGhcSession (SessionGhc _) = True
@@ -153,7 +153,7 @@ -- | Add options without reinit session
 addCmdOpts :: (MonadLog m, GhcMonad m) => [String] -> m ()
 addCmdOpts opts = do
-	Log.log Log.Trace $ "setting ghc options: {}" ~~ unwords opts
+	Log.sendLog Log.Trace $ "setting ghc options: {}" ~~ unwords opts
 	fs <- getSessionDynFlags
 	(fs', _, _) <- parseDynamicFlags fs (map noLoc opts)
 	let fs'' = fs' {
@@ -167,7 +167,7 @@ -- | Set options after session reinit
 setCmdOpts :: (MonadLog m, GhcMonad m) => [String] -> m ()
 setCmdOpts opts = do
-	Log.log Log.Trace $ "restarting ghc session with: {}" ~~ unwords opts
+	Log.sendLog Log.Trace $ "restarting ghc session with: {}" ~~ unwords opts
 	initGhcMonad (Just libdir)
 	addCmdOpts opts
 	modifyFlags $ setLogAction logToNull
src/HsDev/Tools/HDocs.hs view
@@ -8,7 +8,6 @@ 	module Control.Monad.Except
 	) where
 
-import Control.Exception
 import Control.DeepSeq
 import Control.Lens (set, view, over)
 import Control.Monad ()
src/HsDev/Util.hs view
@@ -278,8 +278,10 @@ 	onAsync :: (MonadIO m, C.MonadThrow m) => (String -> m ()) -> AsyncException -> m ()
 	onAsync out' e = out' (displayException e) >> C.throwM e
 
-ignoreIO :: IO () -> IO ()
-ignoreIO = handle (const (return ()) :: IOException -> IO ())
+ignoreIO :: C.MonadCatch m => m () -> m ()
+ignoreIO = C.handle ignore' where
+	ignore' :: Monad m => IOException -> m ()
+	ignore' _ = return ()
 
 liftAsync :: (C.MonadThrow m, C.MonadCatch m, MonadIO m) => IO (Async a) -> ExceptT String m a
 liftAsync = liftExceptionM . ExceptT . liftIO . liftM (left displayException) . join . liftM waitCatch
src/HsDev/Watcher.hs view
@@ -15,6 +15,7 @@ import HsDev.Project
 import HsDev.Symbols
 import HsDev.Watcher.Types
+import HsDev.Util
 
 -- | Watch for project sources changes
 watchProject :: Watcher -> Project -> [String] -> IO ()
@@ -63,10 +64,10 @@ unwatchPackageDb w (PackageDb pdb) = void $ unwatchTree w pdb
 
 isSource :: Event -> Bool
-isSource (Event _ f _) = takeExtension f == ".hs"
+isSource = haskellSource . view eventPath
 
 isCabal :: Event -> Bool
-isCabal (Event _ f _) = takeExtension f == ".cabal"
+isCabal = cabalFile . view eventPath
 
 isConf :: Event -> Bool
 isConf (Event _ f _) = takeExtension f == ".conf"
tests/test-package/test-package.cabal view
@@ -17,7 +17,7 @@     ModuleTwo
   -- other-modules:       
   -- other-extensions:    
-  build-depends:       base
+  build-depends:       base >=4.8
   hs-source-dirs:      .
   default-language:    Haskell2010
   ghc-options: -Wall -fno-warn-tabs