{-# Language ExistentialQuantification #-}
{-|
Module      : Client.Commands.Types
Description : Types used to implement client commands
Copyright   : (c) Eric Mertens, 2016-2020
License     : ISC
Maintainer  : emertens@gmail.com
-}

module Client.Commands.Types where

import Client.Commands.Arguments.Spec (Args)
import Client.State (ClientState, clientErrorMsg, clientConnection, clientFocus)
import Client.State.Focus (Focus)
import Client.State.Network (NetworkState, csNetwork)
import Control.Lens (set, view)
import Data.List.NonEmpty (NonEmpty)
import Data.Text (Text)
import Irc.Identifier (Identifier)
import LensUtils (setStrict)

-- | Possible results of running a command
data CommandResult
  -- | Continue running the client, consume input if command was from input
  = CommandSuccess ClientState
  -- | Continue running the client, report an error
  | CommandFailure ClientState
  -- | Client should close
  | CommandQuit ClientState


-- | Type of commands that always work
type ClientCommand a = ClientState -> a {- ^ arguments -} -> IO CommandResult

-- | Type of commands that operate on a window
type WindowCommand a = Focus -> ClientCommand a

-- | Type of commands that require an active network to be focused
type NetworkCommand a = NetworkState {- ^ current network -} -> ClientCommand a

-- | Type of commands that require an active network to be focused and maybe a chat window.
type MaybeChatCommand a = Maybe Identifier {- ^ focused channel -} -> NetworkCommand a

-- | Type of commands that require an active channel to be focused
type ChannelCommand a = Identifier {- ^ focused channel -} -> NetworkCommand a


-- | Pair of implementations for executing a command and tab completing one.
-- The tab-completion logic is extended with a Bool
-- indicating that tab completion should be reversed
data CommandImpl a
  -- | no requirements
  = ClientCommand    (ClientCommand  a)   (Bool -> ClientCommand String)
  -- | operates on a window
  | WindowCommand    (WindowCommand a)    (Bool -> WindowCommand String)
  -- | requires an active network
  | NetworkCommand   (NetworkCommand a)   (Bool -> NetworkCommand String)
  -- | requires an active network and maybe a chat window
  | MaybeChatCommand (MaybeChatCommand a) (Bool -> MaybeChatCommand String)
  -- | requires an active chat window
  | ChatCommand      (ChannelCommand a)   (Bool -> ChannelCommand String)
  -- | requires an active channel window
  | ChannelCommand   (ChannelCommand a)   (Bool -> ChannelCommand String)

-- | Data available to the arguments parser at the time of parsing.
data ArgsContext = ArgsContext
  { ArgsContext -> ClientState
argsContextSt    :: ClientState 
  , ArgsContext -> Focus
argsContextFocus :: Focus
  }

makeArgsContext :: ClientState -> ArgsContext
makeArgsContext :: ClientState -> ArgsContext
makeArgsContext ClientState
st = ArgsContext {argsContextSt :: ClientState
argsContextSt=ClientState
st, argsContextFocus :: Focus
argsContextFocus=Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
clientFocus ClientState
st}

-- | A command is a list of aliases, an argument specification, implementation,
-- and documentation. The arguments and implementation must match so that
-- the parsed arguments will match what the implementation expects.
data Command = forall a. Command
  { -- | Names of this command, first in the list is the "primary" name
    Command -> NonEmpty Text
cmdNames          :: NonEmpty Text
  -- | Specification of the arguments of the command
  , ()
cmdArgumentSpec   :: Args ArgsContext a
  -- | Multi-line IRC-formatted documentation text used for @/help@
  , Command -> Text
cmdDocumentation  :: Text
  -- | Implementation of the command for both execution and tab completion
  , ()
cmdImplementation :: CommandImpl a
  }

-- | A command section is a logical grouping of commands. This allows for
-- showing more structure in the help menu system.
data CommandSection = CommandSection
  { CommandSection -> Text
cmdSectionName :: Text
  , CommandSection -> [Command]
cmdSectionCmds :: [Command]
  }

-- | Consider the text entry successful and resume the client
commandSuccess :: Monad m => ClientState -> m CommandResult
commandSuccess :: forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess = CommandResult -> m CommandResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandResult -> m CommandResult)
-> (ClientState -> CommandResult) -> ClientState -> m CommandResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientState -> CommandResult
CommandSuccess

-- | Consider the text entry successful, and resume the client with
-- a particular network updated.
commandSuccessUpdateCS :: NetworkState -> ClientState -> IO CommandResult
commandSuccessUpdateCS :: NetworkState -> ClientState -> IO CommandResult
commandSuccessUpdateCS NetworkState
cs ClientState
st =
  do let network :: Text
network = Getting Text NetworkState Text -> NetworkState -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text NetworkState Text
Lens' NetworkState Text
csNetwork NetworkState
cs
     ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess
       (ClientState -> IO CommandResult)
-> ClientState -> IO CommandResult
forall a b. (a -> b) -> a -> b
$ ASetter ClientState ClientState NetworkState NetworkState
-> NetworkState -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
setStrict (Text -> ASetter ClientState ClientState NetworkState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network) NetworkState
cs ClientState
st

-- | Consider the text entry a failure and resume the client
commandFailure :: Monad m => ClientState -> m CommandResult
commandFailure :: forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandFailure = CommandResult -> m CommandResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandResult -> m CommandResult)
-> (ClientState -> CommandResult) -> ClientState -> m CommandResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientState -> CommandResult
CommandFailure

-- | Command failure with an error message printed to client window
commandFailureMsg :: Text -> ClientState -> IO CommandResult
commandFailureMsg :: Text -> ClientState -> IO CommandResult
commandFailureMsg Text
e ClientState
st =
  CommandResult -> IO CommandResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandResult -> IO CommandResult)
-> CommandResult -> IO CommandResult
forall a b. (a -> b) -> a -> b
$! ClientState -> CommandResult
CommandFailure (ClientState -> CommandResult) -> ClientState -> CommandResult
forall a b. (a -> b) -> a -> b
$! ASetter ClientState ClientState (Maybe Text) (Maybe Text)
-> Maybe Text -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState (Maybe Text) (Maybe Text)
Lens' ClientState (Maybe Text)
clientErrorMsg (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
e) ClientState
st