diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,35 @@ and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## 0.5.1.0 - 2026-07-02 + +* Fix a regression on unsupported operating systems. + +## 0.5.0.0 - 2026-06-22 + +* Fix a regression on Linux operating systems, whereby `xdg-open` would not + return until the browser was closed. +* Replace utility `openBrowserWithExitCode` with `openBrowserWithException`. + +## 0.4.0.0 - 2025-04-02 + +* On Unix-like operating systems, use Haskell to silence the opening + application or script, rather than the `sh` shell on Linux and BSD. +* Add utility `openBrowserWithExitCode`, to help with debugging failure. +* Improve Haddock documentation. + +## 0.3.0.1 - 2025-03-17 + +* On Windows, remove unnecessary dependency on `process`. +* Improve Haddock documentation. + +## 0.3.0.0 - 2025-03-16 + +* Make operating system-related choices at compilation. The function will never + succeed on unsupported operating systems, rather than than throwing an + `ErrorCall` exception. +* Drop support for 32-bit Windows. + ## 0.2.1.1 - 2025-03-15 * Add `CHANGELOG.md` and `README.md`. @@ -19,8 +48,9 @@ * As released by rightfold on Hackage. This entry and prior change log is reconstructed. -* Support GHC versions before GHC 8.0. -* Add support for 32-bit Windows. +* Support GHC versions before GHC 8.0, by removing the Byte Order Mark from + source files. +* Add support for 32-bit Windows, by using the `stdcall` calling convention. ## 0.2.0.0 - 2015-07-31 @@ -28,11 +58,13 @@ ## 0.1.4.0 - 2015-07-30 -* On Linux, silence `xdg-open`. +* On Linux and BSD, silence the `xdg-open` script using the `sh` shell. ## 0.1.3.0 - 2015-07-27 -* Add support for BSD and Windows. +* Add support for BSD, using the `xdg-open` script. +* Add support for Windows, using the Win32 API and the `ccall` calling + convention. ## 0.1.2.0 - 2015-07-27 @@ -40,8 +72,9 @@ ## 0.1.1.0 - 2015-07-27 -* Add support for Linux. +* Add support for Linux, using the `xdg-open` script. +* On OS X, use the `open` application. ## 0.1.0.0 - 2015-07-25 -* Initial version. Only OS X supported. +* Initial version. Only OS X supported, using `open location` in an AppleScript. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,8 +1,8 @@ # open-browser -A Haskell library that provides the function `openBrowser` that, given a URL, -yields an IO action that seeks to open the URL in the user's preferred web -browser. +A Haskell library that provides the function `openBrowser` that, given a URL or +other item associated with a web browser, yields an IO action that seeks to open +the item in the user's preferred web browser. Supported operating systems are Windows, macOS, Linux and BSD. diff --git a/example/Main.hs b/example/Main.hs --- a/example/Main.hs +++ b/example/Main.hs @@ -1,8 +1,30 @@ +{-# LANGUAGE LambdaCase #-} + module Main ( main ) where -import Web.Browser ( openBrowser ) +import Control.Exception ( Exception (..), SomeException ) +import Web.Browser ( openBrowser, openBrowserWithException ) main :: IO () -main = openBrowser "https://haskell.org/" >>= print +main = do + openBrowser "https://haskell.org/" >>= \case + True -> putStrLn "The operation succeeded!" + False -> putStrLn "The operation failed!" + blankLine + putStrLn "Help with debugging:" + putStrLn "Try a good URL:" + tryOpenGoodUrl >>= reportResult + blankLine + putStrLn "Try a bad URL:" + tryOpenBadUrl >>= reportResult + where + tryOpenGoodUrl :: IO (Maybe SomeException) + tryOpenGoodUrl = openBrowserWithException "https://haskell.org/" + tryOpenBadUrl :: IO (Maybe SomeException) + tryOpenBadUrl = openBrowserWithException "example-bad-url" + reportResult = \case + Just e -> putStrLn $ "Exception: " <> displayException e + Nothing -> putStrLn "Nothing to report" + blankLine = putStrLn "" diff --git a/lib/Web/Browser.hs b/lib/Web/Browser.hs --- a/lib/Web/Browser.hs +++ b/lib/Web/Browser.hs @@ -1,30 +1,64 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-| +Module : Web.Browser +Description : Open a web browser from Haskell +Copyright : (c) rightfold 2015 +License : BSD3 +Maintainer : public@pilgrem.com + +Open a web browser from Haskell. Supported operating systems are Windows, macOS, +Linux and BSD. +-} + module Web.Browser ( openBrowser + -- * Utilities + , openBrowserWithException ) where -#if defined(mingw32_HOST_OS) -import Web.Browser.Windows ( openBrowserWindows ) -#else -import Data.List ( isInfixOf ) -import System.Info ( os ) -import Web.Browser.Linux ( openBrowserLinux ) -import Web.Browser.OSX ( openBrowserOSX ) -#endif +import Control.Exception ( Exception (..), SomeException, try) +import Data.Maybe ( isNothing ) +import qualified Web.Browser.OS as OS --- | Seeks to open the given URL in the user's preferred web browser. Returns --- whether or not the operation succeeded. Throws an 'ErrorCall' exception if --- the operating system is unsupported. +-- | Seeks to open the given item, silently. If the item is a URL or another +-- item associated with a web browser (for example, it represents a local +-- @.html@ file), seeks to open it in the user's preferred web browser. Returns +-- whether or not the operation succeeded. +-- +-- No checks are performed on the nature or validity of the given item. +-- +-- Implemented using: +-- +-- * on Windows, the \'open\' operation provided by the Win32 API. For an item +-- that represents a file, equivalent double-clicking on the file's icon; +-- +-- * on macOS, the \'open\' application, if it is on the user's PATH. For an +-- item that represents a file, equivalent to double-clicking on the file's +-- icon; and +-- +-- * on Linux, FreeBSD, OpenBSD or NetBSD, the \'xdg-open\' script, if it +-- is on the user's PATH. +-- +-- On other operating systems, the operation always fails. +-- +-- @since 0.1.0.0 openBrowser :: String - -- ^ URL + -- ^ URL or other item to try to open. -> IO Bool -#if defined(mingw32_HOST_OS) -openBrowser = openBrowserWindows -#else -openBrowser - | any (`isInfixOf` os) ["linux", "bsd"] = openBrowserLinux - | "darwin" `isInfixOf` os = openBrowserOSX - | otherwise = error "unsupported platform" -#endif +openBrowser url = + isNothing <$> (openBrowserWithException url :: IO (Maybe SomeException)) + +-- | Exported to help with debugging. As for 'openBrowser' but returns 'Nothing' +-- or 'Just' an exception. +-- +-- @since 0.5.0.0 +openBrowserWithException :: + Exception e + => String + -- ^ URL or other item to try to open. + -> IO (Maybe e) +openBrowserWithException url = try (OS.openBrowser url) >>= \case + Left e -> pure $ Just e + Right () -> pure Nothing diff --git a/lib/Web/Browser/Linux.hs b/lib/Web/Browser/Linux.hs deleted file mode 100644 --- a/lib/Web/Browser/Linux.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Web.Browser.Linux - ( openBrowserLinux - ) where - -import System.Exit ( ExitCode (..) ) -import System.Process ( rawSystem ) - -openBrowserLinux :: String -> IO Bool -openBrowserLinux url = exitCodeToBool `fmap` rawSystem executable argv - where - (executable, argv) = ("sh", ["-c", "xdg-open \"$0\" 2>&1 > /dev/null", url]) - exitCodeToBool ExitSuccess = True - exitCodeToBool (ExitFailure _) = False diff --git a/lib/Web/Browser/OSX.hs b/lib/Web/Browser/OSX.hs deleted file mode 100644 --- a/lib/Web/Browser/OSX.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Web.Browser.OSX - ( openBrowserOSX - ) where - -import System.Exit ( ExitCode (..) ) -import System.Process ( rawSystem ) - -openBrowserOSX :: String -> IO Bool -openBrowserOSX url = exitCodeToBool `fmap` rawSystem executable argv - where - (executable, argv) = ("open", [url]) - exitCodeToBool ExitSuccess = True - exitCodeToBool (ExitFailure _) = False diff --git a/lib/Web/Browser/Windows.hs b/lib/Web/Browser/Windows.hs deleted file mode 100644 --- a/lib/Web/Browser/Windows.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE ForeignFunctionInterface #-} - -module Web.Browser.Windows - ( openBrowserWindows - ) where - -import System.Win32.Types - ( HANDLE, HINSTANCE, INT, LPCTSTR, handleToWord, nullPtr, withTString ) - -openBrowserWindows :: String -> IO Bool -openBrowserWindows url = - withTString "open" $ \openStr -> - withTString url $ \urlStr -> - exitCodeToBool `fmap` c_ShellExecute nullPtr - openStr - urlStr - nullPtr - nullPtr - 1 - where - exitCodeToBool hinst - | handleToWord hinst > 32 = True - | otherwise = False - --- https://learn.microsoft.com/en-us/windows/win32/api/shellapi/nf-shellapi-shellexecutew -foreign import WINDOWS_CCONV unsafe "windows.h ShellExecuteW" - c_ShellExecute :: - HANDLE -- _In_opt_ - -> LPCTSTR -- _In_opt_ - -> LPCTSTR -- _In_ - -> LPCTSTR -- _In_opt_ - -> LPCTSTR -- _In_opt_ - -> INT -- _In_ - -> IO HINSTANCE diff --git a/lib/unix-like/open/Web/Browser/OS.hs b/lib/unix-like/open/Web/Browser/OS.hs new file mode 100644 --- /dev/null +++ b/lib/unix-like/open/Web/Browser/OS.hs @@ -0,0 +1,24 @@ +-------------------------------------------------------------------------------- +-- For Unix-like operating systems, such as macOS, that provide the open +-- application on the PATH. +-------------------------------------------------------------------------------- + +module Web.Browser.OS + ( openBrowser + ) where + +import Control.Monad ( void ) +import System.Process + ( CreateProcess (..), StdStream (..), createProcess, proc ) + +-- https://ss64.com/mac/open.html +openBrowser :: + String + -- ^ URL or other item to try to open. + -> IO () +openBrowser url = void $ createProcess (proc "open" [url]) + { std_in = NoStream + , std_out = NoStream + , std_err = NoStream + , close_fds = True + } diff --git a/lib/unix-like/xdg-open/Web/Browser/OS.hs b/lib/unix-like/xdg-open/Web/Browser/OS.hs new file mode 100644 --- /dev/null +++ b/lib/unix-like/xdg-open/Web/Browser/OS.hs @@ -0,0 +1,23 @@ +-------------------------------------------------------------------------------- +-- For Unix-like operating systems that provide the xdg-open script on the PATH. +-------------------------------------------------------------------------------- + +module Web.Browser.OS + ( openBrowser + ) where + +import Control.Monad ( void ) +import System.Process + ( CreateProcess (..), StdStream (..), createProcess, proc ) + +-- https://ss64.com/bash/xdg-open.html +openBrowser :: + String + -- ^ URL or other item to try to open. + -> IO () +openBrowser url = void $ createProcess (proc "xdg-open" [url]) + { std_in = NoStream + , std_out = NoStream + , std_err = NoStream + , close_fds = True + } diff --git a/lib/unsupported-os/Web/Browser/OS.hs b/lib/unsupported-os/Web/Browser/OS.hs new file mode 100644 --- /dev/null +++ b/lib/unsupported-os/Web/Browser/OS.hs @@ -0,0 +1,15 @@ +-------------------------------------------------------------------------------- +-- For unsupported operating systems +-------------------------------------------------------------------------------- + +module Web.Browser.OS + ( openBrowser + ) where + +openBrowser :: + String + -- ^ URL or other item to try to open. + -> IO () +openBrowser _ = + -- Operation never succeeds + error "openBrowser: Unsupported operating system." diff --git a/lib/windows/Web/Browser/OS.hs b/lib/windows/Web/Browser/OS.hs new file mode 100644 --- /dev/null +++ b/lib/windows/Web/Browser/OS.hs @@ -0,0 +1,52 @@ +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} +{-# HLINT ignore "Use camelCase" #-} + +{-# LANGUAGE ForeignFunctionInterface #-} + +-------------------------------------------------------------------------------- +-- For Windows operating systems, making use of the Win32 API. +-------------------------------------------------------------------------------- + +module Web.Browser.OS + ( openBrowser + ) where + +import Control.Monad ( unless ) +import System.Win32.Types + ( HANDLE, HINSTANCE, INT, LPCWSTR, handleToWord, nullPtr + , withTString + ) + +type HWND = HANDLE + +-- https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-showwindow +-- Activates and displays a window. If the window is minimized, maximized, or +-- arranged, the system restores it to its original size and position. An +-- application should specify this flag when displaying the window for the first +-- time. +sW_SHOWNORMAL :: INT +sW_SHOWNORMAL = 1 + +openBrowser :: + String + -- ^ URL or other item to try to open. + -> IO () +openBrowser url = do + hinst <- withTString "open" $ \openStr -> + withTString url $ \urlStr -> + c_ShellExecute nullPtr openStr urlStr nullPtr nullPtr sW_SHOWNORMAL + let exitcode = fromIntegral (handleToWord hinst) :: Int + unless (exitcode > 32) $ error $ + "openBrowser: ShellExecuteW \"open\" failed with exit code: " + <> show exitcode + +-- https://learn.microsoft.com/en-us/windows/win32/api/shellapi/nf-shellapi-shellexecutew +foreign import ccall unsafe "windows.h ShellExecuteW" + c_ShellExecute :: + HWND -- [in, optional] hwnd + -> LPCWSTR -- [in, optional] lpOperation + -> LPCWSTR -- [in] lpFile + -> LPCWSTR -- [in, optional] lpParameters + -> LPCWSTR -- [in, optional] lpDirectory + -> INT -- [in] nShowCmd + -> IO HINSTANCE diff --git a/open-browser.cabal b/open-browser.cabal --- a/open-browser.cabal +++ b/open-browser.cabal @@ -1,68 +1,80 @@ cabal-version: 1.12 - --- This file has been generated from package.yaml by hpack version 0.38.0. --- --- see: https://github.com/sol/hpack - -name: open-browser -version: 0.2.1.1 -synopsis: Open a web browser from Haskell. -description: Open a web browser from Haskell. Currently BSD, Linux, OS X and Windows are - supported. -category: Web -homepage: https://github.com/mpilgrem/open-browser -bug-reports: https://github.com/mpilgrem/open-browser/issues -author: rightfold -maintainer: public@pilgrem.com -license: BSD3 -license-file: LICENSE -build-type: Simple -tested-with: - GHC >= 7.6 -extra-source-files: - CHANGELOG.md - README.md - stack.yaml - stack.yaml.lock - -source-repository head - type: git - location: https://github.com/mpilgrem/open-browser - -flag example - description: Build the example application - manual: True - default: False - -library - exposed-modules: - Web.Browser - other-modules: - Web.Browser.Linux - Web.Browser.OSX - hs-source-dirs: - lib - build-depends: - base ==4.* - , process ==1.* - default-language: Haskell2010 - if os(windows) - other-modules: - Web.Browser.Windows - build-depends: - Win32 - if arch(i386) - cpp-options: -DWINDOWS_CCONV=stdcall - else - cpp-options: -DWINDOWS_CCONV=ccall - -executable open-browser-example - main-is: Main.hs - hs-source-dirs: - example - build-depends: - base ==4.* - , open-browser - default-language: Haskell2010 - if !flag(example) - buildable: False + +-- This file has been generated from package.yaml by hpack version 0.39.6. +-- +-- see: https://github.com/sol/hpack + +name: open-browser +version: 0.5.1.0 +synopsis: Open a web browser from Haskell +description: Open a web browser from Haskell. Windows, macOS, Linux and BSD are supported. +category: Web +homepage: https://github.com/mpilgrem/open-browser +bug-reports: https://github.com/mpilgrem/open-browser/issues +author: rightfold +maintainer: public@pilgrem.com +license: BSD3 +license-file: LICENSE +build-type: Simple +tested-with: + GHC >= 8.4 +extra-source-files: + CHANGELOG.md + README.md + +source-repository head + type: git + location: https://github.com/mpilgrem/open-browser + +flag example + description: Build the example application + manual: True + default: False + +library + hs-source-dirs: + lib + exposed-modules: + Web.Browser + build-depends: + base ==4.* + default-language: Haskell2010 + if os(windows) + other-modules: + Web.Browser.OS + hs-source-dirs: + lib/windows + build-depends: + Win32 <3 + else + if os(darwin) + other-modules: + Web.Browser.OS + hs-source-dirs: + lib/unix-like/open + build-depends: + process >=1.2.0.0 && <2 + else + if os(linux) || os(freebsd) || os(openbsd) || os(netbsd) + other-modules: + Web.Browser.OS + hs-source-dirs: + lib/unix-like/xdg-open + build-depends: + process >=1.2.0.0 && <2 + else + other-modules: + Web.Browser.OS + hs-source-dirs: + lib/unsupported-os + +executable open-browser-example + main-is: Main.hs + hs-source-dirs: + example + build-depends: + base ==4.* + , open-browser + default-language: Haskell2010 + if !flag(example) + buildable: False diff --git a/stack.yaml b/stack.yaml deleted file mode 100644 --- a/stack.yaml +++ /dev/null @@ -1,1 +0,0 @@ -snapshot: lts-23.10 # GHC 9.8.4 diff --git a/stack.yaml.lock b/stack.yaml.lock deleted file mode 100644 --- a/stack.yaml.lock +++ /dev/null @@ -1,12 +0,0 @@ -# This file was autogenerated by Stack. -# You should not edit this file by hand. -# For more information, please see the documentation at: -# https://docs.haskellstack.org/en/stable/topics/lock_files - -packages: [] -snapshots: -- completed: - sha256: 889b6bffaf21cd509a7c6017703281e77c2f6df0a0908a11c85fa97fcbf11d4e - size: 680573 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/23/10.yaml - original: lts-23.10