content: {-# Language OverloadedStrings, TemplateHaskell #-}
  {-|
  Module      : Client.Commands.Connection
  Description : Connection command implementations
  Copyright   : (c) Eric Mertens, 2016-2020
  License     : ISC
  Maintainer  : emertens@gmail.com
  -}
  
  module Client.Commands.Connection (connectionCommands) where
  
  import Client.Commands.Arguments.Spec ( remainingArg, simpleToken )
  import Client.Commands.Docs (netDocs, cmdDoc)
  import Client.Commands.TabCompletion
  import Client.Commands.Types
  import Client.Commands.WordCompletion ( plainWordCompleteMode )
  import Client.Configuration ( configServers )
  import Client.State
  import Client.State.Focus (focusNetwork, Focus(NetworkFocus), Subfocus(FocusCert))
  import Client.State.Network (csLastReceived, csNetwork, csNick, sendMsg)
  import Control.Lens (view, folded, preview, views)
  import Data.HashMap.Strict qualified as HashMap
  import Data.Text qualified as Text
  import Irc.Commands (ircMode, ircQuit)
  
  connectionCommands :: CommandSection
  connectionCommands = CommandSection "Connection commands"
  
    [ Command
        (pure "connect")
        (simpleToken "network")
        $(netDocs `cmdDoc` "connect")
      $ ClientCommand cmdConnect tabConnect
  
    , Command
        (pure "reconnect")
        (pure ())
        $(netDocs `cmdDoc` "reconnect")
      $ ClientCommand cmdReconnect noClientTab
  
    , Command
        (pure "disconnect")
        (pure ())
        $(netDocs `cmdDoc` "disconnect")
      $ NetworkCommand cmdDisconnect noNetworkTab
  
    , Command
        (pure "quit")
        (remainingArg "reason")
        $(netDocs `cmdDoc` "quit")
      $ NetworkCommand cmdQuit simpleNetworkTab
  
    , Command
        (pure "cert")
        (pure ())
        $(netDocs `cmdDoc` "cert")
      $ NetworkCommand cmdCert noNetworkTab
  
    , Command
        (pure "umode")
        (remainingArg "modes")
        $(netDocs `cmdDoc` "umode")
      $ NetworkCommand cmdUmode noNetworkTab
    ]
  
  cmdUmode :: NetworkCommand String
  cmdUmode cs st rest =
    do let args = Text.words (Text.pack rest)
       sendMsg cs (ircMode (view csNick cs) args)
       commandSuccess st
  
  cmdConnect :: ClientCommand String
  cmdConnect st networkStr =
    do -- abort any existing connection before connecting
       let network = Text.pack networkStr
       st' <- addConnection 0 Nothing Nothing network =<< abortNetwork network st
       commandSuccess
         $ changeFocus (NetworkFocus network) st'
  
  cmdQuit :: NetworkCommand String
  cmdQuit cs st rest =
    do let msg = Text.pack rest
       sendMsg cs (ircQuit msg)
       commandSuccess st
  
  cmdDisconnect :: NetworkCommand ()
  cmdDisconnect cs st _ =
    do st' <- abortNetwork (view csNetwork cs) st
       commandSuccess st'
  
  -- | Reconnect to the currently focused network. It's possible
  -- that we're not currently connected to a network, so
  -- this is implemented as a client command.
  cmdReconnect :: ClientCommand ()
  cmdReconnect st _
    | Just network <- views clientFocus focusNetwork st =
  
        do let tm = preview (clientConnection network . csLastReceived . folded) st
           st' <- addConnection 0 tm Nothing network =<< abortNetwork network st
           commandSuccess
             $ changeFocus (NetworkFocus network) st'
  
    | otherwise = commandFailureMsg "command requires focused network" st
  
  -- | @/connect@ tab completes known server names
  tabConnect :: Bool -> ClientCommand String
  tabConnect isReversed st _ =
    simpleTabCompletion plainWordCompleteMode [] networks isReversed st
    where
      networks = views clientConnections              HashMap.keys st
              ++ views (clientConfig . configServers) HashMap.keys st
  
  cmdCert :: NetworkCommand ()
  cmdCert _ st _ = commandSuccess (changeSubfocus FocusCert st)
  