module Effectful.Notify.Internal.Utils
  ( -- * Text
    maybeStr,
    showt,

    -- * Process
    runProcessIO,

    -- * Int conversions
    unsafeConvertIntegral,

    -- * Misc
    mkProcessText,
    mkProcessTextQuote,
  )
where

import Control.Exception (throwIO)
import Data.Bits (Bits, toIntegralSized)
import Data.Char qualified as Ch
import Data.String (IsString)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Builder (Builder)
import Data.Text.Lazy.Builder qualified as TLB
import Data.Typeable (Typeable)
import Data.Typeable qualified as Typeable
import Effectful qualified as Eff
import Effectful.Process qualified as P
import GHC.IO.Exception
  ( IOErrorType (SystemError),
    IOException
      ( IOError,
        ioe_description,
        ioe_errno,
        ioe_filename,
        ioe_handle,
        ioe_location,
        ioe_type
      ),
  )
import GHC.Stack (HasCallStack)
import System.Exit (ExitCode (ExitFailure, ExitSuccess))

-- | Showable to Text.
showt :: (Show a) => a -> Text
showt :: forall a. Show a => a -> Text
showt = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

maybeStr :: (IsString s) => (a -> s) -> Maybe a -> s
maybeStr :: forall s a. IsString s => (a -> s) -> Maybe a -> s
maybeStr = s -> (a -> s) -> Maybe a -> s
forall b a. b -> (a -> b) -> Maybe a -> b
maybe s
""

-- | Runs the string as a shell command, throwing error as exceptions.
runProcessIO ::
  (HasCallStack) =>
  String ->
  IO ()
runProcessIO :: HasCallStack => String -> IO ()
runProcessIO String
cmdStr = do
  (ec, out, err) <- Eff '[Process, IOE] (ExitCode, String, String)
-> IO (ExitCode, String, String)
forall {a}. Eff '[Process, IOE] a -> IO a
runner (Eff '[Process, IOE] (ExitCode, String, String)
 -> IO (ExitCode, String, String))
-> Eff '[Process, IOE] (ExitCode, String, String)
-> IO (ExitCode, String, String)
forall a b. (a -> b) -> a -> b
$ CreateProcess
-> String -> Eff '[Process, IOE] (ExitCode, String, String)
forall (es :: [(* -> *) -> * -> *]).
(Process :> es) =>
CreateProcess -> String -> Eff es (ExitCode, String, String)
P.readCreateProcessWithExitCode CreateProcess
pr String
""
  case ec of
    ExitCode
ExitSuccess -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    ExitFailure Int
n ->
      IOException -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$
        IOError
          { ioe_handle :: Maybe Handle
ioe_handle = Maybe Handle
forall a. Maybe a
Nothing,
            ioe_type :: IOErrorType
ioe_type = IOErrorType
SystemError,
            ioe_location :: String
ioe_location = String
"runProcessIO",
            ioe_description :: String
ioe_description =
              [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                [ String
"Running command '",
                  String
cmdStr,
                  String
"' failed. Out: '",
                  String
out,
                  String
"'; Err: '",
                  String
err,
                  String
"'."
                ],
            ioe_errno :: Maybe CInt
ioe_errno = CInt -> Maybe CInt
forall a. a -> Maybe a
Just (CInt -> Maybe CInt) -> CInt -> Maybe CInt
forall a b. (a -> b) -> a -> b
$ Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n,
            ioe_filename :: Maybe String
ioe_filename = Maybe String
forall a. Maybe a
Nothing
          }
  where
    pr :: CreateProcess
pr = String -> CreateProcess
P.shell String
cmdStr

    runner :: Eff '[Process, IOE] a -> IO a
runner = Eff '[IOE] a -> IO a
forall a. HasCallStack => Eff '[IOE] a -> IO a
Eff.runEff (Eff '[IOE] a -> IO a)
-> (Eff '[Process, IOE] a -> Eff '[IOE] a)
-> Eff '[Process, IOE] a
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff '[Process, IOE] a -> Eff '[IOE] a
forall (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, IOE :> es) =>
Eff (Process : es) a -> Eff es a
P.runProcess

-- | Escapes text so it is acceptable for sending to the shell. If the text
-- is non-empty:
--
-- - Escapes double quotes e.g. " -> \\\"
-- - If there is any whitespace, surrounds text in non-escaped double quotes.
-- - Surrounds text with whitespace.
mkProcessText :: Text -> Text
mkProcessText :: Text -> Text
mkProcessText = Bool -> Text -> Text
mkProcessTextQuote Bool
False

-- | Escapes text so it is acceptable for sending to the shell. If the text
-- is non-empty:
--
-- - Escapes double quotes e.g. " -> \\\"
-- - If there is any whitespace, surrounds text in non-escaped double quotes.
-- - Surrounds text with whitespace.
mkProcessTextQuote :: Bool -> Text -> Text
mkProcessTextQuote :: Bool -> Text -> Text
mkProcessTextQuote Bool
_ Text
"" = Text
""
mkProcessTextQuote Bool
shouldQuote Text
t =
  LazyText -> Text
TL.toStrict
    (LazyText -> Text) -> (Builder -> LazyText) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyText
TLB.toLazyText
    (Builder -> LazyText)
-> (Builder -> Builder) -> Builder -> LazyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
addDQuotes
    (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Builder
builder
  where
    (Builder
builder, Bool
foundWs) = ((Builder, Bool) -> Char -> (Builder, Bool))
-> (Builder, Bool) -> Text -> (Builder, Bool)
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' (Builder, Bool) -> Char -> (Builder, Bool)
go (Builder
"", Bool
False) Text
t

    -- Adds quotes if necessary and whitespace unconditionally. We could
    -- use cons/unsnoc (0(1) each) to conditionally add whitespace when
    -- leading/trailing does not already exist, but this is simpler and
    -- harmless.
    --
    -- Also, always quote if the arg is true.
    addDQuotes :: Builder -> Builder
addDQuotes Builder
b =
      if Bool
shouldQuote Bool -> Bool -> Bool
|| Bool
foundWs
        then Builder
" \"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\" "
        else Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" "

    go :: (Builder, Bool) -> Char -> (Builder, Bool)
    go :: (Builder, Bool) -> Char -> (Builder, Bool)
go (Builder
acc, Bool
ws) Char
'"' = (Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\\\"", Bool
ws)
    go (Builder
acc, Bool
ws) Char
c = (Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
TLB.singleton Char
c, Char -> Bool
Ch.isSpace Char
c Bool -> Bool -> Bool
|| Bool
ws)

unsafeConvertIntegral ::
  forall a b.
  ( Bits a,
    Bits b,
    HasCallStack,
    Integral a,
    Integral b,
    Show a,
    Typeable a,
    Typeable b
  ) =>
  a ->
  b
unsafeConvertIntegral :: forall a b.
(Bits a, Bits b, HasCallStack, Integral a, Integral b, Show a,
 Typeable a, Typeable b) =>
a -> b
unsafeConvertIntegral a
x = case a -> Either String b
forall a b.
(Bits a, Bits b, Integral a, Integral b, Show a, Typeable a,
 Typeable b) =>
a -> Either String b
convertIntegral a
x of
  Right b
y -> b
y
  Left String
err -> String -> b
forall a. HasCallStack => String -> a
error String
err

-- | Like 'fromIntegral', except the conversion is only between integral types.
convertIntegral ::
  forall a b.
  ( Bits a,
    Bits b,
    Integral a,
    Integral b,
    Show a,
    Typeable a,
    Typeable b
  ) =>
  a ->
  Either String b
convertIntegral :: forall a b.
(Bits a, Bits b, Integral a, Integral b, Show a, Typeable a,
 Typeable b) =>
a -> Either String b
convertIntegral a
x = case a -> Maybe b
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized a
x of
  Just b
y -> b -> Either String b
forall a b. b -> Either a b
Right b
y
  Maybe b
Nothing ->
    String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$
      [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"convertIntegral: Failed converting ",
          a -> String
forall a. Show a => a -> String
show a
x,
          String
" from ",
          TypeRep -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
Typeable.typeOf a
x),
          String
" to ",
          TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ b -> TypeRep
forall a. Typeable a => a -> TypeRep
Typeable.typeOf (b
forall a. HasCallStack => a
undefined :: b)
        ]