diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2024-06-02 21:00:37 +0200 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2024-06-07 22:20:21 +0200 |
commit | ba789c3413ac996cb65314cb5ac9f77bd9617ff9 (patch) | |
tree | bef3d623dd4326a44d0af3996c4c5e446a40ea9b /src/Command.hs | |
parent | a66cf7cf7d897e87fef715daf36dd773562241ec (diff) |
Patchset parameter for `run' command
Diffstat (limited to 'src/Command.hs')
-rw-r--r-- | src/Command.hs | 39 |
1 files changed, 37 insertions, 2 deletions
diff --git a/src/Command.hs b/src/Command.hs index 78d0d6c..bb0b26f 100644 --- a/src/Command.hs +++ b/src/Command.hs @@ -1,20 +1,55 @@ module Command ( Command(..), + CommandArgumentsType(..), CommandExec(..), getConfig, ) where +import Control.Monad.Except import Control.Monad.Reader +import Data.Kind +import Data.Text (Text) +import Data.Text qualified as T + +import System.Console.GetOpt + import Config -class Command c where +class CommandArgumentsType (CommandArguments c) => Command c where commandName :: proxy c -> String - commandInit :: proxy c -> c + type CommandOptions c :: Type + type CommandOptions c = () + commandOptions :: proxy c -> [OptDescr (CommandOptions c -> CommandOptions c)] + commandOptions _ = [] + defaultCommandOptions :: proxy c -> CommandOptions c + default defaultCommandOptions :: CommandOptions c ~ () => proxy c -> CommandOptions c + defaultCommandOptions _ = () + + type CommandArguments c :: Type + type CommandArguments c = () + + commandInit :: CommandArgumentsType (CommandArguments c) => proxy c -> CommandOptions c -> CommandArguments c -> c commandExec :: c -> CommandExec () +class CommandArgumentsType args where + argsFromStrings :: [String] -> Except String args + +instance CommandArgumentsType () where + argsFromStrings [] = return () + argsFromStrings _ = throwError "no argument expected" + +instance CommandArgumentsType Text where + argsFromStrings [str] = return $ T.pack str + argsFromStrings _ = throwError "expected single argument" + +instance CommandArgumentsType (Maybe Text) where + argsFromStrings [] = return $ Nothing + argsFromStrings [str] = return $ Just (T.pack str) + argsFromStrings _ = throwError "expected at most one argument" + newtype CommandExec a = CommandExec (ReaderT Config IO a) deriving (Functor, Applicative, Monad, MonadIO) |