{-# LANGUAGE CPP #-}
module GHC.SysTools.Process where
import GHC.Prelude
import GHC.Utils.Exception
import GHC.Utils.Error
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Misc
import GHC.Utils.Logger
import GHC.Utils.TmpFs
import GHC.Utils.CliOption
import GHC.Types.SrcLoc ( SrcLoc, mkSrcLoc, mkSrcSpan )
import GHC.Data.FastString
import Control.Concurrent
import Data.Char
import System.Exit
import System.Environment
import System.FilePath
import System.IO
import System.IO.Error as IO
import System.Process
enableProcessJobs :: CreateProcess -> CreateProcess
enableProcessJobs :: CreateProcess -> CreateProcess
enableProcessJobs CreateProcess
opts = CreateProcess
opts { use_process_jobs = True }
readCreateProcessWithExitCode'
:: CreateProcess
-> IO (ExitCode, String)
readCreateProcessWithExitCode' :: CreateProcess -> IO (ExitCode, String)
readCreateProcessWithExitCode' CreateProcess
proc = do
(_, Just outh, _, pid) <-
CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a b. (a -> b) -> a -> b
$ CreateProcess -> CreateProcess
enableProcessJobs (CreateProcess -> CreateProcess) -> CreateProcess -> CreateProcess
forall a b. (a -> b) -> a -> b
$ CreateProcess
proc{ std_out = CreatePipe }
outMVar <- newEmptyMVar
let onError :: SomeException -> IO ()
onError SomeException
exc = MVar (Either SomeException String)
-> Either SomeException String -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either SomeException String)
outMVar (SomeException -> Either SomeException String
forall a b. a -> Either a b
Left SomeException
exc)
_ <- forkIO $ handle onError $ do
output <- hGetContents' outh
putMVar outMVar $ Right output
result <- takeMVar outMVar
hClose outh
output <- case result of
Left SomeException
exc -> SomeException -> IO String
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO SomeException
exc
Right String
output -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
output
ex <- waitForProcess pid
return (ex, output)
replaceVar :: (String, String) -> [(String, String)] -> [(String, String)]
replaceVar :: (String, String) -> [(String, String)] -> [(String, String)]
replaceVar (String
var, String
value) [(String, String)]
env =
(String
var, String
value) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: ((String, String) -> Bool)
-> [(String, String)] -> [(String, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(String
var',String
_) -> String
var String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
var') [(String, String)]
env
readProcessEnvWithExitCode
:: String
-> [String]
-> (String, String)
-> IO (ExitCode, String, String)
readProcessEnvWithExitCode :: String
-> [String] -> (String, String) -> IO (ExitCode, String, String)
readProcessEnvWithExitCode String
prog [String]
args (String, String)
env_update = do
current_env <- IO [(String, String)]
getEnvironment
readCreateProcessWithExitCode (proc prog args) {
env = Just (replaceVar env_update current_env) } ""
c_locale_env :: (String, String)
c_locale_env :: (String, String)
c_locale_env = (String
"LANGUAGE", String
"C")
getGccEnv :: [Option] -> IO (Maybe [(String,String)])
getGccEnv :: [Option] -> IO (Maybe [(String, String)])
getGccEnv [Option]
opts =
if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
b_dirs
then Maybe [(String, String)] -> IO (Maybe [(String, String)])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [(String, String)]
forall a. Maybe a
Nothing
else do env <- IO [(String, String)]
getEnvironment
return (Just (mangle_paths env))
where
([String]
b_dirs, [Option]
_) = (Option -> Either String Option)
-> [Option] -> ([String], [Option])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith Option -> Either String Option
get_b_opt [Option]
opts
get_b_opt :: Option -> Either String Option
get_b_opt (Option (Char
'-':Char
'B':String
dir)) = String -> Either String Option
forall a b. a -> Either a b
Left String
dir
get_b_opt Option
other = Option -> Either String Option
forall a b. b -> Either a b
Right Option
other
#if defined(mingw32_HOST_OS)
mangle_paths = map mangle_path
mangle_path (path,paths) | map toUpper path == "PATH"
= (path, '\"' : head b_dirs ++ "\";" ++ paths)
mangle_path other = other
#else
mangle_paths :: a -> a
mangle_paths = a -> a
forall {a}. a -> a
id
#endif
runSomething :: Logger
-> String
-> String
-> [Option]
-> IO ()
runSomething :: Logger -> String -> String -> [Option] -> IO ()
runSomething Logger
logger String
phase_name String
pgm [Option]
args =
Logger
-> (String -> String)
-> String
-> String
-> [Option]
-> Maybe String
-> Maybe [(String, String)]
-> IO ()
runSomethingFiltered Logger
logger String -> String
forall {a}. a -> a
id String
phase_name String
pgm [Option]
args Maybe String
forall a. Maybe a
Nothing Maybe [(String, String)]
forall a. Maybe a
Nothing
runSomethingResponseFile
:: Logger
-> TmpFs
-> TempDir
-> (String->String)
-> String
-> String
-> [Option]
-> Maybe [(String,String)]
-> IO ()
runSomethingResponseFile :: Logger
-> TmpFs
-> TempDir
-> (String -> String)
-> String
-> String
-> [Option]
-> Maybe [(String, String)]
-> IO ()
runSomethingResponseFile Logger
logger TmpFs
tmpfs TempDir
tmp_dir String -> String
filter_fn String
phase_name String
pgm [Option]
args Maybe [(String, String)]
mb_env =
Logger
-> String
-> String
-> [Option]
-> ([String] -> IO (ExitCode, ()))
-> IO ()
forall a.
Logger
-> String
-> String
-> [Option]
-> ([String] -> IO (ExitCode, a))
-> IO a
runSomethingWith Logger
logger String
phase_name String
pgm [Option]
args (([String] -> IO (ExitCode, ())) -> IO ())
-> ([String] -> IO (ExitCode, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[String]
real_args -> do
fp <- [String] -> IO String
getResponseFile [String]
real_args
let args = [Char
'@'Char -> String -> String
forall a. a -> [a] -> [a]
:String
fp]
r <- builderMainLoop logger filter_fn pgm args Nothing mb_env
return (r,())
where
getResponseFile :: [String] -> IO String
getResponseFile [String]
args = do
fp <- Logger
-> TmpFs -> TempDir -> TempFileLifetime -> String -> IO String
newTempName Logger
logger TmpFs
tmpfs TempDir
tmp_dir TempFileLifetime
TFL_CurrentModule String
"rsp"
withFile fp WriteMode $ \Handle
h -> do
Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8
Handle -> String -> IO ()
hPutStr Handle
h (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall {t :: * -> *}. Foldable t => t Char -> String
escape [String]
args
return fp
escape :: t Char -> String
escape t Char
x = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"\""
, (Char -> String) -> t Char -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(\Char
c ->
case Char
c of
Char
'\\' -> String
"\\\\"
Char
'\n' -> String
"\\n"
Char
'\"' -> String
"\\\""
Char
_ -> [Char
c])
t Char
x
, String
"\""
]
runSomethingFiltered
:: Logger -> (String->String) -> String -> String -> [Option]
-> Maybe FilePath -> Maybe [(String,String)] -> IO ()
runSomethingFiltered :: Logger
-> (String -> String)
-> String
-> String
-> [Option]
-> Maybe String
-> Maybe [(String, String)]
-> IO ()
runSomethingFiltered Logger
logger String -> String
filter_fn String
phase_name String
pgm [Option]
args Maybe String
mb_cwd Maybe [(String, String)]
mb_env =
Logger
-> String
-> String
-> [Option]
-> ([String] -> IO (ExitCode, ()))
-> IO ()
forall a.
Logger
-> String
-> String
-> [Option]
-> ([String] -> IO (ExitCode, a))
-> IO a
runSomethingWith Logger
logger String
phase_name String
pgm [Option]
args (([String] -> IO (ExitCode, ())) -> IO ())
-> ([String] -> IO (ExitCode, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[String]
real_args -> do
r <- Logger
-> (String -> String)
-> String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> IO ExitCode
builderMainLoop Logger
logger String -> String
filter_fn String
pgm [String]
real_args Maybe String
mb_cwd Maybe [(String, String)]
mb_env
return (r,())
runSomethingWith
:: Logger -> String -> String -> [Option]
-> ([String] -> IO (ExitCode, a))
-> IO a
runSomethingWith :: forall a.
Logger
-> String
-> String
-> [Option]
-> ([String] -> IO (ExitCode, a))
-> IO a
runSomethingWith Logger
logger String
phase_name String
pgm [Option]
args [String] -> IO (ExitCode, a)
io = do
let real_args :: [String]
real_args = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
forall (f :: * -> *) a. Foldable f => f a -> Bool
notNull ((Option -> String) -> [Option] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Option -> String
showOpt [Option]
args)
cmdLine :: String
cmdLine = String -> [String] -> String
showCommandForUser String
pgm [String]
real_args
Logger -> String -> String -> IO a -> IO a
forall a. Logger -> String -> String -> IO a -> IO a
traceCmd Logger
logger String
phase_name String
cmdLine (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ String -> String -> IO (ExitCode, a) -> IO a
forall r. String -> String -> IO (ExitCode, r) -> IO r
handleProc String
pgm String
phase_name (IO (ExitCode, a) -> IO a) -> IO (ExitCode, a) -> IO a
forall a b. (a -> b) -> a -> b
$ [String] -> IO (ExitCode, a)
io [String]
real_args
handleProc :: String -> String -> IO (ExitCode, r) -> IO r
handleProc :: forall r. String -> String -> IO (ExitCode, r) -> IO r
handleProc String
pgm String
phase_name IO (ExitCode, r)
proc = do
(rc, r) <- IO (ExitCode, r)
proc IO (ExitCode, r)
-> (IOError -> IO (ExitCode, r)) -> IO (ExitCode, r)
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIO` IOError -> IO (ExitCode, r)
handler
case rc of
ExitSuccess{} -> r -> IO r
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return r
r
ExitFailure Int
n -> GhcException -> IO r
forall a. GhcException -> IO a
throwGhcExceptionIO (
String -> GhcException
ProgramError (String
"`" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
takeFileName String
pgm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" failed in phase `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
phase_name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'." String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" (Exit code: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"))
where
handler :: IOError -> IO (ExitCode, r)
handler IOError
err =
if IOError -> Bool
IO.isDoesNotExistError IOError
err
then IO (ExitCode, r)
does_not_exist
else GhcException -> IO (ExitCode, r)
forall a. GhcException -> IO a
throwGhcExceptionIO (String -> GhcException
ProgramError (String -> GhcException) -> String -> GhcException
forall a b. (a -> b) -> a -> b
$ IOError -> String
forall a. Show a => a -> String
show IOError
err)
does_not_exist :: IO (ExitCode, r)
does_not_exist = GhcException -> IO (ExitCode, r)
forall a. GhcException -> IO a
throwGhcExceptionIO (String -> GhcException
InstallationError (String
"could not execute: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pgm))
builderMainLoop :: Logger -> (String -> String) -> FilePath
-> [String] -> Maybe FilePath -> Maybe [(String, String)]
-> IO ExitCode
builderMainLoop :: Logger
-> (String -> String)
-> String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> IO ExitCode
builderMainLoop Logger
logger String -> String
filter_fn String
pgm [String]
real_args Maybe String
mb_cwd Maybe [(String, String)]
mb_env = do
chan <- IO (Chan BuildMessage)
forall a. IO (Chan a)
newChan
let safely ProcessHandle -> IO ExitCode
inner = ((forall a. IO a -> IO a) -> IO ExitCode) -> IO ExitCode
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO ExitCode) -> IO ExitCode)
-> ((forall a. IO a -> IO a) -> IO ExitCode) -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
let procdata :: CreateProcess
procdata =
CreateProcess -> CreateProcess
enableProcessJobs
(CreateProcess -> CreateProcess) -> CreateProcess -> CreateProcess
forall a b. (a -> b) -> a -> b
$ (String -> [String] -> CreateProcess
proc String
pgm [String]
real_args) { cwd = mb_cwd
, env = mb_env
, std_in = CreatePipe
, std_out = CreatePipe
, std_err = CreatePipe
}
(Just hStdIn, Just hStdOut, Just hStdErr, hProcess) <- IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a. IO a -> IO a
restore (IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a b. (a -> b) -> a -> b
$
String
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess_ String
"builderMainLoop" CreateProcess
procdata
let cleanup_handles = do
Handle -> IO ()
hClose Handle
hStdIn
Handle -> IO ()
hClose Handle
hStdOut
Handle -> IO ()
hClose Handle
hStdErr
r <- try $ restore $ do
hSetBuffering hStdOut LineBuffering
hSetBuffering hStdErr LineBuffering
let make_reader_proc Handle
h = IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Chan BuildMessage -> Handle -> (String -> String) -> IO ()
readerProc Chan BuildMessage
chan Handle
h String -> String
filter_fn
bracketOnError (make_reader_proc hStdOut) killThread $ \ThreadId
_ ->
IO ThreadId
-> (ThreadId -> IO ()) -> (ThreadId -> IO ExitCode) -> IO ExitCode
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError (Handle -> IO ThreadId
make_reader_proc Handle
hStdErr) ThreadId -> IO ()
killThread ((ThreadId -> IO ExitCode) -> IO ExitCode)
-> (ThreadId -> IO ExitCode) -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ \ThreadId
_ ->
ProcessHandle -> IO ExitCode
inner ProcessHandle
hProcess
case r of
Left (SomeException e
e) -> do
ProcessHandle -> IO ()
terminateProcess ProcessHandle
hProcess
IO ()
cleanup_handles
e -> IO ExitCode
forall a e. (HasCallStack, Exception e) => e -> a
throw e
e
Right ExitCode
s -> do
IO ()
cleanup_handles
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
s
safely $ \ProcessHandle
h -> do
Chan BuildMessage -> Integer -> IO ()
log_loop Chan BuildMessage
chan (Integer
2 :: Integer)
ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
h
where
log_loop :: Chan BuildMessage -> Integer -> IO ()
log_loop Chan BuildMessage
_ Integer
0 = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
log_loop Chan BuildMessage
chan Integer
t = do
msg <- Chan BuildMessage -> IO BuildMessage
forall a. Chan a -> IO a
readChan Chan BuildMessage
chan
case msg of
BuildMsg SDoc
msg -> do
Logger -> SDoc -> IO ()
logInfo Logger
logger (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ PprStyle -> SDoc -> SDoc
withPprStyle PprStyle
defaultUserStyle SDoc
msg
Chan BuildMessage -> Integer -> IO ()
log_loop Chan BuildMessage
chan Integer
t
BuildError SrcLoc
loc SDoc
msg -> do
Logger -> MessageClass -> SrcSpan -> SDoc -> IO ()
logMsg Logger
logger MessageClass
errorDiagnostic (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan SrcLoc
loc SrcLoc
loc)
(SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ PprStyle -> SDoc -> SDoc
withPprStyle PprStyle
defaultUserStyle SDoc
msg
Chan BuildMessage -> Integer -> IO ()
log_loop Chan BuildMessage
chan Integer
t
BuildMessage
EOF ->
Chan BuildMessage -> Integer -> IO ()
log_loop Chan BuildMessage
chan (Integer
tInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1)
readerProc :: Chan BuildMessage -> Handle -> (String -> String) -> IO ()
readerProc :: Chan BuildMessage -> Handle -> (String -> String) -> IO ()
readerProc Chan BuildMessage
chan Handle
hdl String -> String
filter_fn =
(do str <- Handle -> IO String
hGetContents Handle
hdl
loop (linesPlatform (filter_fn str)) Nothing)
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally`
Chan BuildMessage -> BuildMessage -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan BuildMessage
chan BuildMessage
EOF
where
loop :: [String] -> Maybe BuildMessage -> IO ()
loop [] Maybe BuildMessage
Nothing = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
loop [] (Just BuildMessage
err) = Chan BuildMessage -> BuildMessage -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan BuildMessage
chan BuildMessage
err
loop (String
l:[String]
ls) Maybe BuildMessage
in_err =
case Maybe BuildMessage
in_err of
Just err :: BuildMessage
err@(BuildError SrcLoc
srcLoc SDoc
msg)
| String -> Bool
leading_whitespace String
l ->
[String] -> Maybe BuildMessage -> IO ()
loop [String]
ls (BuildMessage -> Maybe BuildMessage
forall a. a -> Maybe a
Just (SrcLoc -> SDoc -> BuildMessage
BuildError SrcLoc
srcLoc (SDoc
msg SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
l)))
| Bool
otherwise -> do
Chan BuildMessage -> BuildMessage -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan BuildMessage
chan BuildMessage
err
String -> [String] -> IO ()
checkError String
l [String]
ls
Maybe BuildMessage
Nothing ->
String -> [String] -> IO ()
checkError String
l [String]
ls
Maybe BuildMessage
_ -> String -> IO ()
forall a. HasCallStack => String -> a
panic String
"readerProc/loop"
checkError :: String -> [String] -> IO ()
checkError String
l [String]
ls
= case String -> Maybe (String, Int, Int, String)
parseError String
l of
Maybe (String, Int, Int, String)
Nothing -> do
Chan BuildMessage -> BuildMessage -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan BuildMessage
chan (SDoc -> BuildMessage
BuildMsg (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
l))
[String] -> Maybe BuildMessage -> IO ()
loop [String]
ls Maybe BuildMessage
forall a. Maybe a
Nothing
Just (String
file, Int
lineNum, Int
colNum, String
msg) -> do
let srcLoc :: SrcLoc
srcLoc = FastString -> Int -> Int -> SrcLoc
mkSrcLoc (String -> FastString
mkFastString String
file) Int
lineNum Int
colNum
[String] -> Maybe BuildMessage -> IO ()
loop [String]
ls (BuildMessage -> Maybe BuildMessage
forall a. a -> Maybe a
Just (SrcLoc -> SDoc -> BuildMessage
BuildError SrcLoc
srcLoc (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
msg)))
leading_whitespace :: String -> Bool
leading_whitespace [] = Bool
False
leading_whitespace (Char
x:String
_) = Char -> Bool
isSpace Char
x
parseError :: String -> Maybe (String, Int, Int, String)
parseError :: String -> Maybe (String, Int, Int, String)
parseError String
s0 = case String -> Maybe (String, String)
breakColon String
s0 of
Just (String
filename, String
s1) ->
case String -> Maybe (Int, String)
breakIntColon String
s1 of
Just (Int
lineNum, String
s2) ->
case String -> Maybe (Int, String)
breakIntColon String
s2 of
Just (Int
columnNum, String
s3) ->
(String, Int, Int, String) -> Maybe (String, Int, Int, String)
forall a. a -> Maybe a
Just (String
filename, Int
lineNum, Int
columnNum, String
s3)
Maybe (Int, String)
Nothing ->
(String, Int, Int, String) -> Maybe (String, Int, Int, String)
forall a. a -> Maybe a
Just (String
filename, Int
lineNum, Int
0, String
s2)
Maybe (Int, String)
Nothing -> Maybe (String, Int, Int, String)
forall a. Maybe a
Nothing
Maybe (String, String)
Nothing -> Maybe (String, Int, Int, String)
forall a. Maybe a
Nothing
breakColon :: String -> Maybe (String, String)
breakColon :: String -> Maybe (String, String)
breakColon = String -> String -> Maybe (String, String)
go []
where
go :: String -> String -> Maybe (String, String)
go String
accum (Char
':':Char
'\\':String
rest) = String -> String -> Maybe (String, String)
go (Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
':'Char -> String -> String
forall a. a -> [a] -> [a]
:String
accum) String
rest
go String
accum (Char
':':Char
'/':String
rest) = String -> String -> Maybe (String, String)
go (Char
'/'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
':'Char -> String -> String
forall a. a -> [a] -> [a]
:String
accum) String
rest
go String
accum (Char
':':String
rest) = (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String -> String
forall a. [a] -> [a]
reverse String
accum, String
rest)
go String
accum (Char
c:String
rest) = String -> String -> Maybe (String, String)
go (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
accum) String
rest
go String
_accum [] = Maybe (String, String)
forall a. Maybe a
Nothing
breakIntColon :: String -> Maybe (Int, String)
breakIntColon :: String -> Maybe (Int, String)
breakIntColon String
xs = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char
':' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) String
xs of
(String
ys, Char
_:String
zs)
| Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ys) Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isAscii String
ys Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
ys ->
(Int, String) -> Maybe (Int, String)
forall a. a -> Maybe a
Just (String -> Int
forall a. Read a => String -> a
read String
ys, String
zs)
(String, String)
_ -> Maybe (Int, String)
forall a. Maybe a
Nothing
data BuildMessage
= BuildMsg !SDoc
| BuildError !SrcLoc !SDoc
| EOF
linesPlatform :: String -> [String]
#if !defined(mingw32_HOST_OS)
linesPlatform :: String -> [String]
linesPlatform String
ls = String -> [String]
lines String
ls
#else
linesPlatform "" = []
linesPlatform xs =
case lineBreak xs of
(as,xs1) -> as : linesPlatform xs1
where
lineBreak "" = ("","")
lineBreak ('\r':'\n':xs) = ([],xs)
lineBreak ('\n':xs) = ([],xs)
lineBreak (x:xs) = let (as,bs) = lineBreak xs in (x:as,bs)
#endif