{- |
Copyright: (c) 2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Contains implementation of a function that opens a given file in a
browser.
-}

module Stan.Browse
    ( openBrowser
    ) where

import Colourista (errorMessage, infoMessage)
import System.Directory (findExecutable)
import System.Environment (lookupEnv)
import System.Info (os)
import System.Process (callCommand, showCommandForUser)


{- | Open a given file in a browser. The function has the following algorithm:

* Check the @BROWSER@ environment variable
* If it's not set, try to guess browser depending on OS
* If unsuccsessful, print a message
-}
openBrowser :: FilePath -> IO ()
openBrowser :: FilePath -> IO ()
openBrowser file :: FilePath
file = FilePath -> IO (Maybe FilePath)
lookupEnv "BROWSER" IO (Maybe FilePath) -> (Maybe FilePath -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just browser :: FilePath
browser -> FilePath -> [FilePath] -> IO ()
runCommand FilePath
browser [FilePath
file]
    Nothing -> case FilePath
os of
        "darwin"  -> FilePath -> [FilePath] -> IO ()
runCommand "open" [FilePath
file]
        "mingw32" -> FilePath -> [FilePath] -> IO ()
runCommand "cmd"  ["/c", "start", FilePath
file]
        curOs :: FilePath
curOs    -> do
            Maybe FilePath
browserExe <- [FilePath] -> IO (Maybe FilePath)
findFirstExecutable
                [ "xdg-open"
                , "cygstart"
                , "x-www-browser"
                , "firefox"
                , "opera"
                , "mozilla"
                , "netscape"
                ]
            case Maybe FilePath
browserExe of
                Just browser :: FilePath
browser -> FilePath -> [FilePath] -> IO ()
runCommand FilePath
browser [FilePath
file]
                Nothing -> do
                    Text -> IO ()
errorMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "Cannot guess browser for the OS: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
curOs
                    Text -> IO ()
infoMessage "Please set the $BROWSER environment variable to a web launcher"
                    IO ()
forall (m :: * -> *) a. MonadIO m => m a
exitFailure

-- | Execute a command with arguments.
runCommand :: FilePath -> [String] -> IO ()
runCommand :: FilePath -> [FilePath] -> IO ()
runCommand cmd :: FilePath
cmd args :: [FilePath]
args = do
    let cmdStr :: FilePath
cmdStr = FilePath -> [FilePath] -> FilePath
showCommandForUser FilePath
cmd [FilePath]
args
    FilePath -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "⚙  " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cmdStr
    FilePath -> IO ()
callCommand FilePath
cmdStr

findFirstExecutable :: [FilePath] -> IO (Maybe FilePath)
findFirstExecutable :: [FilePath] -> IO (Maybe FilePath)
findFirstExecutable = \case
    [] -> Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
    exe :: FilePath
exe:exes :: [FilePath]
exes -> FilePath -> IO (Maybe FilePath)
findExecutable FilePath
exe IO (Maybe FilePath)
-> (Maybe FilePath -> IO (Maybe FilePath)) -> IO (Maybe FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Nothing   -> [FilePath] -> IO (Maybe FilePath)
findFirstExecutable [FilePath]
exes
        Just path :: FilePath
path -> Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path