module EIBd.Client.Address (
	-- * Individual Addresses
	IndividualAddress (..),
	fromIndividualAddress,
	toIndividualAddress,

	-- * Group Addresses
	GroupAddress (..),
	fromGroupAddress,
	toGroupAddress,
) where

import Data.Word
import Data.String
import Data.Bits
import Data.Char
import Data.List

-- | Group by numbers.
groupNumbers :: String -> [String]
groupNumbers = groupBy (\a b -> (isDigit a && isDigit b) || not (isDigit a || isDigit b))

-- | Used to determine a message's origin.
-- Each individual address points to a single device in the system.
-- It is used as follows:
--
-- > myDeviceAddr :: IndividualAddress
-- > myDeviceAddr = "1.2.3" -- With OverloadedStrings only
--
-- or
--
-- > myDeviceAddr :: IndividualAddress
-- > myDeviceAddr = toIndividualAddress 1 2 3
--
-- Use 'fromIndividualAddress', in order to dissect an individual address:
--
-- > (a, b, c) = fromIndividualAddress myDeviceAddr
--
-- where @(a, b, c)@ are the main-line, sub-line and device address.
newtype IndividualAddress = IndividualAddress Word16
	deriving (Eq, Ord)

-- | Inspect an individual address.
fromIndividualAddress :: IndividualAddress -> (Word8, Word8, Word8)
fromIndividualAddress (IndividualAddress n) =
	(fromIntegral (shift n (-12)),
	 fromIntegral (shift n (-8) .&. 15),
	 fromIntegral (n .&. 255))

-- | Create an individual address.
toIndividualAddress :: Word8 -> Word8 -> Word8 -> IndividualAddress
toIndividualAddress a b c = IndividualAddress (shift (fromIntegral a .&. 15) 12
                                          .|. shift (fromIntegral b .&. 15) 8
                                          .|. fromIntegral c)

-- | Instance for the OverloadedStrings extension
instance IsString IndividualAddress where
	fromString str =
		case groupNumbers str of
			[a, ".", b, ".", c] -> toIndividualAddress (read a) (read b) (read c)
			_ -> error "Ill formated individual address"

instance Show IndividualAddress where
	show i = show a ++ "." ++ show b ++ "." ++ show c where
		(a, b, c) = fromIndividualAddress i

-- | Used to identify communication groups. Individual and group addresses are created and inspected in
-- similiar fashion.
--
-- > myGrpAddr :: GroupAddress
-- > myGrpAddr = "1/2/3"
--
-- or
--
-- > myGrpAddr :: GroupAddress
-- > myGrpAddr = toGroupAddress 1 2 3
--
-- Inspect the components of a group address in the following manner:
--
-- > (a, b, c) = fromGroupAddress myGrpAddr
newtype GroupAddress = GroupAddress Word16
	deriving (Eq, Ord)

-- | Inspect a group address.
fromGroupAddress :: GroupAddress -> (Word8, Word8, Word8)
fromGroupAddress (GroupAddress n) =
	(fromIntegral (shift n (-11)),
	 fromIntegral (shift n (-8) .&. 7),
	 fromIntegral (n .&. 255))

-- | Create a group address.
toGroupAddress :: Word8 -> Word8 -> Word8 -> GroupAddress
toGroupAddress a b c = GroupAddress (shift (fromIntegral a .&. 15) 11
                                     .|. shift (fromIntegral b .&. 7) 8
                                     .|. fromIntegral c)

-- | Instance for the OverloadedStrings extension
instance IsString GroupAddress where
	fromString str =
		case groupNumbers str of
			[a, "/", b, "/", c] -> toGroupAddress (read a) (read b) (read c)
			_ -> error "Ill formated group address"

instance Show GroupAddress where
	show g = show a ++ "/" ++ show b ++ "/" ++ show c where
		(a, b, c) = fromGroupAddress g