David Eichmann pushed to branch wip/davide/ghc-toolchain-throw-less at Glasgow Haskell Compiler / GHC

Commits:

2 changed files:

Changes:

  • utils/ghc-toolchain/src/GHC/Toolchain/Program.hs
    ... ... @@ -148,12 +148,14 @@ findProgram description userSpec candidates
    148 148
                     Just prefix -> map (prefix++) candidates
    
    149 149
                     Nothing     -> []
    
    150 150
               candidates' = prefixedCandidates ++ candidates
    
    151
    -          err =
    
    152
    -            [ "Failed to find " ++ description ++ "."
    
    153
    -            , "Looked for one of " ++ show candidates' ++ " in the system search path."
    
    154
    -            ]
    
    155
    -      path <- oneOf' err (map findExecutableErr candidates')
    
    156
    -      return Program { prgPath = path, prgFlags = fromMaybe [] (poFlags userSpec) }
    
    151
    +      pathMay <- findM doesExecutableExist candidates'
    
    152
    +      case pathMay of
    
    153
    +        Nothing -> throwEs
    
    154
    +          [ "Failed to find " ++ description ++ "."
    
    155
    +          , "Looked for one of " ++ show candidates' ++ " in the system search path."
    
    156
    +          ]
    
    157
    +        Just path ->
    
    158
    +          return Program { prgPath = path, prgFlags = fromMaybe [] (poFlags userSpec) }
    
    157 159
     
    
    158 160
     -- Note that @configure.ac@ checks these llvm version constants (using @sed@) to
    
    159 161
     -- ensure they are the same as the @$LlvmMinVersion@ and @$LlvmMaxVersion@
    
    ... ... @@ -222,21 +224,18 @@ maybeFindProgramFromProgOpts :: String -> ProgOpt -> Maybe (M Program)
    222 224
     maybeFindProgramFromProgOpts description userSpec = case poPath userSpec of
    
    223 225
       Nothing -> Nothing
    
    224 226
       Just path -> Just $ do
    
    225
    -    let err =
    
    226
    -          [ "Failed to find " ++ description ++ "."
    
    227
    -          , "Looked for user-specified program '" ++ path ++ "' in the system search path."
    
    228
    -          ]
    
    229
    -    path' <- findExecutableErr path <|> throwEs err
    
    230
    -    return Program { prgPath = path', prgFlags = fromMaybe [] (poFlags userSpec) }
    
    231
    -
    
    232
    -findExecutableErr :: String -> M FilePath
    
    233
    -findExecutableErr name = do
    
    234
    -    r <- liftIO $ findExecutable name
    
    235
    -    case r of
    
    236
    -      Nothing -> throwE $ name ++ " not found in search path"
    
    237
    -      -- Use the given `prgPath` or candidate name rather than the
    
    238
    -      -- absolute path returned by `findExecutable`.
    
    239
    -      Just _x -> return name
    
    227
    +    exists <- doesExecutableExist path
    
    228
    +    unless exists $ throwEs
    
    229
    +      [ "Failed to find " ++ description ++ "."
    
    230
    +      , "Looked for user-specified program '" ++ path ++ "' in the system search path."
    
    231
    +      ]
    
    232
    +    return Program { prgPath = path, prgFlags = fromMaybe [] (poFlags userSpec) }
    
    233
    +
    
    234
    +doesExecutableExist
    
    235
    +  :: String -- ^ executable name
    
    236
    +  -> M Bool
    
    237
    +doesExecutableExist name = isJust <$> liftIO (findExecutable name)
    
    238
    +
    
    240 239
     
    
    241 240
     -------------------- Compiling utilities --------------------
    
    242 241
     
    

  • utils/ghc-toolchain/src/GHC/Toolchain/Utils.hs
    ... ... @@ -9,6 +9,7 @@ module GHC.Toolchain.Utils
    9 9
         , oneOf'
    
    10 10
         , isSuccess
    
    11 11
         , lastLine
    
    12
    +    , findM
    
    12 13
         ) where
    
    13 14
     
    
    14 15
     import Control.Exception
    
    ... ... @@ -69,3 +70,10 @@ isSuccess = \case
    69 70
     
    
    70 71
     lastLine :: String -> String
    
    71 72
     lastLine = maybe "" snd . unsnoc . lines
    
    73
    +
    
    74
    +findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
    
    75
    +findM f = \case
    
    76
    +  [] -> return Nothing
    
    77
    +  a:as -> do
    
    78
    +    found <- f a
    
    79
    +    if found then return (Just a) else findM f as