-- | SDIF related data types
module Sound.SDIF.Type where

import Data.Bits
import qualified Data.ByteString.Lazy as B {- bytestring -}
import Data.Int
import Data.Word
import Sound.OpenSoundControl.Coding.Byte {- hosc -}

-- | Section of 'B.ByteString' from /i/th to /j/th indices.
section :: B.ByteString -> Int64 -> Int64 -> B.ByteString
section xs i j = B.take (j - i) (B.drop i xs)

-- | 'Int' based variant of 'section'.
section' :: B.ByteString -> Int -> Int -> B.ByteString
section' xs i j = section xs (fromIntegral i) (fromIntegral j)

-- | Data element type.
type Type = Int

-- | Is data element type standard.
data_type_standard_p :: Type -> Bool
data_type_standard_p d =
    let xs = [0x004, 0x008
             ,0x101, 0x102, 0x104, 0x108
             ,0x201, 0x202, 0x204, 0x208
             ,0x301
             ,0x401]
    in d `elem` xs

-- | String describing indicated data element type.
--
-- > data_type_string 0x008 == "real number"
data_type_string :: Type -> String
data_type_string d
    | d `elem` [0x004,0x008] = "real number"
    | d `elem` [0x101,0x102,0x104,0x108] = "signed integer"
    | d `elem` [0x201,0x202,0x204,0x208] = "unsigned integer"
    | d `elem` [0x301] = "utf_8 byte"
    | d `elem` [0x401] = "byte"
    | otherwise = "unknown"

-- | Size (in bytes) of data element type.
--
-- > data_type_size 0x008 == 8
data_type_size :: Type -> Int
data_type_size d = d .&. 0xff

-- | Universal type for element data.
data Datum = I8 Int
           | I16 Int
           | I32 Int
           | I64 Int64
           | U32 Int
           | U64 Word64
           | F32 Double
           | F64 Double
           | U8 Word8
             deriving (Eq, Show)

-- | Decoder for indicated data element type to 'Datum'.
data_type_decoder :: Type -> B.ByteString -> Datum
data_type_decoder d x =
    case d of
      0x004 -> F32 (decode_f32 x)
      0x008 -> F64 (decode_f64 x)
      0x101 -> I8 (decode_i8 x)
      0x102 -> I16 (decode_i16 x)
      0x104 -> I32 (decode_i32 x)
      0x108 -> I64 (decode_i64 x)
      0x201 -> U8 (x `B.index` 0)
      0x202 -> error "data_type_decoder:0x202,u16" -- decode_u16
      0x204 -> U32 (decode_u32 x)
      0x208 -> U64 (decode_u64 x)
      0x301 -> U8 (x `B.index` 0)
      0x401 -> U8 (x `B.index` 0)
      _ -> error "data_type_decoder:_"

-- | SDIF encoder for 'Datum'.
data_type_encoder :: Datum -> B.ByteString
data_type_encoder x =
    case x of
      I8 n -> encode_i8 n
      I16 n -> encode_i16 n
      I32 n -> encode_i32 n
      I64 n -> encode_i64 n
      U32 n -> encode_u32 n
      U64 n -> encode_u64 n
      F32 n -> encode_f32 n
      F64 n -> encode_f64 n
      U8 n -> B.singleton n