-- Die SP1 Aufgabe "clash" in Haskell
-- $Id: clash.hs,v 1.1 2024/03/21 17:58:53 oc45ujef Exp $
-- https://wwwcip.cs.fau.de/~oc45ujef/misc/clash.hs
-- Implementierung inspiriert von https://wwwcip.cs.fau.de/~oj14ozun/src+etc/clash.sml
import System.Posix.Process
import System.Posix.Types (ProcessID)
import System.IO
import System.Exit (exitSuccess)
import Control.Arrow (first)
import System.Directory (getCurrentDirectory, setCurrentDirectory)
import Control.Monad.State
import Control.Exception (SomeException, catch)
import Data.List

type Sh = StateT [(ProcessID, String)] IO

-- this was `recently` added to Data.List
unsnoc :: [a] -> Maybe ([a], a)
unsnoc = foldr (\x -> Just . maybe ([], x) (first (x :))) Nothing

err :: String -> Sh ()
err = lift . hPutStrLn stderr

printProc :: ProcessID -> String -> Sh ()
printProc pid c = lift $ putStrLn $ "[" <> show pid <> "] " <> c

cleanup :: Sh ()
cleanup = do
  s <- lift $ getAnyProcessStatus False True `catch` (\(_ :: SomeException) -> pure Nothing)
  case s of
    Nothing -> pure ()
    Just (pid, _) -> do
      gets (find ((== pid) . fst)) >>= maybe (pure ()) (uncurry printProc)
      modify (filter ((/= pid) . fst)) >> cleanup

prompt :: Sh ()
prompt = lift $ getCurrentDirectory >>= putStr . (<> ": ") >> hFlush stdout

cmd :: [String] -> Sh ()
cmd ["cd", dir] = lift (setCurrentDirectory dir)
cmd ("cd" : _) = err "usage: cd [dir]"
cmd ["jobs"] = get >>= mapM_ (uncurry printProc)
cmd ("jobs" : _) = err "usage: jobs"
cmd (c : args) =
  case unsnoc args of
    Just (args', "&") -> do
      child <- fork args'
      modify ((child , unwords (c : args')) :)
    Just _ -> fork args >>= wait
    Nothing -> fork args >>= wait
    where
      fork argv = lift $ forkProcess (executeFile c True argv Nothing)
      wait = lift . void . getProcessStatus True False
cmd [] = pure ()

execute :: Sh ()
execute = (lift isEOF >>= (`when` lift exitSuccess))
          >> lift getLine >>= cmd . words

main :: IO ()
main = void $ execStateT (forever $ cleanup >> prompt >> execute) []