hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix opening changelog on windows

Browse Source
This commit is contained in:
Julian Ospald 2023-11-20 22:36:17 +08:00
parent 2caf491e9d
commit 3a8cdf9967
No known key found for this signature in database
GPG Key ID: 4275CDA6A29BED43
2 changed files with 25 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
app/ghcup/BrickMain.hs
View File

@ -52,6 +52,7 @@ import Haskus.Utils.Variant.Excepts
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Exit import System.Exit
import System.IO.Unsafe import System.IO.Unsafe
import System.Process ( system )
import Text.PrettyPrint.HughesPJClass ( prettyShow ) import Text.PrettyPrint.HughesPJClass ( prettyShow )
import URI.ByteString import URI.ByteString
@ -644,12 +645,18 @@ changelog' _ (_, ListResult {..}) = do
Nothing -> pure $ Left $ Nothing -> pure $ Left $
"Could not find ChangeLog for " <> prettyShow lTool <> ", version " <> T.unpack (prettyVer lVer) "Could not find ChangeLog for " <> prettyShow lTool <> ", version " <> T.unpack (prettyVer lVer)
Just uri -> do Just uri -> do
let cmd = case _rPlatform pfreq of case _rPlatform pfreq of
Darwin -> "open" Darwin -> exec "open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
Linux _ -> "xdg-open" Linux _ -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
FreeBSD -> "xdg-open" FreeBSD -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
Windows -> "start" Windows -> do
exec cmd [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing >>= \case let args = "start \"\" " ++ (T.unpack $ decUTF8Safe $ serializeURIRef' uri)
c <- liftIO $ system $ args
case c of
(ExitFailure xi) -> pure $ Left $ NonZeroExit xi "cmd.exe" [args]
ExitSuccess -> pure $ Right ()
>>= \case
Right _ -> pure $ Right () Right _ -> pure $ Right ()
Left e -> pure $ Left $ prettyHFError e Left e -> pure $ Left $ prettyHFError e

22
lib-opt/GHCup/OptParse/ChangeLog.hs
View File

@ -29,6 +29,7 @@ import Data.Maybe
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Exit import System.Exit
import System.Process ( system )
import Text.PrettyPrint.HughesPJClass ( prettyShow ) import Text.PrettyPrint.HughesPJClass ( prettyShow )
import qualified Data.Text as T import qualified Data.Text as T
@ -128,21 +129,22 @@ changelog ChangeLogOptions{..} runAppState runLogger = do
Just uri -> do Just uri -> do
pfreq <- runAppState getPlatformReq pfreq <- runAppState getPlatformReq
let uri' = T.unpack . decUTF8Safe . serializeURIRef' $ uri let uri' = T.unpack . decUTF8Safe . serializeURIRef' $ uri
cmd = case _rPlatform pfreq of
Darwin -> "open"
Linux _ -> "xdg-open"
FreeBSD -> "xdg-open"
Windows -> "start"
if clOpen if clOpen
then do then do
runAppState $ runAppState $
exec cmd case _rPlatform pfreq of
[T.unpack $ decUTF8Safe $ serializeURIRef' uri] Darwin -> exec "open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
Nothing Linux _ -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
Nothing FreeBSD -> exec "xdg-open" [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing
Windows -> do
let args = "start \"\" " ++ (T.unpack $ decUTF8Safe $ serializeURIRef' uri)
c <- liftIO $ system $ args
case c of
(ExitFailure xi) -> pure $ Left $ NonZeroExit xi "cmd.exe" [args]
ExitSuccess -> pure $ Right ()
>>= \case >>= \case
Right _ -> pure ExitSuccess Right _ -> pure ExitSuccess
Left e -> logError (T.pack $ prettyHFError e) Left e -> logError (T.pack $ prettyHFError e)
>> pure (ExitFailure 13) >> pure (ExitFailure 13)
else liftIO $ putStrLn uri' >> pure ExitSuccess else liftIO $ putStrLn uri' >> pure ExitSuccess