{-# 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

  , openBrowserWithExitCode
  ) where

import           Control.Exception ( Exception (..), SomeException, try)
import           System.Exit ( ExitCode (..) )
import qualified Web.Browser.OS as OS

-- | 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 or other item to try to open.

  -> IO Bool
openBrowser :: String -> IO Bool
openBrowser String
url = IO (Either SomeException (ExitCode, String, String))
tryOpenUrl IO (Either SomeException (ExitCode, String, String))
-> (Either SomeException (ExitCode, String, String) -> IO Bool)
-> IO Bool
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Left SomeException
_ -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  Right (ExitCode
ec, String
_, String
_) -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ ExitCode
ec ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
 where
  tryOpenUrl :: IO (Either SomeException (ExitCode, String, String))
  tryOpenUrl :: IO (Either SomeException (ExitCode, String, String))
tryOpenUrl = String -> IO (Either SomeException (ExitCode, String, String))
forall e.
Exception e =>
String -> IO (Either e (ExitCode, String, String))
openBrowserWithExitCode String
url

-- | Exported to help with debugging. As for 'openBrowser' but returns either an

-- exception or, as a triple, the 'ExitCode' of the opening mechanism and any

-- output to the standard output and standard error channels. On failure, the

-- meaning of the exit code will depend on the operating system; for unsupported

-- operating systems, it will be 'ExitFailure' @1@.

--

-- @since 0.4.0.0

openBrowserWithExitCode ::
     Exception e
  => String
     -- ^ URL or other item to try to open.

  -> IO (Either e (ExitCode, String, String))
openBrowserWithExitCode :: forall e.
Exception e =>
String -> IO (Either e (ExitCode, String, String))
openBrowserWithExitCode String
url = IO (ExitCode, String, String)
-> IO (Either e (ExitCode, String, String))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (ExitCode, String, String)
 -> IO (Either e (ExitCode, String, String)))
-> IO (ExitCode, String, String)
-> IO (Either e (ExitCode, String, String))
forall a b. (a -> b) -> a -> b
$ String -> IO (ExitCode, String, String)
OS.openBrowserWithExitCode String
url