{-# OPTIONS_GHC -fno-warn-orphans #-}

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies      #-}

{- |
Module                  : Shellmet
Copyright               : (c) 2019-2021 Kowainik
SPDX-License-Identifier : MPL-2.0
Maintainer              : Kowainik <xrom.xkov@gmail.com>
Stability               : Stable
Portability             : Portable

This module contains neat utilities to be able to work with
shell commands in generic and simple way using just string literals.

>>> "echo" ["Hello", "World!"]
⚙  echo Hello 'World!'
Hello World!
-}

module Shellmet
    ( ($|)
    , ($^)
    , ($?)
    , isSuccess
    ) where

import Control.Exception (catch)
import Data.String (IsString (..))
import Data.Text (Text)
import System.Process (callCommand, readProcess, showCommandForUser)

import qualified Data.Text as T


{- | This instance is needed to provide functionality to call commands by using
simple string literals in 'IO' monad.

>>> "ls" ["-1", "test"]
⚙  ls -1 test
Doctest.hs
-}
instance (a ~ [Text], b ~ IO ()) => IsString (a -> b) where
    fromString :: String -> [Text] -> IO ()
    fromString :: String -> [Text] -> IO ()
fromString String
cmd [Text]
args = do
        let cmdStr :: String
cmdStr = String -> [String] -> String
showCommandForUser String
cmd ((Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack [Text]
args)
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"⚙  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cmdStr
        String -> IO ()
callCommand String
cmdStr
    {-# INLINE fromString #-}

{- | Run shell command with given options and return stripped stdout of the
executed command.

>>> "echo" $| ["Foo", "Bar"]
"Foo Bar"
-}
infix 5 $|
($|) :: FilePath -> [Text] -> IO Text
String
cmd $| :: String -> [Text] -> IO Text
$| [Text]
args = Text -> Text
T.strip (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> IO String -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO String
readProcess String
cmd ((Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack [Text]
args) String
""
{-# INLINE ($|) #-}

{- | This operator runs shell command with given options but doesn't print the
command itself.

>>> "echo" $^ ["Foo", "Bar"]
Foo Bar
-}
infix 5 $^
($^) :: FilePath -> [Text] -> IO ()
String
cmd $^ :: String -> [Text] -> IO ()
$^ [Text]
args = String -> IO ()
callCommand (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
showCommandForUser String
cmd ((Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack [Text]
args)
{-# INLINE ($^) #-}

{- | Do some IO actions when process failed with 'IOError'.

>>> "exit" ["0"] $? putStrLn "Command failed"
⚙  exit 0

>>> "exit" ["1"] $? putStrLn "Command failed"
⚙  exit 1
Command failed
-}
infixl 4 $?
($?) :: IO a -> IO a -> IO a
IO a
action $? :: forall a. IO a -> IO a -> IO a
$? IO a
handler = IO a
action IO a -> (IOError -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOError
_ :: IOError) -> IO a
handler
{-# INLINE ($?) #-}

{- | Returns the indicator of if the command succeded or not.

>>> isSuccess $ "echo" ["Hello world!"]
⚙  echo 'Hello world!'
Hello world!
True
-}
isSuccess :: IO a -> IO Bool
isSuccess :: forall a. IO a -> IO Bool
isSuccess IO a
action = (Bool
True Bool -> IO a -> IO Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ IO a
action) IO Bool -> IO Bool -> IO Bool
forall a. IO a -> IO a -> IO a
$? Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False