{-# OPTIONS_GHC -fglasgow-exts #-}
module Test.Maybench.Command where

import Test.Maybench.Utils ((|>))

infixl 5 <@>

data Command = Cmd { cmdName :: String, cmdArgs :: [String], cmdInput :: String }

updateCmdName :: (String -> String) -> (Command -> Command)
updateCmdName f c = c { cmdName = f $ cmdName c }

updateCmdInput :: (String -> String) -> (Command -> Command)
updateCmdInput f c = c { cmdInput = f $ cmdInput c }

updateCmdArgs :: ([String] -> [String]) -> (Command -> Command)
updateCmdArgs f c = c { cmdArgs = f $ cmdArgs c }

addArg :: String -> (Command -> Command)
addArg arg = updateCmdArgs (|> arg)

addArgs :: [String] -> (Command -> Command)
addArgs arg = updateCmdArgs (++ arg)

class Monad m => CommandModifierClass m mod where
  modifyCmd :: mod -> m (Command -> Command)

data CommandModifier m where
  Nop    :: CommandModifier m
  CmdMod :: (Monad m, CommandModifierClass m mod) => CommandModifier m -> mod -> CommandModifier m

(<@>) :: (Monad m, CommandModifierClass m mod) => CommandModifier m -> mod -> CommandModifier m
(<@>) = CmdMod

instance Monad m => CommandModifierClass m (CommandModifier m) where
  modifyCmd Nop          = return id
  modifyCmd (CmdMod f g) = do
    f' <- modifyCmd f
    g' <- modifyCmd g
    return (g' . f')

{-
instance CommandModifierClass mod => CommandModifierClass [mod] where
  modifyCmd []         = id
  modifyCmd (mod:mods) = modifyCmd mod . modifyCmd mods
-}

instance Monad m => CommandModifierClass m String where
  modifyCmd = return . addArg

instance Monad m => CommandModifierClass m [String] where
  modifyCmd = return . addArgs

instance Monad m => CommandModifierClass m Command where
  modifyCmd = return . const