Register.hs

--------------------------------------------------------------------------------
-- | 
-- Module                  : I2C.Register
-- SPDX-License-Identifier : MIT
-- Copyright               : karamellpelle@hotmail.com
-- Maintainer              : karamellpelle@hotmail.com
-- Stability               : experimental
--
-- Utilities for working with chips with registers.
--------------------------------------------------------------------------------
{-# OPTIONS_GHC -Wno-deprecations #-}
module I2C.Register
(
    -- * Register
    Register (..),
    -- ** Register addressing
    RegisterAddress (..),
    fromRegisterAddress,

    -- * Read and write registers
    regread,
    regwrite,
    regmodify,

    -- * Read and write registers (direct addressing)
    regread',
    regwrite',
    regmodify',

) where

import Relude
import Data.Default
import Text.Show qualified
import Numeric (showHex)
import Data.Char (toUpper)
import Foreign

import I2C.Internal qualified as Internal
import I2C.Chip
import I2C.Types


--------------------------------------------------------------------------------
--  Register

-- | Register addressing inside chips.
newtype RegisterAddress = RegisterAddress Word8
    deriving (Num, Storable)

instance Show RegisterAddress where
    show (RegisterAddress w) =
        (if 0x10 <= w then "0x" else "0x0") <> fmap toUpper (showHex w "")

-- | Convert from 'RegisterAddress'
fromRegisterAddress :: Num b => RegisterAddress -> b
fromRegisterAddress (RegisterAddress addr) = fromIntegral addr

-- | Index to a register of type 'a'.
data Register t a = Register Text RegisterAddress


--------------------------------------------------------------------------------
--  using Register

-- | Read register.
--   May throw 'I2C.Exception.I2CErr'.
regread :: (IsChip t, Storable a, MonadIO m) => Internal.Chip t -> Register t a -> m a
regread chip (Register _name addr) = 
    regread' chip addr
{-# INLINE regread #-}

-- | Write register.
--   May throw 'I2C.Exception.I2CErr'.
regwrite :: (IsChip t, Storable a, MonadIO m) => Internal.Chip t -> Register t a -> a -> m ()
regwrite chip (Register _name addr) = 
    regwrite' chip addr
{-# INLINE regwrite #-}

-- | Modify register.
--   May throw 'I2C.Exception.I2CErr'.
regmodify :: (IsChip t, Storable a, MonadIO m) => Internal.Chip t -> Register t a -> (a -> a) -> m a
regmodify = \chip reg f -> do
    a <- regread chip reg
    let a' = f a
    regwrite chip reg a'
    pure a'


--------------------------------------------------------------------------------
--  raw addressing, no Register

-- | Read register at address.
--   May throw 'I2C.Exception.I2CErr'.
regread' :: forall a t m . (IsChip t, Storable a, MonadIO m) => Internal.Chip t -> RegisterAddress -> m a
regread' chip addr = 
    liftIO $ Internal.read chip (sizeOf addr) (flip poke addr) (sizeOf @a undefined) peek
{-# INLINE regread' #-}

-- | Write register at address.
--   May throw 'I2C.Exception.I2CErr'.
regwrite' :: forall a t m . (IsChip t, Storable a, MonadIO m) => Internal.Chip t -> RegisterAddress -> a -> m ()
regwrite' chip addr = \a -> do
    let w = StorableAB addr a
    liftIO $ Internal.write chip (sizeOf w) (flip poke w) 
{-# INLINE regwrite' #-}

-- | Modify register at address.
--   May throw 'I2C.Exception.I2CErr'.
regmodify' :: forall a t m . (IsChip t, Storable a, MonadIO m) => Internal.Chip t -> RegisterAddress -> (a -> a) -> m a
regmodify' = \chip addr f -> do
    a <- regread' chip addr
    let a' = f a
    regwrite' chip addr a'
    pure a'