{-# LINE 1 "Network/Bluetooth/Types.hsc" #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LINE 2 "Network/Bluetooth/Types.hsc" #-}
module Network.Bluetooth.Types where


{-# LINE 7 "Network/Bluetooth/Types.hsc" #-}

{-# LINE 8 "Network/Bluetooth/Types.hsc" #-}

{-# LINE 9 "Network/Bluetooth/Types.hsc" #-}

{-# LINE 10 "Network/Bluetooth/Types.hsc" #-}

{-# LINE 11 "Network/Bluetooth/Types.hsc" #-}

import Control.Applicative
import Control.Exception
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as BI
import Data.Char
import Data.List
import Data.Typeable
import Foreign
import Foreign.C
import Numeric



{-# LINE 26 "Network/Bluetooth/Types.hsc" #-}
foreign import ccall unsafe "strerror" strerror
    :: CInt -> CString

{-# LINE 29 "Network/Bluetooth/Types.hsc" #-}


{-# LINE 33 "Network/Bluetooth/Types.hsc" #-}
data Adapter = Adapter CInt CInt deriving (Eq, Ord, Show)

{-# LINE 35 "Network/Bluetooth/Types.hsc" #-}

data BluetoothException = BluetoothException String String deriving (Show, Typeable)
instance Exception BluetoothException

newtype BluetoothAddr = BluetoothAddr ByteString deriving (Eq, Ord)

instance Show BluetoothAddr where
    show (BluetoothAddr bs) = intercalate ":" $ map (\x -> dig2 $ showHex x "") $ reverse $ B.unpack bs
      where
        dig2 = map toUpper . reverse . take 2 . reverse . ('0':) 

instance Read BluetoothAddr where
    readsPrec _ t = go t (6 :: Int) []
      where
        go t n acc = case readHex t of
            (x, t'):_ -> case (n, t') of
                (1, _)       -> [(BluetoothAddr (B.pack (x:acc)), t')]
                (_, ':':t'') -> go t'' (n-1) (x:acc)
                _ -> []
            _ -> []

instance Storable BluetoothAddr where

{-# LINE 60 "Network/Bluetooth/Types.hsc" #-}
    sizeOf _ = (6)
{-# LINE 61 "Network/Bluetooth/Types.hsc" #-}

{-# LINE 62 "Network/Bluetooth/Types.hsc" #-}
    alignment _ = alignment (undefined :: Word64)
    peek p = BluetoothAddr . B.pack <$> peekArray 6 (castPtr p)
    poke p (BluetoothAddr bs) = do
        BI.memset (castPtr p) 0 (fromIntegral $ sizeOf (undefined :: BluetoothAddr)) 
        pokeArray (castPtr p) (B.unpack bs)