Move reading source from stdin to frontend
This commit is contained in:
parent
86545a895b
commit
d3b1bf125b
@ -21,22 +21,10 @@ import GHC
|
||||
loadMappedFiles :: IOish m => GhcModT m ()
|
||||
loadMappedFiles = do
|
||||
Options {fileMappings} <- options
|
||||
mapM_ (uncurry loadMappedFile) $ reverse fileMappings
|
||||
mapM_ (uncurry loadMappedFile) fileMappings
|
||||
|
||||
loadMappedFile :: IOish m => FilePath -> FileMapping -> GhcModT m ()
|
||||
loadMappedFile from fm@(RedirectedMapping _) =
|
||||
addToState from fm
|
||||
loadMappedFile from (MemoryMapping _) = do
|
||||
let loop' acc = do
|
||||
line <- getLine
|
||||
if not (null line) && last line == '\EOT'
|
||||
then return $ acc ++ init line
|
||||
else loop' (acc++line++"\n")
|
||||
src <- liftIO $ loop' ""
|
||||
addToState from (MemoryMapping $ Just src)
|
||||
|
||||
addToState :: IOish m => FilePath -> FileMapping -> GhcModT m ()
|
||||
addToState from fm = do
|
||||
loadMappedFile from fm = do
|
||||
crdl <- cradle
|
||||
let ccfn = cradleCurrentDir crdl </> from
|
||||
cfn <- liftIO $ canonicalizePath ccfn
|
||||
|
@ -438,11 +438,12 @@ legacyInteractiveLoop symdbreq world = do
|
||||
"boot" -> bootCmd []
|
||||
"browse" -> browseCmd args
|
||||
|
||||
"map-file" -> loadMappedFile arg (MemoryMapping Nothing)
|
||||
>> return ""
|
||||
"map-file" -> liftIO getFileSourceFromStdin
|
||||
>>= loadMappedFile arg . MemoryMapping . Just
|
||||
>> return ""
|
||||
|
||||
"unmap-file" -> unloadMappedFile arg
|
||||
>> return ""
|
||||
"unmap-file" -> unloadMappedFile arg
|
||||
>> return ""
|
||||
|
||||
"quit" -> liftIO $ exitSuccess
|
||||
"" -> liftIO $ exitSuccess
|
||||
@ -456,6 +457,15 @@ legacyInteractiveLoop symdbreq world = do
|
||||
, GHandler $ \(SomeException e) -> gmErrStrLn (show e) >> return ""
|
||||
]
|
||||
|
||||
getFileSourceFromStdin :: IO String
|
||||
getFileSourceFromStdin = do
|
||||
let loop' acc = do
|
||||
line <- getLine
|
||||
if not (null line) && last line == '\EOT'
|
||||
then return $ acc ++ init line
|
||||
else loop' (acc++line++"\n")
|
||||
loop' ""
|
||||
|
||||
ghcCommands :: IOish m => [String] -> GhcModT m ()
|
||||
ghcCommands [] = fatalError "No command given (try --help)"
|
||||
ghcCommands (cmd:args) = do
|
||||
|
Loading…
Reference in New Issue
Block a user