{-# Language OverloadedStrings, TemplateHaskell #-}
{-|
Module      : Client.Commands.Toggles
Description : View modality command implementations
Copyright   : (c) Eric Mertens, 2016-2020
License     : ISC
Maintainer  : emertens@gmail.com
-}

module Client.Commands.Toggles (togglesCommands) where

import Client.Commands.Docs (togglesDocs, cmdDoc)
import Client.Commands.TabCompletion (noClientTab)
import Client.Commands.Types
import Client.Configuration (EditMode(SingleLineEditor, MultiLineEditor), LayoutMode(OneColumn, TwoColumn))
import Client.State
import Control.Lens (over, set)

togglesCommands :: CommandSection
togglesCommands :: CommandSection
togglesCommands = Text -> [Command] -> CommandSection
CommandSection Text
"View toggles"

  [ forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"toggle-detail")
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      $(togglesDocs `cmdDoc` "toggle-detail")
    forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand ()
cmdToggleDetail Bool -> ClientCommand String
noClientTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"toggle-activity-bar")
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      $(togglesDocs `cmdDoc` "toggle-activity-bar")
    forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand ()
cmdToggleActivityBar Bool -> ClientCommand String
noClientTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"toggle-show-ping")
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      $(togglesDocs `cmdDoc` "toggle-show-ping")
    forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand ()
cmdToggleShowPing Bool -> ClientCommand String
noClientTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"toggle-metadata")
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      $(togglesDocs `cmdDoc` "toggle-metadata")
    forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand ()
cmdToggleMetadata Bool -> ClientCommand String
noClientTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"toggle-layout")
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      $(togglesDocs `cmdDoc` "toggle-layout")
    forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand ()
cmdToggleLayout Bool -> ClientCommand String
noClientTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"toggle-editor")
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      $(togglesDocs `cmdDoc` "toggle-editor")
    forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand ()
cmdToggleEditor Bool -> ClientCommand String
noClientTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"toggle-edit-lock")
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      $(togglesDocs `cmdDoc` "toggle-edit-lock")
    forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand ()
cmdToggleEditLock Bool -> ClientCommand String
noClientTab
  ]

cmdToggleDetail :: ClientCommand ()
cmdToggleDetail :: ClientCommand ()
cmdToggleDetail ClientState
st ()
_ = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ClientState Bool
clientDetailView Bool -> Bool
not ClientState
st)

cmdToggleActivityBar :: ClientCommand ()
cmdToggleActivityBar :: ClientCommand ()
cmdToggleActivityBar ClientState
st ()
_ = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ClientState Bool
clientActivityBar Bool -> Bool
not ClientState
st)

cmdToggleShowPing :: ClientCommand ()
cmdToggleShowPing :: ClientCommand ()
cmdToggleShowPing ClientState
st ()
_ = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ClientState Bool
clientShowPing Bool -> Bool
not ClientState
st)

cmdToggleMetadata :: ClientCommand ()
cmdToggleMetadata :: ClientCommand ()
cmdToggleMetadata ClientState
st ()
_ = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (ClientState -> ClientState
clientToggleHideMeta ClientState
st)

cmdToggleLayout :: ClientCommand ()
cmdToggleLayout :: ClientCommand ()
cmdToggleLayout ClientState
st ()
_ = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' ClientState Int
clientScroll Int
0 (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ClientState LayoutMode
clientLayout LayoutMode -> LayoutMode
aux ClientState
st))
  where
    aux :: LayoutMode -> LayoutMode
aux LayoutMode
OneColumn = LayoutMode
TwoColumn
    aux LayoutMode
TwoColumn = LayoutMode
OneColumn

cmdToggleEditor :: ClientCommand ()
cmdToggleEditor :: ClientCommand ()
cmdToggleEditor ClientState
st ()
_ = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ClientState EditMode
clientEditMode EditMode -> EditMode
aux ClientState
st)
  where
    aux :: EditMode -> EditMode
aux EditMode
SingleLineEditor = EditMode
MultiLineEditor
    aux EditMode
MultiLineEditor = EditMode
SingleLineEditor

cmdToggleEditLock :: ClientCommand ()
cmdToggleEditLock :: ClientCommand ()
cmdToggleEditLock ClientState
st ()
_ = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ClientState Bool
clientEditLock Bool -> Bool
not ClientState
st)