{-# LANGUAGE OverloadedStrings #-}

module EIBd.Client.Types (
	-- * Class
	DatapointType (..),

	-- * Auxiliary Types
	DPTB1,
	DPTB2 (..),
	DPTB1U3 (..),
	DPTU8,
	DPTS8,
	DPTF16 (..),
) where

import Control.Monad

import Data.Word
import Data.Int
import Data.Bits
import qualified Data.ByteString as B

-- | Datapoint Type
class DatapointType a where
	fromDPT :: a -> B.ByteString
	toDPT :: B.ByteString -> Maybe a

-- | DPT 1.x - 1 bit
type DPTB1 = Bool

instance DatapointType Bool where
	fromDPT False = "\NUL"
	fromDPT True  = "\SOH"

	toDPT "\NUL" = Just False
	toDPT "\SOH" = Just True
	toDPT _      = Nothing

-- | DPT 2.x - 2 bits
data DPTB2 = DPTB2 Bool Bool
	deriving (Show, Eq, Ord)

instance DatapointType DPTB2 where
	fromDPT (DPTB2 False False) = "\NUL"
	fromDPT (DPTB2 False True)  = "\SOH"
	fromDPT (DPTB2 True  False) = "\STX"
	fromDPT (DPTB2 True  True)  = "\ETX"

	toDPT "\NUL" = Just (DPTB2 False False)
	toDPT "\SOH" = Just (DPTB2 False True)
	toDPT "\STX" = Just (DPTB2 True  False)
	toDPT "\ETX" = Just (DPTB2 True  True)
	toDPT _      = Nothing

-- | DPT 3.x - 1 control bit and a 3-bit unsigned integer
data DPTB1U3 = DPTB1U3 Bool Word8
	deriving (Show, Eq, Ord)

instance DatapointType DPTB1U3 where
	fromDPT (DPTB1U3 True u)  = B.singleton (8 .|. (u .&. 7))
	fromDPT (DPTB1U3 False u) = B.singleton (u .&. 7)

	toDPT n = do
		guard (B.length n == 1)
		let x = B.head n
		return (DPTB1U3 (testBit x 3) (x .&. 7))

-- | DPT 4.x and 5.x - 8-bit unsigned integer
type DPTU8 = Word8

instance DatapointType Word8 where
	fromDPT w = B.pack [0, w]

	toDPT n = do
		guard (B.length n == 2)
		return (B.last n)

-- | DPT 6.x -- 8-bit signed integer
type DPTS8 = Int8

instance DatapointType Int8 where
	fromDPT w = B.pack [0, fromIntegral w]

	toDPT n = do
		guard (B.length n == 2)
		return (fromIntegral (B.last n))

-- | DPT 9.x -- 16-bit floating (not really) point integer
newtype DPTF16 = DPTF16 Float
	deriving (Show, Eq, Ord)

instance DatapointType DPTF16 where
	fromDPT (DPTF16 x) =
		B.pack [0, s .|. shift e 3 .|. fromIntegral leftM, fromIntegral rightM]
		where
			-- Generate the sign mask and make the target number positive
			(s, f) = if x < 0 then (bit 7, -x) else (0, x)

			-- Find the exponent and mantissa
			(e, m) = findE 0 (f * 100) :: (Word8, Word16)

			leftM = shift m (-8) .&. 7
			rightM = m .&. 255

			findE t r
				| t > 15 = error "DPTF16 is too large"
				| r > 2047 = findE (t + 1) (r / 2)
				| otherwise = (t, round r)
	toDPT n = do
		guard (B.length n == 3)

		let [_, x, y] = B.unpack n
		let sign = if testBit x 7 then (-0.01) else 0.01
		let mant = shiftL (fromIntegral x .&. 7) 8 .|. fromIntegral y :: Word16
		let power = 2 ^ (shiftR x 3 .&. 15)

		return (DPTF16 (sign * fromIntegral mant * power))