{-|
Module      : KMonad.Args.Types
Description : The basic types of configuration parsing.
Copyright   : (c) David Janssen, 2019
License     : MIT

Maintainer  : janssen.dhj@gmail.com
Stability   : experimental
Portability : non-portable (MPTC with FD, FFI to Linux-only c-code)

-}
module KMonad.Args.Types
  (
    -- * $cfg
    CfgToken(..)

    -- * $but
  , DefButton(..)

    -- * $tls
  , DefSetting(..)
  , DefSettings
  , DefAlias
  , DefLayer(..)
  , DefSrc
  , KExpr(..)

    -- * $defio
  , IToken(..)
  , OToken(..)

    -- * $lenses
  , AsKExpr(..)
  , AsDefSetting(..)
) where


import KMonad.Prelude

import KMonad.Model.Button
import KMonad.Keyboard
import KMonad.Keyboard.IO
import KMonad.Util

--------------------------------------------------------------------------------
-- $but
--
-- Tokens representing different types of buttons

-- FIXME: This is really broken: why are there 2 lists of 'DefButton's? There is
-- one here, and one in Parser/Types.hs

-- | Button ADT
data DefButton
  = KRef Text                              -- ^ Reference a named button
  | KEmit Keycode                          -- ^ Emit a keycode
  | KPressOnly Keycode                     -- ^ Emit only the press of a keycode
  | KReleaseOnly Keycode                   -- ^ Emit only the release of a keycode
  | KLayerToggle Text                      -- ^ Toggle to a layer when held
  | KLayerSwitch Text                      -- ^ Switch base-layer when pressed
  | KLayerAdd Text                         -- ^ Add a layer when pressed
  | KLayerRem Text                         -- ^ Remove top instance of a layer when pressed
  | KTapNext DefButton DefButton           -- ^ Do 2 things based on behavior
  | KTapHold Int DefButton DefButton       -- ^ Do 2 things based on behavior and delay
  | KTapHoldNext Int DefButton DefButton (Maybe DefButton)
    -- ^ Mixture between KTapNext and KTapHold
  | KTapNextRelease DefButton DefButton    -- ^ Do 2 things based on behavior
  | KTapHoldNextRelease Int DefButton DefButton (Maybe DefButton)
    -- ^ Like KTapNextRelease but with a timeout
  | KTapNextPress DefButton DefButton      -- ^ Like KTapNextRelease but also hold on presses
  | KAroundNext DefButton                  -- ^ Surround a future button
  | KAroundNextSingle DefButton            -- ^ Surround a future button
  | KMultiTap [(Int, DefButton)] DefButton -- ^ Do things depending on tap-count
  | KAround DefButton DefButton            -- ^ Wrap 1 button around another
  | KAroundNextTimeout Int DefButton DefButton
  | KTapMacro [DefButton] (Maybe Int)
    -- ^ Sequence of buttons to tap, possible delay between each press
  | KTapMacroRelease [DefButton] (Maybe Int)
    -- ^ Sequence of buttons to tap, tap last on release, possible delay between each press
  | KComposeSeq [DefButton]                -- ^ Compose-key sequence
  | KPause Milliseconds                    -- ^ Pause for a period of time
  | KLayerDelay Int LayerTag               -- ^ Switch to a layer for a period of time
  | KLayerNext LayerTag                    -- ^ Perform next button in different layer
  | KCommand Text (Maybe Text)             -- ^ Execute a shell command on press, as well
                                           --   as possibly on release
  | KStickyKey Int DefButton               -- ^ Act as if a button is pressed for a period of time
  | KBeforeAfterNext DefButton DefButton   -- ^ Surround a future button in a before and after tap
  | KTrans                                 -- ^ Transparent button that does nothing
  | KBlock                                 -- ^ Button that catches event
  deriving Int -> DefButton -> ShowS
[DefButton] -> ShowS
DefButton -> String
(Int -> DefButton -> ShowS)
-> (DefButton -> String)
-> ([DefButton] -> ShowS)
-> Show DefButton
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DefButton -> ShowS
showsPrec :: Int -> DefButton -> ShowS
$cshow :: DefButton -> String
show :: DefButton -> String
$cshowList :: [DefButton] -> ShowS
showList :: [DefButton] -> ShowS
Show


--------------------------------------------------------------------------------
-- $cfg
--
-- The Cfg token that can be extracted from a config-text without ever enterring
-- IO. This will then directly be translated to a DaemonCfg
--

-- | The 'CfgToken' contains all the data needed to construct an
-- 'KMonad.App.AppCfg'.
data CfgToken = CfgToken
  { CfgToken -> LogFunc -> IO (Acquire KeySource)
_src   :: LogFunc -> IO (Acquire KeySource) -- ^ How to grab the source keyboard
  , CfgToken -> LogFunc -> IO (Acquire KeySink)
_snk   :: LogFunc -> IO (Acquire KeySink)   -- ^ How to construct the out keybboard
  , CfgToken -> LMap Button
_km    :: LMap Button                       -- ^ An 'LMap' of 'Button' actions
  , CfgToken -> Text
_fstL  :: LayerTag                          -- ^ Name of initial layer
  , CfgToken -> Bool
_flt   :: Bool                              -- ^ How to deal with unhandled events
  , CfgToken -> Bool
_allow :: Bool                              -- ^ Whether to allow shell commands
  }
makeClassy ''CfgToken


--------------------------------------------------------------------------------
-- $tls
--
-- A collection of all the different top-level statements possible in a config
-- file.

-- | A list of keycodes describing the ordering of all the other layers
type DefSrc = [Keycode]

-- | A mapping from names to button tokens
type DefAlias = [(Text, DefButton)]

-- | A layer of buttons
data DefLayer = DefLayer
  { DefLayer -> Text
_layerName :: Text        -- ^ A unique name used to refer to this layer
  , DefLayer -> [DefButton]
_buttons   :: [DefButton] -- ^ A list of button tokens
  }
  deriving Int -> DefLayer -> ShowS
[DefLayer] -> ShowS
DefLayer -> String
(Int -> DefLayer -> ShowS)
-> (DefLayer -> String) -> ([DefLayer] -> ShowS) -> Show DefLayer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DefLayer -> ShowS
showsPrec :: Int -> DefLayer -> ShowS
$cshow :: DefLayer -> String
show :: DefLayer -> String
$cshowList :: [DefLayer] -> ShowS
showList :: [DefLayer] -> ShowS
Show


--------------------------------------------------------------------------------
-- $defcfg
--
-- Different settings

-- | All different input-tokens KMonad can take
data IToken
  = KDeviceSource FilePath
  | KLowLevelHookSource
  | KIOKitSource (Maybe Text)
  deriving Int -> IToken -> ShowS
[IToken] -> ShowS
IToken -> String
(Int -> IToken -> ShowS)
-> (IToken -> String) -> ([IToken] -> ShowS) -> Show IToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IToken -> ShowS
showsPrec :: Int -> IToken -> ShowS
$cshow :: IToken -> String
show :: IToken -> String
$cshowList :: [IToken] -> ShowS
showList :: [IToken] -> ShowS
Show

-- | All different output-tokens KMonad can take
data OToken
  = KUinputSink Text (Maybe Text)
  | KSendEventSink (Maybe (Int, Int))
  | KKextSink
  deriving Int -> OToken -> ShowS
[OToken] -> ShowS
OToken -> String
(Int -> OToken -> ShowS)
-> (OToken -> String) -> ([OToken] -> ShowS) -> Show OToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OToken -> ShowS
showsPrec :: Int -> OToken -> ShowS
$cshow :: OToken -> String
show :: OToken -> String
$cshowList :: [OToken] -> ShowS
showList :: [OToken] -> ShowS
Show

-- | All possible single settings
data DefSetting
  = SIToken      IToken
  | SOToken      OToken
  | SCmpSeq      DefButton
  | SInitStr     Text
  | SFallThrough Bool
  | SAllowCmd    Bool
  | SCmpSeqDelay Int
  deriving Int -> DefSetting -> ShowS
[DefSetting] -> ShowS
DefSetting -> String
(Int -> DefSetting -> ShowS)
-> (DefSetting -> String)
-> ([DefSetting] -> ShowS)
-> Show DefSetting
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DefSetting -> ShowS
showsPrec :: Int -> DefSetting -> ShowS
$cshow :: DefSetting -> String
show :: DefSetting -> String
$cshowList :: [DefSetting] -> ShowS
showList :: [DefSetting] -> ShowS
Show
makeClassyPrisms ''DefSetting

-- | 'Eq' instance for a 'DefSetting'. Because every one of these options may be
-- given at most once, we only need to check the outermost constructor in order
-- to test for equality
instance Eq DefSetting where
  SIToken{}      == :: DefSetting -> DefSetting -> Bool
== SIToken{}      = Bool
True
  SOToken{}      == SOToken{}      = Bool
True
  SCmpSeq{}      == SCmpSeq{}      = Bool
True
  SInitStr{}     == SInitStr{}     = Bool
True
  SFallThrough{} == SFallThrough{} = Bool
True
  SAllowCmd{}    == SAllowCmd{}    = Bool
True
  DefSetting
_              == DefSetting
_              = Bool
False

-- | A list of different 'DefSetting' values
type DefSettings = [DefSetting]

--------------------------------------------------------------------------------
-- $tkn

-- | Any statement in a config-file must parse to a 'KExpr'
data KExpr
  = KDefCfg   DefSettings
  | KDefSrc   DefSrc
  | KDefLayer DefLayer
  | KDefAlias DefAlias
  deriving Int -> KExpr -> ShowS
[KExpr] -> ShowS
KExpr -> String
(Int -> KExpr -> ShowS)
-> (KExpr -> String) -> ([KExpr] -> ShowS) -> Show KExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KExpr -> ShowS
showsPrec :: Int -> KExpr -> ShowS
$cshow :: KExpr -> String
show :: KExpr -> String
$cshowList :: [KExpr] -> ShowS
showList :: [KExpr] -> ShowS
Show
makeClassyPrisms ''KExpr


--------------------------------------------------------------------------------
-- $act