Connection.hs

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE KindSignatures      #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
module Device.Nintendo.Switch.Connection where

-- attoparsec
import Data.Attoparsec.ByteString (Parser, maybeResult, parse)

-- base
import Control.Exception (Exception, bracket, throwIO)
import Data.IORef        (newIORef)
import Prelude    hiding (init)

-- bytestring
import Data.ByteString (ByteString)

-- switch
import Device.Nintendo.Switch.Controller (Controller(..), ControllerType(..),
                                          HasCalibration(..), RawCalibration(..),
                                          axisCalibrationParser, stickFactoryParser,
                                          parseStickUserCalibration, axisUserParser)
import Device.Nintendo.Switch.Input      (Acknowledgement(ACK), ReplyData(SetInputMode),
                                          withCommandReply, withRawSPIData)
import Device.Nintendo.Switch.Output     (InputMode(Standard), setInputModeInternal)

import qualified System.HIDAPI as HID

-- | A handle which represents a virtual Nintendo Switch console. The handle
-- is used to detect controllers and manage their connections.
data Console = Console
  deriving (Eq, Ord, Read, Show)

-- | Initializes a Nintendo Switch console handle. In other words, it lets us
-- pretend to be Nintendo Switch console in order to detect controllers and manage
-- their connections. You must call this first before doing anything else.
init :: IO Console
init = HID.init >> pure Console

-- | Destroys a virtual Nintendo Switch handle. You must call this when you are
-- finished talking to the controllers.
exit :: Console -> IO ()
exit Console = HID.exit

-- | A convenient wrapper around 'init' and 'exit'.
withConsole :: (Console -> IO a) -> IO a
withConsole = bracket init exit

-- | A handle which represents an unconnected Nintendo Switch controller.
newtype ControllerInfo (t :: ControllerType) =
  ControllerInfo HID.DeviceInfo
    deriving Show

-- | A constraint which indicates that a controller is a valid Nintendo Switch
-- controller that can be detected and connected to.
class IsController (t :: ControllerType) where
  productID :: HID.ProductID
  vendorID  :: HID.VendorID
  vendorID = 0x057E -- standard: Nintendo

instance IsController 'LeftJoyCon where
  productID = 0x2006

instance IsController 'RightJoyCon where
  productID = 0x2007

instance IsController 'ProController where
  productID = 0x2009

-- | A 'ConnectionException' is thrown if something goes wrong when reading the
-- internal data of a Nintendo Switch controller when connecting to it. This
-- should not occur if you have an unmodified controller (i.e., you have not
-- tampered with its internal SPI flash memory).
data ConnectionException
  = NoFactoryStickException -- ^ Indicates that a controller has no factory stick calibration.
  | NoFactoryAxisException  -- ^ Indicates that a controller has no factory sensor calibration.
  deriving Eq

instance Exception ConnectionException
instance Show ConnectionException where
  show NoFactoryStickException = "Could not determine the factory stick calibration."
  show NoFactoryAxisException  = "Could not determine the factory sensor calibration."

-- | Connects to a detected Nintendo Switch controller.
--
-- Can throw a 'ConnectionException' if something is very wrong with your
-- internal controller memory (i.e., if you have tampered with it).
connect
  :: forall t . HasCalibration t
  => ControllerInfo t  -- ^ The detected Nintendo Switch controller.
  -> IO (Controller t) -- ^ The connected Nintendo Switch controller.
connect (ControllerInfo devInfo) = do
  dev <- HID.openDeviceInfo devInfo
  ref <- newIORef 0
  facStick  <- withRawSPIData dev ref 0x603D 18 (tryParse stickFactoryParser)
  facAxis   <- withRawSPIData dev ref 0x6020 24 (tryParse axisCalibrationParser)
  (usl,usr) <- withRawSPIData dev ref 0x8010 22 parseStickUserCalibration
  usrAxis   <- withRawSPIData dev ref 0x8026 26 (tryParse axisUserParser)
  controller <-
    case (facStick, facAxis) of
      (Nothing, _) -> throwIO NoFactoryStickException
      (_, Nothing) -> throwIO NoFactoryAxisException
      (Just (fsl,fsr), Just sensor) ->
        let ls = maybe fsl id usl
            rs = maybe fsr id usr
            ax = maybe sensor id usrAxis 
            cal = calibrate @t (RawCalibration ls rs ax) in
        pure $ Controller dev ref cal
  setInputModeInternal Standard controller
  withCommandReply 10 50 controller $ \case
    SetInputMode (ACK ()) -> Just ()
    _                     -> Nothing
  pure controller
    where
      tryParse :: Parser a -> ByteString -> Maybe a
      tryParse parser = maybeResult . parse parser

-- | Disconnects a Nintendo Switch controller. You must not use the controller
-- handle after disconnecting.
disconnect :: Controller t -> IO ()
disconnect = HID.close . handle

-- | A convenient wrapper around 'connect' and 'disconnect'.
withController :: HasCalibration t => ControllerInfo t -> (Controller t -> IO a) -> IO a
withController info =
  bracket
    ( connect info )
    ( disconnect )

-- | Detects all Nintendo Switch controllers of a specific 'ControllerType',
-- usually connected via Bluetooth.
--
-- You may want to use this function with @TypeApplications@ if the controller
-- type cannot be inferred, like:
--
-- @
--     'getControllerInfos' \@''LeftJoyCon' console
-- @
-- 
getControllerInfos :: forall t . IsController t => Console -> IO [ControllerInfo t]
getControllerInfos Console =
  let
    vendID = vendorID @t
    prodID = productID @t
  in do
    devInfos <- HID.enumerate (Just vendID) (Just prodID)
    pure $ ControllerInfo <$> devInfos