Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Add a few more session-inspection functions.

  • Loading branch information...
commit c5c7883f3743d0515f599c5d2b94c3acf63aa81a 1 parent d3d352f
Thomas Schilling authored
21 src/Scion/Session.hs
View
@@ -29,7 +29,7 @@ import Scion.Cabal ( CabalException )
import Control.Applicative
import Control.Concurrent
import Control.Exception ( throwIO )
-import Control.Monad ( when, unless, forever )
+import Control.Monad ( when, unless, forever, filterM )
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import Data.Char ( ord )
@@ -39,7 +39,7 @@ import Data.Time.Clock.POSIX ( posixSecondsToUTCTime )
import System.Directory ( doesFileExist, getTemporaryDirectory,
removeDirectoryRecursive )
import System.Exit ( ExitCode(..) )
-import System.FilePath ( dropFileName, (</>), takeFileName )
+import System.FilePath ( dropFileName, (</>), takeFileName, makeRelative )
import System.IO
import System.IO.Temp ( createTempDirectory )
import System.PosixCompat.Files ( getFileStatus, modificationTime )
@@ -47,6 +47,7 @@ import System.Process ( getProcessExitCode, terminateProcess )
-- -------------------------------------------------------------------
+-- | Throw a 'ScionException' if the file does not exist.
ensureFileExists :: FilePath -> ScionM ()
ensureFileExists file = do
ok <- io $ doesFileExist file
@@ -80,6 +81,7 @@ createSession sc0@FileConfig{ sc_fileName = file } = do
, sessionOutputDir = outdir
, sessionModuleGraph = graph
, sessionLastCompilation = rslt
+ , sessionHomeDir = working_dir
}
registerSession sid sess0
@@ -115,6 +117,7 @@ createSession sc0@CabalConfig{ sc_cabalFile = file } = do
, sessionOutputDir = build_dir
, sessionModuleGraph = graph
, sessionLastCompilation = rslt
+ , sessionHomeDir = working_dir
}
registerSession sid sess0
@@ -137,6 +140,7 @@ createSession sc@EmptyConfig{} = do
, sessionOutputDir = outdir
, sessionModuleGraph = graph
, sessionLastCompilation = rslt
+ , sessionHomeDir = working_dir
}
registerSession sid sess0
@@ -162,6 +166,9 @@ sessionNotes :: SessionId -> ScionM Notes
sessionNotes sid = do
compilationNotes . sessionLastCompilation <$> getSessionState sid
+sessionModules :: SessionId -> ScionM [ModuleSummary]
+sessionModules sid = sessionModuleGraph <$> getSessionState sid
+
supportedLanguagesAndExtensions :: ScionM [Extension]
supportedLanguagesAndExtensions = do
exts <- getExtensions
@@ -365,3 +372,13 @@ ignoreMostErrors act = do
HandlerM $ \(ex :: RecConError) -> return (Left (show ex))
]
+fileSessions :: FilePath -> ScionM [SessionId]
+fileSessions path = do
+ filterM (fileInSession path) =<< activeSessions
+
+fileInSession :: FilePath -> SessionId -> ScionM Bool
+fileInSession path0 sid = do
+ home <- sessionHomeDir <$> getSessionState sid
+ let path = makeRelative home path0
+ mods <- sessionModules sid
+ return $ not $ null [ m | m <- mods, ms_location m == path ]
4 src/Scion/Types/Monad.hs
View
@@ -102,6 +102,10 @@ doesSessionExist sid = ScionM $ \r -> do
Just _ -> return True
Nothing -> return False
+activeSessions :: ScionM [SessionId]
+activeSessions = ScionM $ \r -> do
+ M.keys . gsSessions <$> readIORef r
+
-- | Unregister a 'SessionId'. NOTE: Does not stop the worker.
unregisterSession :: SessionId -> ScionM ()
unregisterSession sid = ScionM $ \r ->
5 src/Scion/Types/Session.hs
View
@@ -124,6 +124,8 @@ data SessionState = SessionState
-- caches to speed things up.
, sessionModuleGraph :: [ModuleSummary]
, sessionLastCompilation :: CompilationResult
+ , sessionHomeDir :: FilePath
+ -- ^ All file paths are relative to this directory.
} deriving (Show)
instance Binary SessionConfig where
@@ -217,7 +219,8 @@ data ModuleSummary = ModuleSummary
instance Show ModuleSummary where
show ms =
- "<summary:" ++ show (ms_module ms) ++ ">"
+ "<summary:" ++ show (ms_module ms) ++ "," ++
+ ms_location ms ++ ">"
instance Binary ModuleSummary where
put (ModuleSummary mdl ft imps loc) =
Please sign in to comment.
Something went wrong with that request. Please try again.