{-|
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
  ( -- * $bsc
    Parser
  , PErrors(..)

    -- * $cfg
  , CfgToken(..)

    -- * $but
  , DefButton(..)

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

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

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

    -- * Reexports
  , module Text.Megaparsec
  , module Text.Megaparsec.Char
) where


import KMonad.Prelude

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

import Text.Megaparsec
import Text.Megaparsec.Char

--------------------------------------------------------------------------------
-- $bsc
--
-- The basic types of parsing

-- | Parser's operate on Text and carry no state
type Parser = Parsec Void Text

-- | The type of errors returned by the Megaparsec parsers
newtype PErrors = PErrors (ParseErrorBundle Text Void)

instance Show PErrors where
  show :: PErrors -> String
show (PErrors e :: ParseErrorBundle Text Void
e) = "Parse error at " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ParseErrorBundle Text Void -> String
forall s e.
(Stream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text Void
e

instance Exception PErrors

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

-- | Button ADT
data DefButton
  = KRef Text                              -- ^ Reference a named button
  | KEmit Keycode                          -- ^ Emit 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   -- ^ Mixture between KTapNext and KTapHold
  | KTapNextRelease DefButton DefButton    -- ^ Do 2 things based on behavior
  | KTapHoldNextRelease Int DefButton DefButton
    -- ^ Like KTapNextRelease but with a timeout
  | KAroundNext DefButton                  -- ^ Surround a future button
  | KMultiTap [(Int, DefButton)] DefButton -- ^ Do things depending on tap-count
  | KAround DefButton DefButton            -- ^ Wrap 1 button around another
  | KTapMacro [DefButton]                  -- ^ Sequence of buttons to tap
  | 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                          -- ^ Execute a shell command
  | 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
showList :: [DefButton] -> ShowS
$cshowList :: [DefButton] -> ShowS
show :: DefButton -> String
$cshow :: DefButton -> String
showsPrec :: Int -> DefButton -> ShowS
$cshowsPrec :: Int -> 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
showList :: [DefLayer] -> ShowS
$cshowList :: [DefLayer] -> ShowS
show :: DefLayer -> String
$cshow :: DefLayer -> String
showsPrec :: Int -> DefLayer -> ShowS
$cshowsPrec :: Int -> 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
showList :: [IToken] -> ShowS
$cshowList :: [IToken] -> ShowS
show :: IToken -> String
$cshow :: IToken -> String
showsPrec :: Int -> IToken -> ShowS
$cshowsPrec :: Int -> IToken -> ShowS
Show

-- | All different output-tokens KMonad can take
data OToken
  = KUinputSink Text (Maybe Text)
  | KSendEventSink
  | 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
showList :: [OToken] -> ShowS
$cshowList :: [OToken] -> ShowS
show :: OToken -> String
$cshow :: OToken -> String
showsPrec :: Int -> OToken -> ShowS
$cshowsPrec :: Int -> OToken -> ShowS
Show

-- | All possible single settings
data DefSetting
  = SIToken      IToken
  | SOToken      OToken
  | SCmpSeq      DefButton
  | SInitStr     Text
  | SFallThrough Bool
  | SAllowCmd    Bool
  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
showList :: [DefSetting] -> ShowS
$cshowList :: [DefSetting] -> ShowS
show :: DefSetting -> String
$cshow :: DefSetting -> String
showsPrec :: Int -> DefSetting -> ShowS
$cshowsPrec :: Int -> DefSetting -> ShowS
Show
makeClassyPrisms ''DefSetting

-- | 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
showList :: [KExpr] -> ShowS
$cshowList :: [KExpr] -> ShowS
show :: KExpr -> String
$cshow :: KExpr -> String
showsPrec :: Int -> KExpr -> ShowS
$cshowsPrec :: Int -> KExpr -> ShowS
Show
makeClassyPrisms ''KExpr


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