Move reading source from stdin to frontend

This commit is contained in:
Nikolay Yakimov 2015-07-02 14:01:03 +03:00
parent 86545a895b
commit d3b1bf125b
2 changed files with 16 additions and 18 deletions

View File

@ -21,22 +21,10 @@ import GHC
loadMappedFiles :: IOish m => GhcModT m () loadMappedFiles :: IOish m => GhcModT m ()
loadMappedFiles = do loadMappedFiles = do
Options {fileMappings} <- options Options {fileMappings} <- options
mapM_ (uncurry loadMappedFile) $ reverse fileMappings mapM_ (uncurry loadMappedFile) fileMappings
loadMappedFile :: IOish m => FilePath -> FileMapping -> GhcModT m () loadMappedFile :: IOish m => FilePath -> FileMapping -> GhcModT m ()
loadMappedFile from fm@(RedirectedMapping _) = loadMappedFile from fm = do
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
crdl <- cradle crdl <- cradle
let ccfn = cradleCurrentDir crdl </> from let ccfn = cradleCurrentDir crdl </> from
cfn <- liftIO $ canonicalizePath ccfn cfn <- liftIO $ canonicalizePath ccfn

View File

@ -438,7 +438,8 @@ legacyInteractiveLoop symdbreq world = do
"boot" -> bootCmd [] "boot" -> bootCmd []
"browse" -> browseCmd args "browse" -> browseCmd args
"map-file" -> loadMappedFile arg (MemoryMapping Nothing) "map-file" -> liftIO getFileSourceFromStdin
>>= loadMappedFile arg . MemoryMapping . Just
>> return "" >> return ""
"unmap-file" -> unloadMappedFile arg "unmap-file" -> unloadMappedFile arg
@ -456,6 +457,15 @@ legacyInteractiveLoop symdbreq world = do
, GHandler $ \(SomeException e) -> gmErrStrLn (show e) >> return "" , 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 :: IOish m => [String] -> GhcModT m ()
ghcCommands [] = fatalError "No command given (try --help)" ghcCommands [] = fatalError "No command given (try --help)"
ghcCommands (cmd:args) = do ghcCommands (cmd:args) = do