@@ -243,7 +243,7 @@ export async function findHaskellLanguageServer(
243243 }
244244 // now figure out the project GHC version and the latest supported HLS version
245245 // we need for it (e.g. this might in fact be a downgrade for old GHCs)
246- const installableHls = await getLatestSuitableHLS (
246+ const installableHls = await getLatestHLS (
247247 context ,
248248 logger ,
249249 workingDir ,
@@ -293,7 +293,7 @@ async function callGHCup(
293293 }
294294}
295295
296- async function getLatestSuitableHLS (
296+ async function getLatestHLS (
297297 context : ExtensionContext ,
298298 logger : Logger ,
299299 workingDir : string ,
@@ -308,14 +308,29 @@ async function getLatestSuitableHLS(
308308 : await getProjectGHCVersion ( wrapper , workingDir , logger ) ;
309309
310310 // get installable HLS that supports the project GHC version (this might not be the most recent)
311- const latestMetadataHls =
312- projectGhc !== null ? await getLatestHLSforGHC ( context , storagePath , projectGhc , logger ) : null ;
313- if ( latestMetadataHls === null ) {
314- const noMatchingHLS = `No HLS version was found for supporting GHC ${ projectGhc } .` ;
315- window . showErrorMessage ( noMatchingHLS ) ;
316- throw new Error ( noMatchingHLS ) ;
317- } else {
311+ const latestMetadataHls = await getLatestHLSfromMetadata ( context , storagePath , projectGhc , logger ) ;
312+ const latestGhcupHls = await getLatestHLSfromGHCup ( context , storagePath , projectGhc , logger ) ;
313+
314+ if ( latestMetadataHls !== null && latestGhcupHls !== null ) {
315+ // both returned a result, compare versions
316+ if ( comparePVP ( latestMetadataHls , latestGhcupHls ) >= 0 ) {
317+ logger . info ( "Picking HLS according to metadata" ) ;
318318 return latestMetadataHls ;
319+ } else {
320+ logger . info ( "Picking a probably self compiled HLS via ghcup" ) ;
321+ return latestGhcupHls ;
322+ }
323+
324+ } else if ( latestMetadataHls === null && latestGhcupHls !== null ) {
325+ logger . info ( "Picking a probably self compiled HLS via ghcup" ) ;
326+ return latestGhcupHls ;
327+ } else if ( latestMetadataHls !== null && latestGhcupHls === null ) {
328+ logger . info ( "Picking HLS according to metadata" ) ;
329+ return latestMetadataHls ;
330+ } else {
331+ const noMatchingHLS = `No HLS version was found for supporting GHC ${ projectGhc } .` ;
332+ window . showErrorMessage ( noMatchingHLS ) ;
333+ throw new Error ( noMatchingHLS ) ;
319334 }
320335}
321336
@@ -499,6 +514,37 @@ export function addPathToProcessPath(extraPath: string): string {
499514 return PATH . join ( pathSep ) ;
500515}
501516
517+ // complements getLatestHLSfromMetadata, by checking possibly locally compiled
518+ // HLS in ghcup
519+ async function getLatestHLSfromGHCup (
520+ context : ExtensionContext ,
521+ storagePath : string ,
522+ targetGhc : string ,
523+ logger : Logger
524+ ) : Promise < string | null > {
525+ const hlsVersions = await callGHCup (
526+ context ,
527+ logger ,
528+ [ 'list' , '-t' , 'hls' , '-c' , 'installed' , '-r' ] ,
529+ undefined ,
530+ false ,
531+ ) ;
532+ const latestHlsVersion = hlsVersions . split ( / \r ? \n / ) . pop ( ) ! . split ( ' ' ) [ 1 ] ;
533+ logger . info ( `LATEST GHCUP HLS: ${ latestHlsVersion } ` ) ;
534+ let bindir = await callGHCup ( context , logger ,
535+ [ 'whereis' , 'bindir' ] ,
536+ undefined ,
537+ false
538+ ) ;
539+
540+ const hlsBin = path . join ( bindir , `haskell-language-server-${ targetGhc } ~${ latestHlsVersion } ` ) ;
541+ if ( fs . existsSync ( hlsBin ) ) {
542+ return latestHlsVersion ;
543+ } else {
544+ return null ;
545+ }
546+ }
547+
502548/**
503549 * Given a GHC version, download at least one HLS version that can be used.
504550 * This also honours the OS architecture we are on.
@@ -509,7 +555,7 @@ export function addPathToProcessPath(extraPath: string): string {
509555 * @param logger Logger for feedback
510556 * @returns
511557 */
512- async function getLatestHLSforGHC (
558+ async function getLatestHLSfromMetadata (
513559 context : ExtensionContext ,
514560 storagePath : string ,
515561 targetGhc : string ,
0 commit comments