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

module EndOfExe where

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 Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
xs 
    then Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
ys String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> Maybe String
forall a. a -> Maybe a
Just String
"")
    else do
      Maybe String
zs <- String -> IO (Maybe String)
D.findExecutable (String
ys String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".exe")
      if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
zs
        then Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
ys String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> Maybe String
forall a. a -> Maybe a
Just String
".exe")
        else String -> IO (Maybe String)
forall a. HasCallStack => String -> a
error (String
"Please, install the executable " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ys String -> String -> String
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 
  | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs = String -> Maybe String
forall a. HasCallStack => String -> a
error String
"No executable specified!"
  | Bool
otherwise = IO (Maybe String) -> Maybe String
forall a. IO a -> a
unsafePerformIO (IO (Maybe String) -> Maybe String)
-> (String -> IO (Maybe String)) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Maybe String)
endOfExecutable (String -> Maybe String) -> String -> Maybe String
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 
  | (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe String -> Bool)
-> (String -> Maybe String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
showE) [String]
xss = Maybe String
forall a. Maybe a
Nothing
  | Bool
otherwise = String -> Maybe String
forall a. a -> Maybe a
Just ([String] -> String
forall a. [a] -> a
head ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe String -> Bool)
-> (String -> Maybe String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
showE) ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
xss)