{-|
Module      : KMonad.Keyboard.IO.Linux.Types
Description : The types particular to Linux key IO
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.Keyboard.IO.Linux.Types
  ( -- * The LinuxKeyEvent datatype, its constructors, and instances
    -- $types
    LinuxKeyEvent(..)
  , linuxKeyEvent
  , sync

    -- * Casting between 'KeyEvent' and 'LinuxKeyEvent'
    -- $linuxev
  , toLinuxKeyEvent
  , fromLinuxKeyEvent

    -- * Reexport common modules
  , module KMonad.Keyboard
  , module KMonad.Keyboard.IO
  )
where

import KMonad.Prelude

import Data.Time.Clock.System
import Foreign.C.Types (CInt)
import RIO.Partial (toEnum)

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


--------------------------------------------------------------------------------
-- $helper

fi :: Integral a => a -> CInt
fi :: a -> CInt
fi = a -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

--------------------------------------------------------------------------------
-- $types
--
-- Linux produces a stream of binary data representing all its input events
-- through the \/dev\/input files. Each event is represented by 5 numbers:
-- seconds, microseconds, event-type, event-code, and event-value. For more
-- explanation look at: https://www.kernel.org/doc/Documentation/input/input.txt

-- | The LinuxKeyEvent datatype
newtype LinuxKeyEvent = LinuxKeyEvent (CInt, CInt, CInt, CInt, CInt)
  deriving Int -> LinuxKeyEvent -> ShowS
[LinuxKeyEvent] -> ShowS
LinuxKeyEvent -> String
(Int -> LinuxKeyEvent -> ShowS)
-> (LinuxKeyEvent -> String)
-> ([LinuxKeyEvent] -> ShowS)
-> Show LinuxKeyEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LinuxKeyEvent] -> ShowS
$cshowList :: [LinuxKeyEvent] -> ShowS
show :: LinuxKeyEvent -> String
$cshow :: LinuxKeyEvent -> String
showsPrec :: Int -> LinuxKeyEvent -> ShowS
$cshowsPrec :: Int -> LinuxKeyEvent -> ShowS
Show

instance Display LinuxKeyEvent where
  textDisplay :: LinuxKeyEvent -> Text
textDisplay (LinuxKeyEvent (s :: CInt
s, ns :: CInt
ns, typ :: CInt
typ, c :: CInt
c, val :: CInt
val)) = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
         [ CInt -> Text
forall a. Show a => a -> Text
tshow CInt
s, ".", CInt -> Text
forall a. Show a => a -> Text
tshow CInt
ns, ": "
         , "type: ", CInt -> Text
forall a. Show a => a -> Text
tshow CInt
typ, ",  "
         , "code: ", CInt -> Text
forall a. Show a => a -> Text
tshow CInt
c,   ",  "
         , "val: ",  CInt -> Text
forall a. Show a => a -> Text
tshow CInt
val
         ]

-- | A smart constructor that casts from any integral
linuxKeyEvent
  :: (Integral a, Integral b, Integral c, Integral d, Integral e)
  => (a, b, c, d, e) -- ^ The tuple representing the event
  -> LinuxKeyEvent   -- ^ The LinuxKeyEvent
linuxKeyEvent :: (a, b, c, d, e) -> LinuxKeyEvent
linuxKeyEvent (a :: a
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e) = (CInt, CInt, CInt, CInt, CInt) -> LinuxKeyEvent
LinuxKeyEvent (a -> CInt
forall a. Integral a => a -> CInt
f a
a, b -> CInt
forall a. Integral a => a -> CInt
f b
b, c -> CInt
forall a. Integral a => a -> CInt
f c
c, d -> CInt
forall a. Integral a => a -> CInt
f d
d, e -> CInt
forall a. Integral a => a -> CInt
f e
e)
  where
    f :: Integral a => a -> CInt
    f :: a -> CInt
f = a -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Constructor for linux sync events. Whenever you write an event to linux,
-- you need to emit a 'sync' to signal to linux that it should sync all queued
-- updates.
sync :: SystemTime -> LinuxKeyEvent
sync :: SystemTime -> LinuxKeyEvent
sync (MkSystemTime s :: Int64
s ns :: Word32
ns) = (CInt, CInt, CInt, CInt, CInt) -> LinuxKeyEvent
LinuxKeyEvent (Int64 -> CInt
forall a. Integral a => a -> CInt
fi Int64
s, Word32 -> CInt
forall a. Integral a => a -> CInt
fi Word32
ns, 0, 0, 0)


-------------------------------------------------------------------------------
-- $linuxev
--
-- We only represent a subset of all the possible input events produced by
-- Linux. First of all, we disregard all event types that are not key events, so
-- we quietly ignore all sync and scan events. There other other events that are
-- there to do things like toggle LEDs on your keyboard that we also ignore.
--
-- Furthermore, within the category of KeyEvents, we only register presses and
-- releases, and completely ignore repeat events.
--
-- The correspondence between LinuxKeyEvents and core KeyEvents can best be read
-- in the above-mentioned documentation, but the quick version is this:
--   Typ:  1 = KeyEvent            (see below)
--         4 = @scancode@ event    (we neither read nor write)
--         0 = 'sync' event        (we don't read, but do generate for writing)
--   Val:  for keys: 0 = Release, 1 = Press, 2 = Repeat
--         for sync: always 0
--   Code: for keys: an Int value corresponding to a keycode
--           see: https://github.com/torvalds/linux/blob/master/include/uapi/linux/input-event-codes.h
--         for sync: always 0

-- | Translate a 'LinuxKeyEvent' to a kmonad 'KeyEvent'
fromLinuxKeyEvent :: LinuxKeyEvent -> Maybe KeyEvent
fromLinuxKeyEvent :: LinuxKeyEvent -> Maybe KeyEvent
fromLinuxKeyEvent (LinuxKeyEvent (_, _, typ :: CInt
typ, c :: CInt
c, val :: CInt
val))
  | CInt
typ CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Bool -> Bool -> Bool
&& CInt
val CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = KeyEvent -> Maybe KeyEvent
forall a. a -> Maybe a
Just (KeyEvent -> Maybe KeyEvent)
-> (Keycode -> KeyEvent) -> Keycode -> Maybe KeyEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Keycode -> KeyEvent
mkRelease (Keycode -> Maybe KeyEvent) -> Keycode -> Maybe KeyEvent
forall a b. (a -> b) -> a -> b
$ Keycode
kc
  | CInt
typ CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Bool -> Bool -> Bool
&& CInt
val CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = KeyEvent -> Maybe KeyEvent
forall a. a -> Maybe a
Just (KeyEvent -> Maybe KeyEvent)
-> (Keycode -> KeyEvent) -> Keycode -> Maybe KeyEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Keycode -> KeyEvent
mkPress   (Keycode -> Maybe KeyEvent) -> Keycode -> Maybe KeyEvent
forall a b. (a -> b) -> a -> b
$ Keycode
kc
  | Bool
otherwise = Maybe KeyEvent
forall a. Maybe a
Nothing
  where
    kc :: Keycode
kc = Int -> Keycode
forall a. Enum a => Int -> a
toEnum (Int -> Keycode) -> (CInt -> Int) -> CInt -> Keycode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Keycode) -> CInt -> Keycode
forall a b. (a -> b) -> a -> b
$ CInt
c -- This is theoretically partial, but practically not

-- | Translate kmonad 'KeyEvent' along with a 'SystemTime' to 'LinuxKeyEvent's
-- for writing.
toLinuxKeyEvent :: KeyEvent -> SystemTime -> LinuxKeyEvent
toLinuxKeyEvent :: KeyEvent -> SystemTime -> LinuxKeyEvent
toLinuxKeyEvent e :: KeyEvent
e (MkSystemTime s :: Int64
s ns :: Word32
ns)
  = (CInt, CInt, CInt, CInt, CInt) -> LinuxKeyEvent
LinuxKeyEvent (Int64 -> CInt
forall a. Integral a => a -> CInt
fi Int64
s, Word32 -> CInt
forall a. Integral a => a -> CInt
fi Word32
ns, 1, CInt
c, CInt
val)
  where
    c :: CInt
c   = Int -> CInt
forall a. Integral a => a -> CInt
fi (Int -> CInt) -> (Keycode -> Int) -> Keycode -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Keycode -> Int
forall a. Enum a => a -> Int
fromEnum (Keycode -> CInt) -> Keycode -> CInt
forall a b. (a -> b) -> a -> b
$ KeyEvent
eKeyEvent -> Getting Keycode KeyEvent Keycode -> Keycode
forall s a. s -> Getting a s a -> a
^.Getting Keycode KeyEvent Keycode
Lens' KeyEvent Keycode
keycode
    val :: CInt
val = if (KeyEvent
eKeyEvent -> Getting Switch KeyEvent Switch -> Switch
forall s a. s -> Getting a s a -> a
^.Getting Switch KeyEvent Switch
Lens' KeyEvent Switch
switch Switch -> Switch -> Bool
forall a. Eq a => a -> a -> Bool
== Switch
Press) then 1 else 0