{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE QuantifiedConstraints #-}

module Process
  ( sh,
    sh_,
    ProcessType,
    Quotable (..),
    proc,
    textInput,
  )
where

import Control.Exception (throwIO)
import Data.ByteString.Lazy.Char8 qualified as LB
import Data.List (intercalate)
import Data.String (fromString)
import Data.Text qualified as T
import Data.Text.Lazy qualified as LT
import Data.Text.Lazy.Encoding qualified as LT
import Exception qualified as E
import System.Exit (ExitCode (ExitSuccess))
import System.Process.Typed (ProcessConfig, StreamSpec, StreamType (STInput), byteStringInput, readProcess, readProcessStderr)

sh :: ProcessConfig stdin stdoutIgnored stderr -> IO LB.ByteString
sh processConfig = do
  (exitCode, out, err) <- readProcess processConfig
  if exitCode == ExitSuccess
    then pure out
    else throwIO $ E.ProcessException (show processConfig) exitCode err

sh_ :: ProcessConfig stdin stdoutIgnored stderr -> IO ()
sh_ processConfig = do
  (exitCode, err) <- readProcessStderr processConfig
  if exitCode == ExitSuccess
    then pure ()
    else throwIO $ E.ProcessException (show processConfig) exitCode err

class Quotable a where
  quote :: a -> String

instance {-# OVERLAPPING #-} Quotable String where
  quote s = "'" ++ escape s ++ "'"
    where
      escape [] = []
      escape ('\'' : cs) = '\'' : '\\' : '\'' : '\'' : escape cs
      escape (c : cs) = c : escape cs

instance Quotable T.Text where
  quote = quote . T.unpack

instance Quotable Int where
  quote = show

instance {-# OVERLAPPABLE #-} Quotable a => Quotable [a] where
  quote = intercalate " " . map quote

class ProcessType r where
  spr :: String -> [String] -> r

instance (Quotable a, ProcessType r) => ProcessType (a -> r) where
  spr fmt as = \a -> spr fmt (quote a : as)

instance (() ~ stdin, () ~ stdoutIgnored, () ~ stderr) => ProcessType (ProcessConfig stdin stdoutIgnored stderr) where
  spr fmt args = fromString (interp (reverse args) fmt)

interp :: [String] -> String -> String
interp (_ : _) "" = error "sh: extra arguments"
interp [] "" = ""
interp as ('%' : '%' : cs) = '%' : interp as cs
interp [] ('%' : _) = error "sh: insufficient arguments"
interp (a : as) ('%' : cs) = a ++ interp as cs
interp as (c : cs) = c : interp as cs

proc :: ProcessType r => String -> r
proc fmt = spr fmt []

textInput :: LT.Text -> StreamSpec 'STInput ()
textInput = byteStringInput . LT.encodeUtf8