{-# LANGUAGE DataKinds     #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE LambdaCase    #-}
module Device.Nintendo.Switch.Input where

-- attoparsec

import Data.Attoparsec.ByteString (IResult(Done), Parser, anyWord8, parse, take, word8)

-- base

import Control.Applicative ((<|>))
import Control.Exception   (Exception, throwIO)
import Data.Bits           ((.&.), (.|.), shiftL, shiftR)
import Data.IORef          (IORef)
import Data.Int            (Int16)
import Data.List           (intercalate)
import Data.Word           (Word8, Word16, Word32)
import Numeric             (showHex)
import Prelude      hiding (Left, Right, read, take)

-- bytestring

import qualified Data.ByteString as BS

-- hidapi

import System.HIDAPI (Device, read, readTimeout)

-- switch

import Device.Nintendo.Switch.Controller
import Device.Nintendo.Switch.Output     (requestRawSPI)
import Device.Nintendo.Switch.Utils      (checkMask, clamp, tripleMap, tripleParser, tripleZipWith)

-- | A constraint which indicates that a Nintendo Switch controller can provide

-- t'Input' (see 'getInput').

class HasInput t where
  convert :: Controller t -> RawInput -> Input

instance HasInput 'LeftJoyCon where
  convert :: Controller 'LeftJoyCon -> RawInput -> Input
convert Controller 'LeftJoyCon
controller RawInput
raw =
    ControllerInput Float Any
forall s e. ControllerInput s e
noInput
      { btnL :: Bool
btnL         = RawInput -> Bool
forall s e. ControllerInput s e -> Bool
btnL RawInput
raw
      , btnZL :: Bool
btnZL        = RawInput -> Bool
forall s e. ControllerInput s e -> Bool
btnZL RawInput
raw
      , btnMinus :: Bool
btnMinus     = RawInput -> Bool
forall s e. ControllerInput s e -> Bool
btnMinus RawInput
raw
      , btnLeftStick :: Bool
btnLeftStick = RawInput -> Bool
forall s e. ControllerInput s e -> Bool
btnLeftStick RawInput
raw
      , btnUp :: Bool
btnUp        = RawInput -> Bool
forall s e. ControllerInput s e -> Bool
btnUp RawInput
raw
      , btnLeft :: Bool
btnLeft      = RawInput -> Bool
forall s e. ControllerInput s e -> Bool
btnLeft RawInput
raw
      , btnRight :: Bool
btnRight     = RawInput -> Bool
forall s e. ControllerInput s e -> Bool
btnRight RawInput
raw
      , btnDown :: Bool
btnDown      = RawInput -> Bool
forall s e. ControllerInput s e -> Bool
btnDown RawInput
raw
      , btnCapture :: Bool
btnCapture   = RawInput -> Bool
forall s e. ControllerInput s e -> Bool
btnCapture RawInput
raw
      , btnLeftSL :: Bool
btnLeftSL    = RawInput -> Bool
forall s e. ControllerInput s e -> Bool
btnLeftSL RawInput
raw
      , btnLeftSR :: Bool
btnLeftSR    = RawInput -> Bool
forall s e. ControllerInput s e -> Bool
btnLeftSR RawInput
raw
      , stickLeft :: StickDirection Float
stickLeft    = StickDirection Word16 -> StickCalibration -> StickDirection Float
adjustStick (RawInput -> StickDirection Word16
forall s e. ControllerInput s e -> StickDirection s
stickLeft RawInput
raw) (Calibration -> StickCalibration
leftStickCal Calibration
cal)
      , extras :: ExtraInput Float
extras       = ExtraInput Int16
-> (Float, Float, Float)
-> (Float, Float, Float)
-> ExtraInput Float
adjustSensor (RawInput -> ExtraInput Int16
forall s e. ControllerInput s e -> ExtraInput e
extras RawInput
raw) (Calibration -> (Float, Float, Float)
accCoeffs Calibration
cal) (Calibration -> (Float, Float, Float)
gyroCoeffs Calibration
cal)
      , battery :: Maybe BatteryInfo
battery      = RawInput -> Maybe BatteryInfo
forall s e. ControllerInput s e -> Maybe BatteryInfo
battery RawInput
raw
      }
    where
      cal :: Calibration
cal = Controller 'LeftJoyCon -> Calibration
forall (t :: ControllerType). Controller t -> Calibration
calibration Controller 'LeftJoyCon
controller

instance HasInput 'RightJoyCon where
  convert :: Controller 'RightJoyCon -> RawInput -> Input
convert Controller 'RightJoyCon
controller RawInput
raw =
    ControllerInput Float Any
forall s e. ControllerInput s e
noInput
      { btnR :: Bool
btnR          = RawInput -> Bool
forall s e. ControllerInput s e -> Bool
btnR RawInput
raw
      , btnZR :: Bool
btnZR         = RawInput -> Bool
forall s e. ControllerInput s e -> Bool
btnZR RawInput
raw
      , btnPlus :: Bool
btnPlus       = RawInput -> Bool
forall s e. ControllerInput s e -> Bool
btnPlus RawInput
raw
      , btnX :: Bool
btnX          = RawInput -> Bool
forall s e. ControllerInput s e -> Bool
btnX RawInput
raw
      , btnY :: Bool
btnY          = RawInput -> Bool
forall s e. ControllerInput s e -> Bool
btnY RawInput
raw
      , btnA :: Bool
btnA          = RawInput -> Bool
forall s e. ControllerInput s e -> Bool
btnA RawInput
raw
      , btnB :: Bool
btnB          = RawInput -> Bool
forall s e. ControllerInput s e -> Bool
btnB RawInput
raw
      , btnRightStick :: Bool
btnRightStick = RawInput -> Bool
forall s e. ControllerInput s e -> Bool
btnRightStick RawInput
raw
      , btnHome :: Bool
btnHome       = RawInput -> Bool
forall s e. ControllerInput s e -> Bool
btnHome RawInput
raw
      , btnRightSL :: Bool
btnRightSL    = RawInput -> Bool
forall s e. ControllerInput s e -> Bool
btnRightSL RawInput
raw
      , btnRightSR :: Bool
btnRightSR    = RawInput -> Bool
forall s e. ControllerInput s e -> Bool
btnRightSR RawInput
raw
      , stickRight :: StickDirection Float
stickRight    = StickDirection Word16 -> StickCalibration -> StickDirection Float
adjustStick (RawInput -> StickDirection Word16
forall s e. ControllerInput s e -> StickDirection s
stickRight RawInput
raw) (Calibration -> StickCalibration
rightStickCal Calibration
cal)
      , extras :: ExtraInput Float
extras        = ((Float, Float, Float) -> (Float, Float, Float))
-> ExtraInput Float -> ExtraInput Float
forall a. ((a, a, a) -> (a, a, a)) -> ExtraInput a -> ExtraInput a
extraMap
                          ( \(Float
x,Float
y,Float
z) -> (Float
x, -Float
y, -Float
z) ) -- compensate the reverse-installed IMU chip

                          ( ExtraInput Int16
-> (Float, Float, Float)
-> (Float, Float, Float)
-> ExtraInput Float
adjustSensor (RawInput -> ExtraInput Int16
forall s e. ControllerInput s e -> ExtraInput e
extras RawInput
raw) (Calibration -> (Float, Float, Float)
accCoeffs Calibration
cal) (Calibration -> (Float, Float, Float)
gyroCoeffs Calibration
cal) )
      , battery :: Maybe BatteryInfo
battery       = RawInput -> Maybe BatteryInfo
forall s e. ControllerInput s e -> Maybe BatteryInfo
battery RawInput
raw
      }
    where
      cal :: Calibration
cal = Controller 'RightJoyCon -> Calibration
forall (t :: ControllerType). Controller t -> Calibration
calibration Controller 'RightJoyCon
controller
      extraMap :: ((a, a, a) -> (a, a, a)) -> ExtraInput a -> ExtraInput a
extraMap (a, a, a) -> (a, a, a)
f = \case
        Inertial Accelerometer a
a Accelerometer a
g -> Accelerometer a -> Accelerometer a -> ExtraInput a
forall a. Accelerometer a -> Accelerometer a -> ExtraInput a
Inertial (((a, a, a) -> (a, a, a)) -> Accelerometer a -> Accelerometer a
forall a b. (a -> b) -> (a, a, a) -> (b, b, b)
tripleMap (a, a, a) -> (a, a, a)
f Accelerometer a
a) (((a, a, a) -> (a, a, a)) -> Accelerometer a -> Accelerometer a
forall a b. (a -> b) -> (a, a, a) -> (b, b, b)
tripleMap (a, a, a) -> (a, a, a)
f Accelerometer a
g)
        ExtraInput a
other        -> ExtraInput a
other
  
instance HasInput 'ProController where
  convert :: Controller 'ProController -> RawInput -> Input
convert Controller 'ProController
controller RawInput
raw =
    RawInput
raw
      { stickLeft :: StickDirection Float
stickLeft  = StickDirection Word16 -> StickCalibration -> StickDirection Float
adjustStick (RawInput -> StickDirection Word16
forall s e. ControllerInput s e -> StickDirection s
stickLeft RawInput
raw) (Calibration -> StickCalibration
leftStickCal Calibration
cal)
      , stickRight :: StickDirection Float
stickRight = StickDirection Word16 -> StickCalibration -> StickDirection Float
adjustStick (RawInput -> StickDirection Word16
forall s e. ControllerInput s e -> StickDirection s
stickRight RawInput
raw) (Calibration -> StickCalibration
rightStickCal Calibration
cal)
      , extras :: ExtraInput Float
extras     = ExtraInput Int16
-> (Float, Float, Float)
-> (Float, Float, Float)
-> ExtraInput Float
adjustSensor (RawInput -> ExtraInput Int16
forall s e. ControllerInput s e -> ExtraInput e
extras RawInput
raw) (Calibration -> (Float, Float, Float)
accCoeffs Calibration
cal) (Calibration -> (Float, Float, Float)
gyroCoeffs Calibration
cal)
      }
    where
      cal :: Calibration
cal = Controller 'ProController -> Calibration
forall (t :: ControllerType). Controller t -> Calibration
calibration Controller 'ProController
controller

-- | An 'InputException' is thrown if something goes wrong with 'getInput'.

data InputException
  = NoReplyException
    -- ^ Indicates that an expected reply wasn't received in a specific time interval.

  | UnknownFormatException BS.ByteString
    -- ^ Indicates that the controller input has an unexpected format. It essentially

    -- means that a specific part of the protocol has not been implemented yet. This

    -- should not occur as long as you stick to the public API of this library.

  deriving InputException -> InputException -> Bool
(InputException -> InputException -> Bool)
-> (InputException -> InputException -> Bool) -> Eq InputException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputException -> InputException -> Bool
$c/= :: InputException -> InputException -> Bool
== :: InputException -> InputException -> Bool
$c== :: InputException -> InputException -> Bool
Eq

instance Exception InputException
instance Show InputException where
  show :: InputException -> String
show = \case
    InputException
NoReplyException ->
      String
"Did not receive a reply in a given time interval."
    UnknownFormatException ByteString
bs ->
      String
"Encountered an unknown input format: "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Word8 -> String) -> [Word8] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word8 -> ShowS) -> String -> Word8 -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word8 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex String
"") (ByteString -> [Word8]
BS.unpack ByteString
bs))

-- | The input provided by a Nintendo Switch controller.

type Input = ControllerInput Float Float

type RawInput = ControllerInput Word16 Int16

-- | The input provided by a Nintendo Switch controller, where @s@ is the

-- numeric type of the analog stick direction and @e@ is the numeric type

-- of the sensor readings (i.e., accelerometer and gyroscope).

data ControllerInput s e =
  Input
    { -- left buttons

      ControllerInput s e -> Bool
btnL          :: Bool
    , ControllerInput s e -> Bool
btnZL         :: Bool
    , ControllerInput s e -> Bool
btnMinus      :: Bool
    , ControllerInput s e -> Bool
btnLeftStick  :: Bool
    , ControllerInput s e -> Bool
btnUp         :: Bool
    , ControllerInput s e -> Bool
btnLeft       :: Bool
    , ControllerInput s e -> Bool
btnRight      :: Bool
    , ControllerInput s e -> Bool
btnDown       :: Bool
    , ControllerInput s e -> Bool
btnCapture    :: Bool
    , ControllerInput s e -> Bool
btnLeftSL     :: Bool
    , ControllerInput s e -> Bool
btnLeftSR     :: Bool
      -- right buttons

    , ControllerInput s e -> Bool
btnR          :: Bool
    , ControllerInput s e -> Bool
btnZR         :: Bool
    , ControllerInput s e -> Bool
btnPlus       :: Bool
    , ControllerInput s e -> Bool
btnX          :: Bool
    , ControllerInput s e -> Bool
btnY          :: Bool
    , ControllerInput s e -> Bool
btnA          :: Bool
    , ControllerInput s e -> Bool
btnB          :: Bool
    , ControllerInput s e -> Bool
btnRightStick :: Bool
    , ControllerInput s e -> Bool
btnHome       :: Bool
    , ControllerInput s e -> Bool
btnRightSL    :: Bool
    , ControllerInput s e -> Bool
btnRightSR    :: Bool
      -- sticks

    , ControllerInput s e -> StickDirection s
stickLeft     :: StickDirection s
    , ControllerInput s e -> StickDirection s
stickRight    :: StickDirection s
      -- others

    , ControllerInput s e -> ExtraInput e
extras        :: ExtraInput e
    , ControllerInput s e -> Maybe BatteryInfo
battery       :: Maybe BatteryInfo
    }
  deriving (ControllerInput s e -> ControllerInput s e -> Bool
(ControllerInput s e -> ControllerInput s e -> Bool)
-> (ControllerInput s e -> ControllerInput s e -> Bool)
-> Eq (ControllerInput s e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall s e.
(Eq s, Eq e) =>
ControllerInput s e -> ControllerInput s e -> Bool
/= :: ControllerInput s e -> ControllerInput s e -> Bool
$c/= :: forall s e.
(Eq s, Eq e) =>
ControllerInput s e -> ControllerInput s e -> Bool
== :: ControllerInput s e -> ControllerInput s e -> Bool
$c== :: forall s e.
(Eq s, Eq e) =>
ControllerInput s e -> ControllerInput s e -> Bool
Eq, ReadPrec [ControllerInput s e]
ReadPrec (ControllerInput s e)
Int -> ReadS (ControllerInput s e)
ReadS [ControllerInput s e]
(Int -> ReadS (ControllerInput s e))
-> ReadS [ControllerInput s e]
-> ReadPrec (ControllerInput s e)
-> ReadPrec [ControllerInput s e]
-> Read (ControllerInput s e)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall s e. (Read s, Read e) => ReadPrec [ControllerInput s e]
forall s e. (Read s, Read e) => ReadPrec (ControllerInput s e)
forall s e. (Read s, Read e) => Int -> ReadS (ControllerInput s e)
forall s e. (Read s, Read e) => ReadS [ControllerInput s e]
readListPrec :: ReadPrec [ControllerInput s e]
$creadListPrec :: forall s e. (Read s, Read e) => ReadPrec [ControllerInput s e]
readPrec :: ReadPrec (ControllerInput s e)
$creadPrec :: forall s e. (Read s, Read e) => ReadPrec (ControllerInput s e)
readList :: ReadS [ControllerInput s e]
$creadList :: forall s e. (Read s, Read e) => ReadS [ControllerInput s e]
readsPrec :: Int -> ReadS (ControllerInput s e)
$creadsPrec :: forall s e. (Read s, Read e) => Int -> ReadS (ControllerInput s e)
Read, Int -> ControllerInput s e -> ShowS
[ControllerInput s e] -> ShowS
ControllerInput s e -> String
(Int -> ControllerInput s e -> ShowS)
-> (ControllerInput s e -> String)
-> ([ControllerInput s e] -> ShowS)
-> Show (ControllerInput s e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall s e. (Show s, Show e) => Int -> ControllerInput s e -> ShowS
forall s e. (Show s, Show e) => [ControllerInput s e] -> ShowS
forall s e. (Show s, Show e) => ControllerInput s e -> String
showList :: [ControllerInput s e] -> ShowS
$cshowList :: forall s e. (Show s, Show e) => [ControllerInput s e] -> ShowS
show :: ControllerInput s e -> String
$cshow :: forall s e. (Show s, Show e) => ControllerInput s e -> String
showsPrec :: Int -> ControllerInput s e -> ShowS
$cshowsPrec :: forall s e. (Show s, Show e) => Int -> ControllerInput s e -> ShowS
Show)

-- | A convenient constant that represents no input. This can be used to set

-- specific buttons and stick directions in order to test functions without

-- having a Nintendo Switch controller at hand, like:

--

-- @

--     'noInput' { 'btnX' = 'True', 'stickLeft' = 'Discrete' 'Up' }

-- @

-- 

noInput :: ControllerInput s e
noInput :: ControllerInput s e
noInput =
  Input :: forall s e.
Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> StickDirection s
-> StickDirection s
-> ExtraInput e
-> Maybe BatteryInfo
-> ControllerInput s e
Input
    { btnL :: Bool
btnL          = Bool
False
    , btnZL :: Bool
btnZL         = Bool
False
    , btnMinus :: Bool
btnMinus      = Bool
False
    , btnLeftStick :: Bool
btnLeftStick  = Bool
False
    , btnUp :: Bool
btnUp         = Bool
False
    , btnLeft :: Bool
btnLeft       = Bool
False
    , btnRight :: Bool
btnRight      = Bool
False
    , btnDown :: Bool
btnDown       = Bool
False
    , btnCapture :: Bool
btnCapture    = Bool
False
    , btnLeftSL :: Bool
btnLeftSL     = Bool
False
    , btnLeftSR :: Bool
btnLeftSR     = Bool
False
    , btnR :: Bool
btnR          = Bool
False
    , btnZR :: Bool
btnZR         = Bool
False
    , btnPlus :: Bool
btnPlus       = Bool
False
    , btnX :: Bool
btnX          = Bool
False
    , btnY :: Bool
btnY          = Bool
False
    , btnA :: Bool
btnA          = Bool
False
    , btnB :: Bool
btnB          = Bool
False
    , btnRightStick :: Bool
btnRightStick = Bool
False
    , btnHome :: Bool
btnHome       = Bool
False
    , btnRightSL :: Bool
btnRightSL    = Bool
False
    , btnRightSR :: Bool
btnRightSR    = Bool
False
    , stickLeft :: StickDirection s
stickLeft     = Direction -> StickDirection s
forall a. Direction -> StickDirection a
Discrete Direction
None
    , stickRight :: StickDirection s
stickRight    = Direction -> StickDirection s
forall a. Direction -> StickDirection a
Discrete Direction
None
    , extras :: ExtraInput e
extras        = ExtraInput e
forall a. ExtraInput a
Unavailable
    , battery :: Maybe BatteryInfo
battery       = Maybe BatteryInfo
forall a. Maybe a
Nothing
    }

-- | Accelerometer data consists of three measurements recorded in 15ms (i.e.,

-- the precision is 5ms). Each measurement is an x\/y\/z triple measured in Gs.

type Accelerometer a = ((a, a, a), (a, a, a), (a, a, a))

-- | Gyroscope data consists of three measurements recorded in 15ms (i.e., the

-- precision is 5ms). Each measurement is an x\/y\/z triple measured in radians

-- per second.

type Gyroscope a = ((a, a, a), (a, a, a), (a, a, a))

-- | Depending on the t'Device.Nintendo.Switch.InputMode', v'Input' can contain

-- additional information: Replies to commands (e.g., an acknowledgement when

-- sending a rumble command) and inertial sensor data (i.e., accelerometer and

-- gyroscope).

data ExtraInput a
  = CommandReply ReplyData
    -- ^ After sending commands to the controller (e.g., setting the

    -- t'Device.Nintendo.Switch.InputMode'), a command reply is returned as extra

    -- data in the next input.

  | Inertial (Accelerometer a) (Gyroscope a)
    -- ^ A controller provides inertial sensor data (i.e., accelerometer and

    -- gyroscope) only if it is in 'Device.Nintendo.Switch.Standard' input mode and

    -- inertial measurement is activated via 'Device.Nintendo.Switch.setInertialMeasurement'.

    --

    -- Regarding the x\/y\/z coordinate system, consider the left Joy-Con lying

    -- flat on a table, the analog stick pointing up. The x-axis then points

    -- towards the Z/ZL shoulder buttons (or alternatively: to where the up arrow

    -- button is pointing), the y-axis points to the opposite side of the SL/SR

    -- buttons (or alternatively: to where the left arrow button is pointing),

    -- and the z-axis points up in the air. The coordinate system is the same for

    -- all controller types.

  | Unavailable
    -- ^ Indicates that there is no additional input data.

  deriving (ExtraInput a -> ExtraInput a -> Bool
(ExtraInput a -> ExtraInput a -> Bool)
-> (ExtraInput a -> ExtraInput a -> Bool) -> Eq (ExtraInput a)
forall a. Eq a => ExtraInput a -> ExtraInput a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtraInput a -> ExtraInput a -> Bool
$c/= :: forall a. Eq a => ExtraInput a -> ExtraInput a -> Bool
== :: ExtraInput a -> ExtraInput a -> Bool
$c== :: forall a. Eq a => ExtraInput a -> ExtraInput a -> Bool
Eq, a -> ExtraInput b -> ExtraInput a
(a -> b) -> ExtraInput a -> ExtraInput b
(forall a b. (a -> b) -> ExtraInput a -> ExtraInput b)
-> (forall a b. a -> ExtraInput b -> ExtraInput a)
-> Functor ExtraInput
forall a b. a -> ExtraInput b -> ExtraInput a
forall a b. (a -> b) -> ExtraInput a -> ExtraInput b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ExtraInput b -> ExtraInput a
$c<$ :: forall a b. a -> ExtraInput b -> ExtraInput a
fmap :: (a -> b) -> ExtraInput a -> ExtraInput b
$cfmap :: forall a b. (a -> b) -> ExtraInput a -> ExtraInput b
Functor, ReadPrec [ExtraInput a]
ReadPrec (ExtraInput a)
Int -> ReadS (ExtraInput a)
ReadS [ExtraInput a]
(Int -> ReadS (ExtraInput a))
-> ReadS [ExtraInput a]
-> ReadPrec (ExtraInput a)
-> ReadPrec [ExtraInput a]
-> Read (ExtraInput a)
forall a. Read a => ReadPrec [ExtraInput a]
forall a. Read a => ReadPrec (ExtraInput a)
forall a. Read a => Int -> ReadS (ExtraInput a)
forall a. Read a => ReadS [ExtraInput a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExtraInput a]
$creadListPrec :: forall a. Read a => ReadPrec [ExtraInput a]
readPrec :: ReadPrec (ExtraInput a)
$creadPrec :: forall a. Read a => ReadPrec (ExtraInput a)
readList :: ReadS [ExtraInput a]
$creadList :: forall a. Read a => ReadS [ExtraInput a]
readsPrec :: Int -> ReadS (ExtraInput a)
$creadsPrec :: forall a. Read a => Int -> ReadS (ExtraInput a)
Read, Int -> ExtraInput a -> ShowS
[ExtraInput a] -> ShowS
ExtraInput a -> String
(Int -> ExtraInput a -> ShowS)
-> (ExtraInput a -> String)
-> ([ExtraInput a] -> ShowS)
-> Show (ExtraInput a)
forall a. Show a => Int -> ExtraInput a -> ShowS
forall a. Show a => [ExtraInput a] -> ShowS
forall a. Show a => ExtraInput a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtraInput a] -> ShowS
$cshowList :: forall a. Show a => [ExtraInput a] -> ShowS
show :: ExtraInput a -> String
$cshow :: forall a. Show a => ExtraInput a -> String
showsPrec :: Int -> ExtraInput a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ExtraInput a -> ShowS
Show)

-- | Whenever a command is sent to a controller (e.g., setting the

-- t'Device.Nintendo.Switch.InputMode'), the controller replies with an

-- 'Acknowledgement'.

data Acknowledgement a
  = ACK a -- ^ The command was executed successfully, possibly holding some response

          -- data (e.g., if the command was a query of the internal SPI flash memory).

  | NACK  -- ^ The command was not executed successfully.

  deriving (Acknowledgement a -> Acknowledgement a -> Bool
(Acknowledgement a -> Acknowledgement a -> Bool)
-> (Acknowledgement a -> Acknowledgement a -> Bool)
-> Eq (Acknowledgement a)
forall a. Eq a => Acknowledgement a -> Acknowledgement a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Acknowledgement a -> Acknowledgement a -> Bool
$c/= :: forall a. Eq a => Acknowledgement a -> Acknowledgement a -> Bool
== :: Acknowledgement a -> Acknowledgement a -> Bool
$c== :: forall a. Eq a => Acknowledgement a -> Acknowledgement a -> Bool
Eq, a -> Acknowledgement b -> Acknowledgement a
(a -> b) -> Acknowledgement a -> Acknowledgement b
(forall a b. (a -> b) -> Acknowledgement a -> Acknowledgement b)
-> (forall a b. a -> Acknowledgement b -> Acknowledgement a)
-> Functor Acknowledgement
forall a b. a -> Acknowledgement b -> Acknowledgement a
forall a b. (a -> b) -> Acknowledgement a -> Acknowledgement b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Acknowledgement b -> Acknowledgement a
$c<$ :: forall a b. a -> Acknowledgement b -> Acknowledgement a
fmap :: (a -> b) -> Acknowledgement a -> Acknowledgement b
$cfmap :: forall a b. (a -> b) -> Acknowledgement a -> Acknowledgement b
Functor, ReadPrec [Acknowledgement a]
ReadPrec (Acknowledgement a)
Int -> ReadS (Acknowledgement a)
ReadS [Acknowledgement a]
(Int -> ReadS (Acknowledgement a))
-> ReadS [Acknowledgement a]
-> ReadPrec (Acknowledgement a)
-> ReadPrec [Acknowledgement a]
-> Read (Acknowledgement a)
forall a. Read a => ReadPrec [Acknowledgement a]
forall a. Read a => ReadPrec (Acknowledgement a)
forall a. Read a => Int -> ReadS (Acknowledgement a)
forall a. Read a => ReadS [Acknowledgement a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Acknowledgement a]
$creadListPrec :: forall a. Read a => ReadPrec [Acknowledgement a]
readPrec :: ReadPrec (Acknowledgement a)
$creadPrec :: forall a. Read a => ReadPrec (Acknowledgement a)
readList :: ReadS [Acknowledgement a]
$creadList :: forall a. Read a => ReadS [Acknowledgement a]
readsPrec :: Int -> ReadS (Acknowledgement a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Acknowledgement a)
Read, Int -> Acknowledgement a -> ShowS
[Acknowledgement a] -> ShowS
Acknowledgement a -> String
(Int -> Acknowledgement a -> ShowS)
-> (Acknowledgement a -> String)
-> ([Acknowledgement a] -> ShowS)
-> Show (Acknowledgement a)
forall a. Show a => Int -> Acknowledgement a -> ShowS
forall a. Show a => [Acknowledgement a] -> ShowS
forall a. Show a => Acknowledgement a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Acknowledgement a] -> ShowS
$cshowList :: forall a. Show a => [Acknowledgement a] -> ShowS
show :: Acknowledgement a -> String
$cshow :: forall a. Show a => Acknowledgement a -> String
showsPrec :: Int -> Acknowledgement a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Acknowledgement a -> ShowS
Show)

-- | Data type that combines the command type and its corresponding acknowledgement.

data ReplyData
  = RequestSPI             (Acknowledgement (Word32, Word8, BS.ByteString))
  | SetHomeLight           (Acknowledgement ())
  | SetInertialMeasurement (Acknowledgement ())
  | SetInputMode           (Acknowledgement ())
  | SetPlayerLights        (Acknowledgement ())
  | SetVibration           (Acknowledgement ())
  | UnknownCommand         Word8 Word8
  deriving (ReplyData -> ReplyData -> Bool
(ReplyData -> ReplyData -> Bool)
-> (ReplyData -> ReplyData -> Bool) -> Eq ReplyData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReplyData -> ReplyData -> Bool
$c/= :: ReplyData -> ReplyData -> Bool
== :: ReplyData -> ReplyData -> Bool
$c== :: ReplyData -> ReplyData -> Bool
Eq, ReadPrec [ReplyData]
ReadPrec ReplyData
Int -> ReadS ReplyData
ReadS [ReplyData]
(Int -> ReadS ReplyData)
-> ReadS [ReplyData]
-> ReadPrec ReplyData
-> ReadPrec [ReplyData]
-> Read ReplyData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReplyData]
$creadListPrec :: ReadPrec [ReplyData]
readPrec :: ReadPrec ReplyData
$creadPrec :: ReadPrec ReplyData
readList :: ReadS [ReplyData]
$creadList :: ReadS [ReplyData]
readsPrec :: Int -> ReadS ReplyData
$creadsPrec :: Int -> ReadS ReplyData
Read, Int -> ReplyData -> ShowS
[ReplyData] -> ShowS
ReplyData -> String
(Int -> ReplyData -> ShowS)
-> (ReplyData -> String)
-> ([ReplyData] -> ShowS)
-> Show ReplyData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReplyData] -> ShowS
$cshowList :: [ReplyData] -> ShowS
show :: ReplyData -> String
$cshow :: ReplyData -> String
showsPrec :: Int -> ReplyData -> ShowS
$cshowsPrec :: Int -> ReplyData -> ShowS
Show)

-- | The direction of the left ('stickLeft') and right ('stickRight') analog sticks.

data StickDirection a
  = Discrete Direction
    -- ^ In 'Device.Nintendo.Switch.Simple' input mode, controllers send discrete

    -- stick directions.

  | Analog a a
    -- ^ In 'Device.Nintendo.Switch.Standard' input mode, controllers send analog

    -- stick directions. The first value is left/right (interval @[-1,1]@), the

    -- second value is down/up (interval @[-1,1]@).

  deriving (StickDirection a -> StickDirection a -> Bool
(StickDirection a -> StickDirection a -> Bool)
-> (StickDirection a -> StickDirection a -> Bool)
-> Eq (StickDirection a)
forall a. Eq a => StickDirection a -> StickDirection a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StickDirection a -> StickDirection a -> Bool
$c/= :: forall a. Eq a => StickDirection a -> StickDirection a -> Bool
== :: StickDirection a -> StickDirection a -> Bool
$c== :: forall a. Eq a => StickDirection a -> StickDirection a -> Bool
Eq, a -> StickDirection b -> StickDirection a
(a -> b) -> StickDirection a -> StickDirection b
(forall a b. (a -> b) -> StickDirection a -> StickDirection b)
-> (forall a b. a -> StickDirection b -> StickDirection a)
-> Functor StickDirection
forall a b. a -> StickDirection b -> StickDirection a
forall a b. (a -> b) -> StickDirection a -> StickDirection b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> StickDirection b -> StickDirection a
$c<$ :: forall a b. a -> StickDirection b -> StickDirection a
fmap :: (a -> b) -> StickDirection a -> StickDirection b
$cfmap :: forall a b. (a -> b) -> StickDirection a -> StickDirection b
Functor, ReadPrec [StickDirection a]
ReadPrec (StickDirection a)
Int -> ReadS (StickDirection a)
ReadS [StickDirection a]
(Int -> ReadS (StickDirection a))
-> ReadS [StickDirection a]
-> ReadPrec (StickDirection a)
-> ReadPrec [StickDirection a]
-> Read (StickDirection a)
forall a. Read a => ReadPrec [StickDirection a]
forall a. Read a => ReadPrec (StickDirection a)
forall a. Read a => Int -> ReadS (StickDirection a)
forall a. Read a => ReadS [StickDirection a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StickDirection a]
$creadListPrec :: forall a. Read a => ReadPrec [StickDirection a]
readPrec :: ReadPrec (StickDirection a)
$creadPrec :: forall a. Read a => ReadPrec (StickDirection a)
readList :: ReadS [StickDirection a]
$creadList :: forall a. Read a => ReadS [StickDirection a]
readsPrec :: Int -> ReadS (StickDirection a)
$creadsPrec :: forall a. Read a => Int -> ReadS (StickDirection a)
Read, Int -> StickDirection a -> ShowS
[StickDirection a] -> ShowS
StickDirection a -> String
(Int -> StickDirection a -> ShowS)
-> (StickDirection a -> String)
-> ([StickDirection a] -> ShowS)
-> Show (StickDirection a)
forall a. Show a => Int -> StickDirection a -> ShowS
forall a. Show a => [StickDirection a] -> ShowS
forall a. Show a => StickDirection a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StickDirection a] -> ShowS
$cshowList :: forall a. Show a => [StickDirection a] -> ShowS
show :: StickDirection a -> String
$cshow :: forall a. Show a => StickDirection a -> String
showsPrec :: Int -> StickDirection a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> StickDirection a -> ShowS
Show)

-- | The nine possible discrete positions of the analog stick in

-- 'Device.Nintendo.Switch.Simple' input mode.

data Direction
  = None
  | Left
  | Up
  | Right
  | Down
  | LeftUp
  | LeftDown
  | RightUp
  | RightDown
  deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq, ReadPrec [Direction]
ReadPrec Direction
Int -> ReadS Direction
ReadS [Direction]
(Int -> ReadS Direction)
-> ReadS [Direction]
-> ReadPrec Direction
-> ReadPrec [Direction]
-> Read Direction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Direction]
$creadListPrec :: ReadPrec [Direction]
readPrec :: ReadPrec Direction
$creadPrec :: ReadPrec Direction
readList :: ReadS [Direction]
$creadList :: ReadS [Direction]
readsPrec :: Int -> ReadS Direction
$creadsPrec :: Int -> ReadS Direction
Read, Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Direction] -> ShowS
$cshowList :: [Direction] -> ShowS
show :: Direction -> String
$cshow :: Direction -> String
showsPrec :: Int -> Direction -> ShowS
$cshowsPrec :: Int -> Direction -> ShowS
Show)

-- | Converts stick directions into x\/y coordinates in the interval @[-1,1]@.

-- 'Analog' values are taken as is, while 'Discrete' directions are converted

-- to their analog counterpart.

coordinates :: StickDirection Float -> (Float, Float)
coordinates :: StickDirection Float -> (Float, Float)
coordinates (Analog Float
x Float
y) = (Float
x, Float
y)
coordinates (Discrete Direction
dir) =
  case Direction
dir of
    Direction
None      -> (    Float
0,    Float
0)
    Direction
Left      -> ( Float
left,    Float
0)
    Direction
Up        -> (    Float
0,   Float
up)
    Direction
Right     -> (Float
right,    Float
0)
    Direction
Down      -> (    Float
0, Float
down)
    Direction
LeftUp    -> ( Float
left,   Float
up)
    Direction
LeftDown  -> ( Float
left, Float
down)
    Direction
RightUp   -> (Float
right,   Float
up)
    Direction
RightDown -> (Float
right, Float
down)
  where
    right :: Float
right = Float -> Float
forall a. Floating a => a -> a
cos (Float
forall a. Floating a => a
pi Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
4)
    left :: Float
left  = -Float
right
    up :: Float
up    = Float -> Float
forall a. Floating a => a -> a
sin (Float
forall a. Floating a => a
pi Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
4)
    down :: Float
down  = -Float
up

-- | Merges the inputs of two Nintendo Switch controllers. The resulting input

-- contains the left button states and left analog stick direction from one input,

-- and the right button states and right analog stick direction from the other

-- input. This can be used to unify the inputs of two controllers that belong

-- together (e.g., a pair of left and right Joy-Cons).

--

-- Note that the 'extras' and 'battery' information of the original inputs are

-- discarded in the merged input (they are set to 'Unavailable' and 'Nothing',

-- respectively).

mergeInputs
  :: Input -- ^ The left-side input to be merged.

  -> Input -- ^ The right-side input to be merged.

  -> Input -- ^ The merged input, without 'extras' and 'battery'.

mergeInputs :: Input -> Input -> Input
mergeInputs Input
leftInput Input
rightInput =
  Input
leftInput
    { btnR :: Bool
btnR          = Input -> Bool
forall s e. ControllerInput s e -> Bool
btnR Input
rightInput
    , btnZR :: Bool
btnZR         = Input -> Bool
forall s e. ControllerInput s e -> Bool
btnZR Input
rightInput
    , btnPlus :: Bool
btnPlus       = Input -> Bool
forall s e. ControllerInput s e -> Bool
btnPlus Input
rightInput
    , btnX :: Bool
btnX          = Input -> Bool
forall s e. ControllerInput s e -> Bool
btnX Input
rightInput
    , btnY :: Bool
btnY          = Input -> Bool
forall s e. ControllerInput s e -> Bool
btnY Input
rightInput
    , btnA :: Bool
btnA          = Input -> Bool
forall s e. ControllerInput s e -> Bool
btnA Input
rightInput
    , btnB :: Bool
btnB          = Input -> Bool
forall s e. ControllerInput s e -> Bool
btnB Input
rightInput
    , btnRightStick :: Bool
btnRightStick = Input -> Bool
forall s e. ControllerInput s e -> Bool
btnRightStick Input
rightInput
    , btnHome :: Bool
btnHome       = Input -> Bool
forall s e. ControllerInput s e -> Bool
btnHome Input
rightInput
    , btnRightSL :: Bool
btnRightSL    = Input -> Bool
forall s e. ControllerInput s e -> Bool
btnRightSL Input
rightInput
    , btnRightSR :: Bool
btnRightSR    = Input -> Bool
forall s e. ControllerInput s e -> Bool
btnRightSR Input
rightInput
    , stickRight :: StickDirection Float
stickRight    = Input -> StickDirection Float
forall s e. ControllerInput s e -> StickDirection s
stickRight Input
rightInput
    , extras :: ExtraInput Float
extras        = ExtraInput Float
forall a. ExtraInput a
Unavailable
    , battery :: Maybe BatteryInfo
battery       = Maybe BatteryInfo
forall a. Maybe a
Nothing
    }

-- | The battery status of a Nintendo Switch controller.

data BatteryStatus
  = Empty
  | Low
  | Medium
  | Good
  | Full
  deriving (BatteryStatus -> BatteryStatus -> Bool
(BatteryStatus -> BatteryStatus -> Bool)
-> (BatteryStatus -> BatteryStatus -> Bool) -> Eq BatteryStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatteryStatus -> BatteryStatus -> Bool
$c/= :: BatteryStatus -> BatteryStatus -> Bool
== :: BatteryStatus -> BatteryStatus -> Bool
$c== :: BatteryStatus -> BatteryStatus -> Bool
Eq, Eq BatteryStatus
Eq BatteryStatus
-> (BatteryStatus -> BatteryStatus -> Ordering)
-> (BatteryStatus -> BatteryStatus -> Bool)
-> (BatteryStatus -> BatteryStatus -> Bool)
-> (BatteryStatus -> BatteryStatus -> Bool)
-> (BatteryStatus -> BatteryStatus -> Bool)
-> (BatteryStatus -> BatteryStatus -> BatteryStatus)
-> (BatteryStatus -> BatteryStatus -> BatteryStatus)
-> Ord BatteryStatus
BatteryStatus -> BatteryStatus -> Bool
BatteryStatus -> BatteryStatus -> Ordering
BatteryStatus -> BatteryStatus -> BatteryStatus
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BatteryStatus -> BatteryStatus -> BatteryStatus
$cmin :: BatteryStatus -> BatteryStatus -> BatteryStatus
max :: BatteryStatus -> BatteryStatus -> BatteryStatus
$cmax :: BatteryStatus -> BatteryStatus -> BatteryStatus
>= :: BatteryStatus -> BatteryStatus -> Bool
$c>= :: BatteryStatus -> BatteryStatus -> Bool
> :: BatteryStatus -> BatteryStatus -> Bool
$c> :: BatteryStatus -> BatteryStatus -> Bool
<= :: BatteryStatus -> BatteryStatus -> Bool
$c<= :: BatteryStatus -> BatteryStatus -> Bool
< :: BatteryStatus -> BatteryStatus -> Bool
$c< :: BatteryStatus -> BatteryStatus -> Bool
compare :: BatteryStatus -> BatteryStatus -> Ordering
$ccompare :: BatteryStatus -> BatteryStatus -> Ordering
$cp1Ord :: Eq BatteryStatus
Ord, ReadPrec [BatteryStatus]
ReadPrec BatteryStatus
Int -> ReadS BatteryStatus
ReadS [BatteryStatus]
(Int -> ReadS BatteryStatus)
-> ReadS [BatteryStatus]
-> ReadPrec BatteryStatus
-> ReadPrec [BatteryStatus]
-> Read BatteryStatus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatteryStatus]
$creadListPrec :: ReadPrec [BatteryStatus]
readPrec :: ReadPrec BatteryStatus
$creadPrec :: ReadPrec BatteryStatus
readList :: ReadS [BatteryStatus]
$creadList :: ReadS [BatteryStatus]
readsPrec :: Int -> ReadS BatteryStatus
$creadsPrec :: Int -> ReadS BatteryStatus
Read, Int -> BatteryStatus -> ShowS
[BatteryStatus] -> ShowS
BatteryStatus -> String
(Int -> BatteryStatus -> ShowS)
-> (BatteryStatus -> String)
-> ([BatteryStatus] -> ShowS)
-> Show BatteryStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatteryStatus] -> ShowS
$cshowList :: [BatteryStatus] -> ShowS
show :: BatteryStatus -> String
$cshow :: BatteryStatus -> String
showsPrec :: Int -> BatteryStatus -> ShowS
$cshowsPrec :: Int -> BatteryStatus -> ShowS
Show)

-- | Information about the battery of a Nintendo Switch controller. It is only

-- returned by 'getInput' (see 'battery') if the controller sends a command reply

-- or the input mode of the controller is 'Device.Nintendo.Switch.Standard'.

data BatteryInfo =
  BatteryInfo
    { BatteryInfo -> BatteryStatus
batteryStatus :: BatteryStatus
    , BatteryInfo -> Bool
charging      :: Bool
    }
  deriving (BatteryInfo -> BatteryInfo -> Bool
(BatteryInfo -> BatteryInfo -> Bool)
-> (BatteryInfo -> BatteryInfo -> Bool) -> Eq BatteryInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatteryInfo -> BatteryInfo -> Bool
$c/= :: BatteryInfo -> BatteryInfo -> Bool
== :: BatteryInfo -> BatteryInfo -> Bool
$c== :: BatteryInfo -> BatteryInfo -> Bool
Eq, ReadPrec [BatteryInfo]
ReadPrec BatteryInfo
Int -> ReadS BatteryInfo
ReadS [BatteryInfo]
(Int -> ReadS BatteryInfo)
-> ReadS [BatteryInfo]
-> ReadPrec BatteryInfo
-> ReadPrec [BatteryInfo]
-> Read BatteryInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatteryInfo]
$creadListPrec :: ReadPrec [BatteryInfo]
readPrec :: ReadPrec BatteryInfo
$creadPrec :: ReadPrec BatteryInfo
readList :: ReadS [BatteryInfo]
$creadList :: ReadS [BatteryInfo]
readsPrec :: Int -> ReadS BatteryInfo
$creadsPrec :: Int -> ReadS BatteryInfo
Read, Int -> BatteryInfo -> ShowS
[BatteryInfo] -> ShowS
BatteryInfo -> String
(Int -> BatteryInfo -> ShowS)
-> (BatteryInfo -> String)
-> ([BatteryInfo] -> ShowS)
-> Show BatteryInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatteryInfo] -> ShowS
$cshowList :: [BatteryInfo] -> ShowS
show :: BatteryInfo -> String
$cshow :: BatteryInfo -> String
showsPrec :: Int -> BatteryInfo -> ShowS
$cshowsPrec :: Int -> BatteryInfo -> ShowS
Show)

adjustSensor
  :: ExtraInput Int16
  -> (Float, Float, Float)
  -> (Float, Float, Float)
  -> ExtraInput Float
adjustSensor :: ExtraInput Int16
-> (Float, Float, Float)
-> (Float, Float, Float)
-> ExtraInput Float
adjustSensor ExtraInput Int16
Unavailable (Float, Float, Float)
_ (Float, Float, Float)
_ = ExtraInput Float
forall a. ExtraInput a
Unavailable
adjustSensor (CommandReply ReplyData
r) (Float, Float, Float)
_ (Float, Float, Float)
_ = ReplyData -> ExtraInput Float
forall a. ReplyData -> ExtraInput a
CommandReply ReplyData
r
adjustSensor (Inertial Accelerometer Int16
acc Accelerometer Int16
gyro) (Float, Float, Float)
accs (Float, Float, Float)
gyros =
  Accelerometer Float -> Accelerometer Float -> ExtraInput Float
forall a. Accelerometer a -> Accelerometer a -> ExtraInput a
Inertial Accelerometer Float
newAcc Accelerometer Float
newGyro
    where facc :: Accelerometer Float
facc = ((Int16, Int16, Int16) -> (Float, Float, Float))
-> Accelerometer Int16 -> Accelerometer Float
forall a b. (a -> b) -> (a, a, a) -> (b, b, b)
tripleMap ((Int16 -> Float) -> (Int16, Int16, Int16) -> (Float, Float, Float)
forall a b. (a -> b) -> (a, a, a) -> (b, b, b)
tripleMap Int16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Accelerometer Int16
acc
          fgyro :: Accelerometer Float
fgyro = ((Int16, Int16, Int16) -> (Float, Float, Float))
-> Accelerometer Int16 -> Accelerometer Float
forall a b. (a -> b) -> (a, a, a) -> (b, b, b)
tripleMap ((Int16 -> Float) -> (Int16, Int16, Int16) -> (Float, Float, Float)
forall a b. (a -> b) -> (a, a, a) -> (b, b, b)
tripleMap Int16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Accelerometer Int16
gyro
          newAcc :: Accelerometer Float
newAcc = ((Float, Float, Float) -> (Float, Float, Float))
-> Accelerometer Float -> Accelerometer Float
forall a b. (a -> b) -> (a, a, a) -> (b, b, b)
tripleMap ((Float -> Float -> Float)
-> (Float, Float, Float)
-> (Float, Float, Float)
-> (Float, Float, Float)
forall a b c. (a -> b -> c) -> (a, a, a) -> (b, b, b) -> (c, c, c)
tripleZipWith Float -> Float -> Float
forall a. Num a => a -> a -> a
(*) (Float, Float, Float)
accs) Accelerometer Float
facc
          newGyro :: Accelerometer Float
newGyro = ((Float, Float, Float) -> (Float, Float, Float))
-> Accelerometer Float -> Accelerometer Float
forall a b. (a -> b) -> (a, a, a) -> (b, b, b)
tripleMap ((Float -> Float -> Float)
-> (Float, Float, Float)
-> (Float, Float, Float)
-> (Float, Float, Float)
forall a b c. (a -> b -> c) -> (a, a, a) -> (b, b, b) -> (c, c, c)
tripleZipWith Float -> Float -> Float
forall a. Num a => a -> a -> a
(*) (Float, Float, Float)
gyros) Accelerometer Float
fgyro

readRawInput :: Device -> IO RawInput
readRawInput :: Device -> IO RawInput
readRawInput Device
dev = do
  ByteString
response <- Device -> Int -> IO ByteString
read Device
dev Int
362
  case Parser RawInput -> ByteString -> Result RawInput
forall a. Parser a -> ByteString -> Result a
parse Parser RawInput
inputParser ByteString
response of
    Done ByteString
_ RawInput
raw -> RawInput -> IO RawInput
forall (f :: * -> *) a. Applicative f => a -> f a
pure RawInput
raw
    Result RawInput
_          -> InputException -> IO RawInput
forall e a. Exception e => e -> IO a
throwIO (InputException -> IO RawInput) -> InputException -> IO RawInput
forall a b. (a -> b) -> a -> b
$ ByteString -> InputException
UnknownFormatException ByteString
response

-- | Reads input from a Nintendo Switch controller. Blocks until controller

-- input is available.

getInput :: HasInput t => Controller t -> IO Input
getInput :: Controller t -> IO Input
getInput Controller t
controller =
  Controller t -> RawInput -> Input
forall (t :: ControllerType).
HasInput t =>
Controller t -> RawInput -> Input
convert Controller t
controller (RawInput -> Input) -> IO RawInput -> IO Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Device -> IO RawInput
readRawInput (Controller t -> Device
forall (t :: ControllerType). Controller t -> Device
handle Controller t
controller)

readRawTimeoutInput :: Int -> Device -> IO (Maybe RawInput)
readRawTimeoutInput :: Int -> Device -> IO (Maybe RawInput)
readRawTimeoutInput Int
timeout Device
dev = do
  ByteString
response <- Device -> Int -> Int -> IO ByteString
readTimeout Device
dev Int
362 Int
timeout
  if ByteString -> Int
BS.length ByteString
response Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
  then Maybe RawInput -> IO (Maybe RawInput)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe RawInput
forall a. Maybe a
Nothing
  else case Parser RawInput -> ByteString -> Result RawInput
forall a. Parser a -> ByteString -> Result a
parse Parser RawInput
inputParser ByteString
response of
    Done ByteString
_ RawInput
raw -> Maybe RawInput -> IO (Maybe RawInput)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe RawInput -> IO (Maybe RawInput))
-> Maybe RawInput -> IO (Maybe RawInput)
forall a b. (a -> b) -> a -> b
$ RawInput -> Maybe RawInput
forall a. a -> Maybe a
Just RawInput
raw
    Result RawInput
_          -> InputException -> IO (Maybe RawInput)
forall e a. Exception e => e -> IO a
throwIO (InputException -> IO (Maybe RawInput))
-> InputException -> IO (Maybe RawInput)
forall a b. (a -> b) -> a -> b
$ ByteString -> InputException
UnknownFormatException ByteString
response

-- | Reads input from a Nintendo Switch controller. Blocks until controller

-- input is available or a given time interval elapses.

getTimeoutInput
  :: HasInput t
  => Int              -- ^ The time interval in milliseconds.

  -> Controller t     -- ^ The controller to read the input from.

  -> IO (Maybe Input) -- ^ Returns 'Nothing' if the controller does not provide

                      -- an input within the specified time interval.

getTimeoutInput :: Int -> Controller t -> IO (Maybe Input)
getTimeoutInput Int
timeout Controller t
controller =
  (RawInput -> Input) -> Maybe RawInput -> Maybe Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Controller t -> RawInput -> Input
forall (t :: ControllerType).
HasInput t =>
Controller t -> RawInput -> Input
convert Controller t
controller) (Maybe RawInput -> Maybe Input)
-> IO (Maybe RawInput) -> IO (Maybe Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Int -> Device -> IO (Maybe RawInput)
readRawTimeoutInput Int
timeout (Controller t -> Device
forall (t :: ControllerType). Controller t -> Device
handle Controller t
controller)

inputParser :: Parser RawInput
inputParser :: Parser RawInput
inputParser
    = Parser RawInput
standardParser
  Parser RawInput -> Parser RawInput -> Parser RawInput
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser RawInput
buttonPushParser
  Parser RawInput -> Parser RawInput -> Parser RawInput
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser RawInput
commandParser

commandDetailParser :: Parser ReplyData
commandDetailParser :: Parser ReplyData
commandDetailParser
    = Parser ReplyData
requestSPIReplyParser
  Parser ReplyData -> Parser ReplyData -> Parser ReplyData
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ReplyData
homeLightReplyParser
  Parser ReplyData -> Parser ReplyData -> Parser ReplyData
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ReplyData
vibrationReplyParser
  Parser ReplyData -> Parser ReplyData -> Parser ReplyData
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ReplyData
inertialReplyParser
  Parser ReplyData -> Parser ReplyData -> Parser ReplyData
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ReplyData
inputModeReplyParser
  Parser ReplyData -> Parser ReplyData -> Parser ReplyData
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ReplyData
playerLightsReplyParser
  Parser ReplyData -> Parser ReplyData -> Parser ReplyData
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ReplyData
unknownCommandParser 

ackParser :: Parser Bool
ackParser :: Parser Bool
ackParser = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x80 (Word8 -> Bool) -> Parser ByteString Word8 -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word8
anyWord8

toAck :: Bool -> Acknowledgement ()
toAck :: Bool -> Acknowledgement ()
toAck Bool
True  = () -> Acknowledgement ()
forall a. a -> Acknowledgement a
ACK ()
toAck Bool
False = Acknowledgement ()
forall a. Acknowledgement a
NACK

requestSPIReplyParser :: Parser ReplyData
requestSPIReplyParser :: Parser ReplyData
requestSPIReplyParser = do
  Bool
ack <- Parser Bool
ackParser
  Word8
_ <- Word8 -> Parser ByteString Word8
word8 Word8
0x10
  case Bool
ack of
    Bool
False -> ReplyData -> Parser ReplyData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReplyData -> Parser ReplyData) -> ReplyData -> Parser ReplyData
forall a b. (a -> b) -> a -> b
$ Acknowledgement (Word32, Word8, ByteString) -> ReplyData
RequestSPI Acknowledgement (Word32, Word8, ByteString)
forall a. Acknowledgement a
NACK
    Bool
True  -> do
      Word32
byte0 <- Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32)
-> Parser ByteString Word8 -> Parser ByteString Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word8
anyWord8
      Word32
byte1 <- Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32)
-> Parser ByteString Word8 -> Parser ByteString Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word8
anyWord8
      Word32
byte2 <- Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32)
-> Parser ByteString Word8 -> Parser ByteString Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word8
anyWord8
      Word32
byte3 <- Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32)
-> Parser ByteString Word8 -> Parser ByteString Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word8
anyWord8
      Word8
len   <- Parser ByteString Word8
anyWord8
      ByteString
value <- Int -> Parser ByteString
take (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
len)
      let addrByte0 :: Word32
addrByte0 = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL Word32
byte3 Int
24
          addrByte1 :: Word32
addrByte1 = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL Word32
byte2 Int
16
          addrByte2 :: Word32
addrByte2 = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL Word32
byte1 Int
8
          addrByte3 :: Word32
addrByte3 = Word32
byte0
          address :: Word32
address   = Word32
addrByte0 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
addrByte1 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
addrByte2 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
addrByte3
      ReplyData -> Parser ReplyData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReplyData -> Parser ReplyData) -> ReplyData -> Parser ReplyData
forall a b. (a -> b) -> a -> b
$ Acknowledgement (Word32, Word8, ByteString) -> ReplyData
RequestSPI ((Word32, Word8, ByteString)
-> Acknowledgement (Word32, Word8, ByteString)
forall a. a -> Acknowledgement a
ACK (Word32
address, Word8
len, ByteString
value))

homeLightReplyParser :: Parser ReplyData
homeLightReplyParser :: Parser ReplyData
homeLightReplyParser = do
  Bool
ack <- Parser Bool
ackParser
  Word8
_ <- Word8 -> Parser ByteString Word8
word8 Word8
0x38
  ReplyData -> Parser ReplyData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReplyData -> Parser ReplyData) -> ReplyData -> Parser ReplyData
forall a b. (a -> b) -> a -> b
$ Acknowledgement () -> ReplyData
SetHomeLight (Bool -> Acknowledgement ()
toAck Bool
ack)

vibrationReplyParser :: Parser ReplyData
vibrationReplyParser :: Parser ReplyData
vibrationReplyParser = do
  Bool
ack <- Parser Bool
ackParser
  Word8
_ <- Word8 -> Parser ByteString Word8
word8 Word8
0x48
  ReplyData -> Parser ReplyData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReplyData -> Parser ReplyData) -> ReplyData -> Parser ReplyData
forall a b. (a -> b) -> a -> b
$ Acknowledgement () -> ReplyData
SetVibration (Bool -> Acknowledgement ()
toAck Bool
ack)

inertialReplyParser :: Parser ReplyData
inertialReplyParser :: Parser ReplyData
inertialReplyParser = do
  Bool
ack <- Parser Bool
ackParser
  Word8
_ <- Word8 -> Parser ByteString Word8
word8 Word8
0x40
  ReplyData -> Parser ReplyData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReplyData -> Parser ReplyData) -> ReplyData -> Parser ReplyData
forall a b. (a -> b) -> a -> b
$ Acknowledgement () -> ReplyData
SetInertialMeasurement (Bool -> Acknowledgement ()
toAck Bool
ack)

inputModeReplyParser :: Parser ReplyData
inputModeReplyParser :: Parser ReplyData
inputModeReplyParser = do
  Bool
ack <- Parser Bool
ackParser
  Word8
_ <- Word8 -> Parser ByteString Word8
word8 Word8
0x03
  ReplyData -> Parser ReplyData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReplyData -> Parser ReplyData) -> ReplyData -> Parser ReplyData
forall a b. (a -> b) -> a -> b
$ Acknowledgement () -> ReplyData
SetInputMode (Bool -> Acknowledgement ()
toAck Bool
ack)

playerLightsReplyParser :: Parser ReplyData
playerLightsReplyParser :: Parser ReplyData
playerLightsReplyParser = do
  Bool
ack <- Parser Bool
ackParser
  Word8
_ <- Word8 -> Parser ByteString Word8
word8 Word8
0x30
  ReplyData -> Parser ReplyData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReplyData -> Parser ReplyData) -> ReplyData -> Parser ReplyData
forall a b. (a -> b) -> a -> b
$ Acknowledgement () -> ReplyData
SetPlayerLights (Bool -> Acknowledgement ()
toAck Bool
ack)

unknownCommandParser :: Parser ReplyData
unknownCommandParser :: Parser ReplyData
unknownCommandParser = do
  Word8
byte0 <- Parser ByteString Word8
anyWord8
  Word8
byte1 <- Parser ByteString Word8
anyWord8
  ReplyData -> Parser ReplyData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReplyData -> Parser ReplyData) -> ReplyData -> Parser ReplyData
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> ReplyData
UnknownCommand Word8
byte0 Word8
byte1

standardParser :: Parser RawInput
standardParser :: Parser RawInput
standardParser = do
  Word8
_ <- Word8 -> Parser ByteString Word8
word8 Word8
0x30
  Word8
_ <- Parser ByteString Word8
anyWord8 -- timer byte

  BatteryInfo
batInfo    <- Parser BatteryInfo
batteryParser
  RawInput
btnInput   <- RawInput -> Parser RawInput
buttonStandardParser RawInput
forall s e. ControllerInput s e
noInput
  StickDirection Word16
leftStick  <- Parser (StickDirection Word16)
rawStickParser
  StickDirection Word16
rightStick <- Parser (StickDirection Word16)
rawStickParser
  Word8
_ <- Parser ByteString Word8
anyWord8 -- vibration byte

  (Int16, Int16, Int16)
acc1  <- Parser (Int16, Int16, Int16)
forall a. (Bits a, Num a) => Parser (a, a, a)
tripleParser
  (Int16, Int16, Int16)
gyro1 <- Parser (Int16, Int16, Int16)
forall a. (Bits a, Num a) => Parser (a, a, a)
tripleParser
  (Int16, Int16, Int16)
acc2  <- Parser (Int16, Int16, Int16)
forall a. (Bits a, Num a) => Parser (a, a, a)
tripleParser
  (Int16, Int16, Int16)
gyro2 <- Parser (Int16, Int16, Int16)
forall a. (Bits a, Num a) => Parser (a, a, a)
tripleParser
  (Int16, Int16, Int16)
acc3  <- Parser (Int16, Int16, Int16)
forall a. (Bits a, Num a) => Parser (a, a, a)
tripleParser
  (Int16, Int16, Int16)
gyro3 <- Parser (Int16, Int16, Int16)
forall a. (Bits a, Num a) => Parser (a, a, a)
tripleParser
  RawInput -> Parser RawInput
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawInput -> Parser RawInput) -> RawInput -> Parser RawInput
forall a b. (a -> b) -> a -> b
$
    RawInput
btnInput
      { stickLeft :: StickDirection Word16
stickLeft  = StickDirection Word16
leftStick
      , stickRight :: StickDirection Word16
stickRight = StickDirection Word16
rightStick
      , extras :: ExtraInput Int16
extras     = Accelerometer Int16 -> Accelerometer Int16 -> ExtraInput Int16
forall a. Accelerometer a -> Accelerometer a -> ExtraInput a
Inertial ((Int16, Int16, Int16)
acc1,(Int16, Int16, Int16)
acc2,(Int16, Int16, Int16)
acc3) ((Int16, Int16, Int16)
gyro1,(Int16, Int16, Int16)
gyro2,(Int16, Int16, Int16)
gyro3)
      , battery :: Maybe BatteryInfo
battery    = BatteryInfo -> Maybe BatteryInfo
forall a. a -> Maybe a
Just BatteryInfo
batInfo
      }

commandParser :: Parser RawInput
commandParser :: Parser RawInput
commandParser = do
  Word8
_ <- Word8 -> Parser ByteString Word8
word8 Word8
0x21
  Word8
_ <- Parser ByteString Word8
anyWord8 -- timer byte

  BatteryInfo
batInfo    <- Parser BatteryInfo
batteryParser
  RawInput
btnInput   <- RawInput -> Parser RawInput
buttonStandardParser RawInput
forall s e. ControllerInput s e
noInput
  StickDirection Word16
leftStick  <- Parser (StickDirection Word16)
rawStickParser
  StickDirection Word16
rightStick <- Parser (StickDirection Word16)
rawStickParser
  Word8
_ <- Parser ByteString Word8
anyWord8 -- vibration byte

  ReplyData
cmd <- Parser ReplyData
commandDetailParser
  RawInput -> Parser RawInput
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawInput -> Parser RawInput) -> RawInput -> Parser RawInput
forall a b. (a -> b) -> a -> b
$
    RawInput
btnInput
      { stickLeft :: StickDirection Word16
stickLeft  = StickDirection Word16
leftStick
      , stickRight :: StickDirection Word16
stickRight = StickDirection Word16
rightStick
      , extras :: ExtraInput Int16
extras     = ReplyData -> ExtraInput Int16
forall a. ReplyData -> ExtraInput a
CommandReply ReplyData
cmd
      , battery :: Maybe BatteryInfo
battery    = BatteryInfo -> Maybe BatteryInfo
forall a. a -> Maybe a
Just BatteryInfo
batInfo
      }

buttonPushParser :: Parser RawInput
buttonPushParser :: Parser RawInput
buttonPushParser = do
  Word8
_ <- Word8 -> Parser ByteString Word8
word8 Word8
0x3F
  Word8
btnByte1    <- Parser ByteString Word8
anyWord8
  Word8
btnByte2    <- Parser ByteString Word8
anyWord8
  Word8
stickByte   <- Parser ByteString Word8
anyWord8
  Maybe (StickDirection Word16, StickDirection Word16)
analogStick <- Parser (Maybe (StickDirection Word16, StickDirection Word16))
analogParser
  let down :: Bool
down  = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x01 Word8
btnByte1
      right :: Bool
right = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x02 Word8
btnByte1
      left :: Bool
left  = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x04 Word8
btnByte1
      up :: Bool
up    = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x08 Word8
btnByte1
      sl :: Bool
sl    = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x10 Word8
btnByte1
      sr :: Bool
sr    = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x20 Word8
btnByte1
      lr :: Bool
lr    = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x40 Word8
btnByte2
      zlzr :: Bool
zlzr  = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x80 Word8
btnByte2
      (StickDirection Word16
leftStick, StickDirection Word16
rightStick) =
        case Maybe (StickDirection Word16, StickDirection Word16)
analogStick of
          Just (StickDirection Word16
l,StickDirection Word16
r) -> (StickDirection Word16
l,StickDirection Word16
r)
          Maybe (StickDirection Word16, StickDirection Word16)
Nothing ->
            ( case Word8
stickByte of
                Word8
0x00 -> Direction -> StickDirection Word16
forall a. Direction -> StickDirection a
Discrete Direction
Right
                Word8
0x01 -> Direction -> StickDirection Word16
forall a. Direction -> StickDirection a
Discrete Direction
RightDown
                Word8
0x02 -> Direction -> StickDirection Word16
forall a. Direction -> StickDirection a
Discrete Direction
Down
                Word8
0x03 -> Direction -> StickDirection Word16
forall a. Direction -> StickDirection a
Discrete Direction
LeftDown
                Word8
0x04 -> Direction -> StickDirection Word16
forall a. Direction -> StickDirection a
Discrete Direction
Left
                Word8
0x05 -> Direction -> StickDirection Word16
forall a. Direction -> StickDirection a
Discrete Direction
LeftUp
                Word8
0x06 -> Direction -> StickDirection Word16
forall a. Direction -> StickDirection a
Discrete Direction
Up
                Word8
0x07 -> Direction -> StickDirection Word16
forall a. Direction -> StickDirection a
Discrete Direction
RightUp
                Word8
_    -> Direction -> StickDirection Word16
forall a. Direction -> StickDirection a
Discrete Direction
None
            , case Word8
stickByte of
                Word8
0x00 -> Direction -> StickDirection Word16
forall a. Direction -> StickDirection a
Discrete Direction
Left
                Word8
0x01 -> Direction -> StickDirection Word16
forall a. Direction -> StickDirection a
Discrete Direction
LeftUp
                Word8
0x02 -> Direction -> StickDirection Word16
forall a. Direction -> StickDirection a
Discrete Direction
Up
                Word8
0x03 -> Direction -> StickDirection Word16
forall a. Direction -> StickDirection a
Discrete Direction
RightUp
                Word8
0x04 -> Direction -> StickDirection Word16
forall a. Direction -> StickDirection a
Discrete Direction
Right
                Word8
0x05 -> Direction -> StickDirection Word16
forall a. Direction -> StickDirection a
Discrete Direction
RightDown
                Word8
0x06 -> Direction -> StickDirection Word16
forall a. Direction -> StickDirection a
Discrete Direction
Down
                Word8
0x07 -> Direction -> StickDirection Word16
forall a. Direction -> StickDirection a
Discrete Direction
LeftDown
                Word8
_    -> Direction -> StickDirection Word16
forall a. Direction -> StickDirection a
Discrete Direction
None
            )
  RawInput -> Parser RawInput
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawInput -> Parser RawInput) -> RawInput -> Parser RawInput
forall a b. (a -> b) -> a -> b
$
    Input :: forall s e.
Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> StickDirection s
-> StickDirection s
-> ExtraInput e
-> Maybe BatteryInfo
-> ControllerInput s e
Input
      { btnL :: Bool
btnL          = Bool
lr
      , btnZL :: Bool
btnZL         = Bool
zlzr
      , btnMinus :: Bool
btnMinus      = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x01 Word8
btnByte2
      , btnLeftStick :: Bool
btnLeftStick  = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x04 Word8
btnByte2
      , btnUp :: Bool
btnUp         = Bool
left
      , btnLeft :: Bool
btnLeft       = Bool
down
      , btnRight :: Bool
btnRight      = Bool
up
      , btnDown :: Bool
btnDown       = Bool
right
      , btnCapture :: Bool
btnCapture    = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x20 Word8
btnByte2
      , btnLeftSL :: Bool
btnLeftSL     = Bool
sl
      , btnLeftSR :: Bool
btnLeftSR     = Bool
sr
      , btnR :: Bool
btnR          = Bool
lr
      , btnZR :: Bool
btnZR         = Bool
zlzr
      , btnPlus :: Bool
btnPlus       = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x02 Word8
btnByte2
      , btnX :: Bool
btnX          = Bool
right
      , btnY :: Bool
btnY          = Bool
up
      , btnA :: Bool
btnA          = Bool
down
      , btnB :: Bool
btnB          = Bool
left
      , btnRightStick :: Bool
btnRightStick = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x08 Word8
btnByte2
      , btnHome :: Bool
btnHome       = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x10 Word8
btnByte2
      , btnRightSL :: Bool
btnRightSL    = Bool
sl
      , btnRightSR :: Bool
btnRightSR    = Bool
sr
      , stickLeft :: StickDirection Word16
stickLeft     = StickDirection Word16
leftStick
      , stickRight :: StickDirection Word16
stickRight    = StickDirection Word16
rightStick
      , extras :: ExtraInput Int16
extras        = ExtraInput Int16
forall a. ExtraInput a
Unavailable
      , battery :: Maybe BatteryInfo
battery       = Maybe BatteryInfo
forall a. Maybe a
Nothing
      }
  where
    analogParser :: Parser (Maybe (StickDirection Word16, StickDirection Word16))
    analogParser :: Parser (Maybe (StickDirection Word16, StickDirection Word16))
analogParser = Parser (Maybe (StickDirection Word16, StickDirection Word16))
forall a. Parser ByteString (Maybe a)
fillerParser Parser (Maybe (StickDirection Word16, StickDirection Word16))
-> Parser (Maybe (StickDirection Word16, StickDirection Word16))
-> Parser (Maybe (StickDirection Word16, StickDirection Word16))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Maybe (StickDirection Word16, StickDirection Word16))
proParser
    fillerParser :: Parser ByteString (Maybe a)
fillerParser = do
      Word8
_ <- Word8 -> Parser ByteString Word8
word8 Word8
0x00
      Word8
_ <- Word8 -> Parser ByteString Word8
word8 Word8
0x80
      Word8
_ <- Word8 -> Parser ByteString Word8
word8 Word8
0x00
      Word8
_ <- Word8 -> Parser ByteString Word8
word8 Word8
0x80
      Word8
_ <- Word8 -> Parser ByteString Word8
word8 Word8
0x00
      Word8
_ <- Word8 -> Parser ByteString Word8
word8 Word8
0x80
      Word8
_ <- Word8 -> Parser ByteString Word8
word8 Word8
0x00
      Word8
_ <- Word8 -> Parser ByteString Word8
word8 Word8
0x80
      Maybe a -> Parser ByteString (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    proParser :: Parser (Maybe (StickDirection Word16, StickDirection Word16))
proParser = do
      StickDirection Word16
left  <- Parser (StickDirection Word16)
stickBytesParser
      StickDirection Word16
right <- Parser (StickDirection Word16)
stickBytesParser
      Maybe (StickDirection Word16, StickDirection Word16)
-> Parser (Maybe (StickDirection Word16, StickDirection Word16))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (StickDirection Word16, StickDirection Word16)
 -> Parser (Maybe (StickDirection Word16, StickDirection Word16)))
-> Maybe (StickDirection Word16, StickDirection Word16)
-> Parser (Maybe (StickDirection Word16, StickDirection Word16))
forall a b. (a -> b) -> a -> b
$ (StickDirection Word16, StickDirection Word16)
-> Maybe (StickDirection Word16, StickDirection Word16)
forall a. a -> Maybe a
Just (StickDirection Word16
left, StickDirection Word16
right)
    stickBytesParser :: Parser (StickDirection Word16)
stickBytesParser = do
      Word16
stickByte0 <- Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word16)
-> Parser ByteString Word8 -> Parser ByteString Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word8
anyWord8
      Word16
stickByte1 <- Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word16)
-> Parser ByteString Word8 -> Parser ByteString Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word8
anyWord8
      Word16
stickByte2 <- Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word16)
-> Parser ByteString Word8 -> Parser ByteString Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word8
anyWord8
      Word16
stickByte3 <- Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word16)
-> Parser ByteString Word8 -> Parser ByteString Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word8
anyWord8
      StickDirection Word16 -> Parser (StickDirection Word16)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StickDirection Word16 -> Parser (StickDirection Word16))
-> StickDirection Word16 -> Parser (StickDirection Word16)
forall a b. (a -> b) -> a -> b
$
        Word16 -> Word16 -> StickDirection Word16
forall a. a -> a -> StickDirection a
Analog
          ( Word16
stickByte0 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftL Word16
stickByte1 Int
8 )
          ( Word16
stickByte2 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftL Word16
stickByte3 Int
8 )

batteryParser :: Parser BatteryInfo
batteryParser :: Parser BatteryInfo
batteryParser = do
  Word8
batteryByte <- Parser ByteString Word8
anyWord8
  BatteryInfo -> Parser BatteryInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BatteryInfo -> Parser BatteryInfo)
-> BatteryInfo -> Parser BatteryInfo
forall a b. (a -> b) -> a -> b
$
    BatteryInfo :: BatteryStatus -> Bool -> BatteryInfo
BatteryInfo {
      batteryStatus :: BatteryStatus
batteryStatus = Word8 -> BatteryStatus
forall a. (Ord a, Num a) => a -> BatteryStatus
toStatus Word8
batteryByte,
      charging :: Bool
charging      = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x01 Word8
batteryByte
    }
  where toStatus :: a -> BatteryStatus
toStatus a
b | a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
1 = BatteryStatus
Empty
                   | a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
3 = BatteryStatus
Low
                   | a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
5 = BatteryStatus
Medium
                   | a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
7 = BatteryStatus
Good
                   | Bool
otherwise = BatteryStatus
Full

buttonStandardParser :: RawInput -> Parser RawInput
buttonStandardParser :: RawInput -> Parser RawInput
buttonStandardParser RawInput
raw = do
  Word8
rightByte  <- Parser ByteString Word8
anyWord8
  Word8
sharedByte <- Parser ByteString Word8
anyWord8
  Word8
leftByte   <- Parser ByteString Word8
anyWord8
  RawInput -> Parser RawInput
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawInput -> Parser RawInput) -> RawInput -> Parser RawInput
forall a b. (a -> b) -> a -> b
$
    RawInput
raw
      { btnLeftStick :: Bool
btnLeftStick  = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x08 Word8
sharedByte
      , btnZL :: Bool
btnZL         = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x80 Word8
leftByte
      , btnL :: Bool
btnL          = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x40 Word8
leftByte
      , btnMinus :: Bool
btnMinus      = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x01 Word8
sharedByte
      , btnUp :: Bool
btnUp         = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x02 Word8
leftByte
      , btnLeft :: Bool
btnLeft       = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x08 Word8
leftByte
      , btnRight :: Bool
btnRight      = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x04 Word8
leftByte
      , btnDown :: Bool
btnDown       = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x01 Word8
leftByte
      , btnCapture :: Bool
btnCapture    = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x20 Word8
sharedByte
      , btnLeftSL :: Bool
btnLeftSL     = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x20 Word8
leftByte
      , btnLeftSR :: Bool
btnLeftSR     = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x10 Word8
leftByte
      , btnRightStick :: Bool
btnRightStick = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x04 Word8
sharedByte
      , btnZR :: Bool
btnZR         = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x80 Word8
rightByte
      , btnR :: Bool
btnR          = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x40 Word8
rightByte
      , btnPlus :: Bool
btnPlus       = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x02 Word8
sharedByte
      , btnX :: Bool
btnX          = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x02 Word8
rightByte
      , btnY :: Bool
btnY          = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x01 Word8
rightByte
      , btnA :: Bool
btnA          = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x08 Word8
rightByte
      , btnB :: Bool
btnB          = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x04 Word8
rightByte
      , btnHome :: Bool
btnHome       = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x10 Word8
sharedByte
      , btnRightSL :: Bool
btnRightSL    = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x20 Word8
rightByte
      , btnRightSR :: Bool
btnRightSR    = Word8 -> Word8 -> Bool
forall a. (Bits a, Eq a) => a -> a -> Bool
checkMask Word8
0x10 Word8
rightByte
      }

rawStickParser :: Parser (StickDirection Word16)
rawStickParser :: Parser (StickDirection Word16)
rawStickParser = do
  Word16
byte0 <- Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word16)
-> Parser ByteString Word8 -> Parser ByteString Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word8
anyWord8
  Word16
byte1 <- Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word16)
-> Parser ByteString Word8 -> Parser ByteString Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word8
anyWord8
  Word16
byte2 <- Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word16)
-> Parser ByteString Word8 -> Parser ByteString Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word8
anyWord8
  let x :: Word16
x = Word16
byte0 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftL (Word16
byte1 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0x0F) Int
8
      y :: Word16
y = Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftR Word16
byte1 Int
4 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftL Word16
byte2 Int
4
  StickDirection Word16 -> Parser (StickDirection Word16)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StickDirection Word16 -> Parser (StickDirection Word16))
-> StickDirection Word16 -> Parser (StickDirection Word16)
forall a b. (a -> b) -> a -> b
$ Word16 -> Word16 -> StickDirection Word16
forall a. a -> a -> StickDirection a
Analog Word16
x Word16
y

adjustStick :: StickDirection Word16 -> StickCalibration -> StickDirection Float
adjustStick :: StickDirection Word16 -> StickCalibration -> StickDirection Float
adjustStick (Discrete Direction
dir) StickCalibration
_ = Direction -> StickDirection Float
forall a. Direction -> StickDirection a
Discrete Direction
dir
adjustStick (Analog Word16
x Word16
y) (StickCalibration Float
dc Float
dout Float
mx Float
cx Float
px Float
my Float
cy Float
py) = let
    clampX :: Float
clampX = Float -> Float -> Float -> Float
forall a. Ord a => a -> a -> a -> a
clamp Float
mx Float
px (Word16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x)
    clampY :: Float
clampY = Float -> Float -> Float -> Float
forall a. Ord a => a -> a -> a -> a
clamp Float
my Float
py (Word16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
y)
    xf :: Float
xf = if Float
clampX Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
cx
         then (Float
clampX Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
cx) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/  (Float
px Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
cx)
         else (Float
clampX Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
cx) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
cx Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
mx)
    yf :: Float
yf = if Float
clampY Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
cy
         then (Float
clampY Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
cy) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
py Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
cy)
         else (Float
clampY Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
cy) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
cy Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
my)
    mag :: Float
mag = Float -> Float
forall a. Floating a => a -> a
sqrt (Float
xf Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
xf Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
yf Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
yf)
    legalRange :: Float
legalRange = Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
dout Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
dc
    normMag :: Float
normMag = Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
1 ((Float
mag Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
dc) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
legalRange)
    scale :: Float
scale = Float
normMag Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
mag
  in if Float
mag Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
dc
  then Float -> Float -> StickDirection Float
forall a. a -> a -> StickDirection a
Analog (Float
xf Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
scale) (Float
yf Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
scale)
  else Float -> Float -> StickDirection Float
forall a. a -> a -> StickDirection a
Analog Float
0 Float
0

withRawSPIData :: Device -> IORef Word8 -> Word32 -> Word8 -> (BS.ByteString -> a) -> IO a
withRawSPIData :: Device
-> IORef Word8 -> Word32 -> Word8 -> (ByteString -> a) -> IO a
withRawSPIData Device
dev IORef Word8
ref Word32
start Word8
len ByteString -> a
f = do
  Device -> IORef Word8 -> Word32 -> Word8 -> IO ()
requestRawSPI Device
dev IORef Word8
ref Word32
start Word8
len
  Int -> Int -> Device -> (ReplyData -> Maybe a) -> IO a
forall a. Int -> Int -> Device -> (ReplyData -> Maybe a) -> IO a
withRawCommandReply Int
10 Int
50 Device
dev ((ReplyData -> Maybe a) -> IO a) -> (ReplyData -> Maybe a) -> IO a
forall a b. (a -> b) -> a -> b
$ \case
    RequestSPI (ACK (Word32
addr, Word8
rLen, ByteString
value)) | Word32
addr Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
start Bool -> Bool -> Bool
&& Word8
rLen Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
len ->
      a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ ByteString -> a
f ByteString
value
    ReplyData
_ ->
      Maybe a
forall a. Maybe a
Nothing

withRawCommandReply :: Int -> Int -> Device -> (ReplyData -> Maybe a) -> IO a
withRawCommandReply :: Int -> Int -> Device -> (ReplyData -> Maybe a) -> IO a
withRawCommandReply Int
count Int
timeout Device
dev ReplyData -> Maybe a
f = Int -> IO a
loop Int
0
  where
    cCount :: Int
cCount   = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 Int
forall a. Bounded a => a
maxBound Int
count
    cTimeout :: Int
cTimeout = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 Int
forall a. Bounded a => a
maxBound Int
timeout
    loop :: Int -> IO a
loop Int
times
      | Int
times Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
cCount = InputException -> IO a
forall e a. Exception e => e -> IO a
throwIO InputException
NoReplyException
      | Bool
otherwise = do
          Maybe RawInput
input <- Int -> Device -> IO (Maybe RawInput)
readRawTimeoutInput Int
cTimeout Device
dev
          case Maybe RawInput
input of
            Just (Input { extras :: forall s e. ControllerInput s e -> ExtraInput e
extras = CommandReply ReplyData
obj }) ->
              case ReplyData -> Maybe a
f ReplyData
obj of
                Just a
r  -> a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r
                Maybe a
Nothing -> Int -> IO a
loop (Int -> Int
forall a. Enum a => a -> a
succ Int
times)
            Maybe RawInput
_ -> Int -> IO a
loop (Int -> Int
forall a. Enum a => a -> a
succ Int
times)

-- | Consumes inputs from a Nintendo Switch controller until a specific command

-- reply is encountered. Throws a 'NoReplyException' if the expected command

-- reply is not encountered within a specified count of inputs.

--

-- This function can be used to make sure that the controller is in an expected

-- state after sending commands (e.g., to wait for an 'Acknowledgement' after

-- switching its t'Device.Nintendo.Switch.InputMode').

withCommandReply
  :: Int
     -- ^ The maximum count of inputs that should be consumed.

  -> Int
     -- ^ The timeout per input read (see 'getTimeoutInput').

  -> Controller t
     -- ^ The controller to read the input from.

  -> (ReplyData -> Maybe a)
     -- ^ The function which checks the command reply. It must return 'Nothing'

     -- if a 'ReplyData' is encountered which we are not looking for, or 'Just' @a@

     -- if everything went well.

  -> IO a
     -- ^ The data extracted from the expected command reply.

withCommandReply :: Int -> Int -> Controller t -> (ReplyData -> Maybe a) -> IO a
withCommandReply Int
count Int
timeout Controller t
controller ReplyData -> Maybe a
f =
  Int -> Int -> Device -> (ReplyData -> Maybe a) -> IO a
forall a. Int -> Int -> Device -> (ReplyData -> Maybe a) -> IO a
withRawCommandReply Int
count Int
timeout (Controller t -> Device
forall (t :: ControllerType). Controller t -> Device
handle Controller t
controller) ReplyData -> Maybe a
f