-- |
-- Module      :  EndOfExe
-- Copyright   :  (c) Oleksandr Zhabenko 2019-2023
-- License     :  MIT
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- A small library to deal with executable endings. Uses a Maybe data representation inside an IO monad.

{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_HADDOCK -show-extensions #-}

module EndOfExe where

import GHC.Base
import GHC.List
import qualified System.Directory as D (findExecutable)
import Data.Maybe (isJust,isNothing)
import System.IO.Unsafe (unsafePerformIO)

-- | Can be used instead of 'System.Info.os' to check whether the executable ends in \".exe\". The function returns 'IO' 'Nothing' if there is neither 
-- @ys@ nor @(ys ++ ".exe")@ names for executables in the variable @PATH@.
endOfExecutable :: String -> IO (Maybe String)
endOfExecutable :: String -> IO (Maybe String)
endOfExecutable String
ys = do
  Maybe String
xs <- String -> IO (Maybe String)
D.findExecutable String
ys
  if forall a. Maybe a -> Bool
isJust Maybe String
xs 
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
ys forall a. [a] -> [a] -> [a]
++) (forall a. a -> Maybe a
Just String
"")
    else do
      Maybe String
zs <- String -> IO (Maybe String)
D.findExecutable (String
ys forall a. [a] -> [a] -> [a]
++ String
".exe")
      if forall a. Maybe a -> Bool
isJust Maybe String
zs
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
ys forall a. [a] -> [a] -> [a]
++) (forall a. a -> Maybe a
Just String
".exe")
        else forall a. HasCallStack => String -> a
error (String
"EndOfExe.endOfExecutable: Please, install the executable " forall a. [a] -> [a] -> [a]
++ String
ys forall a. [a] -> [a] -> [a]
++ String
" into the directory in the PATH variable!")
                                  
-- | Gets the proper name of the executable in the system (it must be seen in the directories in the @PATH@ variable). 
-- You can use 'showE' \"nameOfExecutable\" to get 'Just' \"nameOfExecutable\"@ if it is present on the system. Further you can adopt it to be used 
-- inside the 'System.Process.callCommand' as the name of the executable
showE :: String -> Maybe String
showE :: String -> Maybe String
showE String
xs 
  | forall a. [a] -> Bool
null String
xs = forall a. HasCallStack => String -> a
error String
"EndOfExe.showE: No executable specified!"
  | Bool
otherwise = forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Maybe String)
endOfExecutable forall a b. (a -> b) -> a -> b
$ String
xs

-- | Being given a list of names of executables (without an \".exe\" suffix) looks up for them in the specified list order 
-- till the first existing occurrence. If there is no such occurrence (the specified executables are not installed in the directories 
-- mentioned in the variable @PATH@) then the function returns 'Nothing'.
findSysExes :: [String] -> Maybe String
findSysExes :: [String] -> Maybe String
findSysExes [String]
xss 
  | forall a. (a -> Bool) -> [a] -> Bool
all (forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
showE) [String]
xss = forall a. Maybe a
Nothing
  | Bool
otherwise = forall a. a -> Maybe a
Just (forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
showE) forall a b. (a -> b) -> a -> b
$ [String]
xss)