-- |
-- Module      :  EndOfExe2
-- Copyright   :  (c) Oleksandr Zhabenko 2019-2024
-- License     :  MIT
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- A small library to deal with executable endings. Uses a Maybe data representation inside an IO monad.
--
-- It is a fork of now deprecated library [mmsyn3](https://hackage.haskell.org/package/mmsyn3).

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

module EndOfExe2 where

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

-- | 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 search path. It can also search in other locations and its behaviour is OS dependent. For more information, please, refer to the link: <https://hackage.haskell.org/package/directory-1.3.4.0/docs/System-Directory.html#v:findExecutable>
-- For more information, how the executable is searched, see also the following address: <https://hackage.haskell.org/package/process-1.6.18.0/docs/System-Process.html#t:CmdSpec> 
maybeEndOfExecutable :: String -> IO (Maybe String)
maybeEndOfExecutable :: String -> IO (Maybe String)
maybeEndOfExecutable 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
xs
    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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
zs
        else Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing

-- | The function 'endOfExe' returns 'IO' \"\" if no executable found by 'D.findExecutable'. Otherwise, it returns its path in the 'IO' monad.
endOfExe :: String -> IO String
endOfExe :: String -> IO String
endOfExe 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 String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String)
-> (Maybe String -> String) -> Maybe String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> IO String) -> Maybe String -> IO String
forall a b. (a -> b) -> a -> b
$ Maybe String
xs
    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 String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String)
-> (Maybe String -> String) -> Maybe String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> IO String) -> Maybe String -> IO String
forall a b. (a -> b) -> a -> b
$ Maybe String
zs
        else String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
                                  
-- | Gets the proper name of the executable in the system (it must be seen in the directories in the @PATH@ variable). 
-- 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 a. [a] -> Bool
null String
xs = Maybe String
forall a. Maybe a
Nothing
  | 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)
maybeEndOfExecutable (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
xs
{-# INLINE showE #-}

-- | Similar to 'showE' but uses 'unsafeDupablePerformIO', which is more efficient, but for the multiprocessor can lead to executing the IO action multiple times.
showEDup :: String -> Maybe String
showEDup :: String -> Maybe String
showEDup String
xs 
  | String -> Bool
forall a. [a] -> Bool
null String
xs = Maybe String
forall a. Maybe a
Nothing
  | Bool
otherwise = IO (Maybe String) -> Maybe String
forall a. IO a -> a
unsafeDupablePerformIO (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)
maybeEndOfExecutable (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
xs
{-# INLINE showEDup #-}

-- | If executable not found, then returns empty 'String'.
showE0 :: String -> String
showE0 :: String -> String
showE0 String
xs 
  | String -> Bool
forall a. [a] -> Bool
null String
xs = String
""
  | Bool
otherwise = IO String -> String
forall a. IO a -> a
unsafePerformIO (IO String -> String) -> (String -> IO String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
endOfExe (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
xs
{-# INLINE showE0 #-}

-- | If executable not found, then returns empty 'String'. Uses 'unsafeDupablePerformIO'.
showE0Dup :: String -> String
showE0Dup :: String -> String
showE0Dup String
xs 
  | String -> Bool
forall a. [a] -> Bool
null String
xs = String
""
  | Bool
otherwise = IO String -> String
forall a. IO a -> a
unsafeDupablePerformIO (IO String -> String) -> (String -> IO String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
endOfExe (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
xs
{-# INLINE showE0Dup #-}