K.hs

{-# Language DeriveDataTypeable,FlexibleInstances,StandaloneDeriving #-}
-- | Data flow wire values.
module Sound.DF.Uniform.LL.K where

import Data.Int {- base -}
import Data.Typeable {- base -}

import Sound.DF.Uniform.LL.UId

-- * Vector

-- | Vector identifier.
data V_Id = V_Id Id deriving (Eq,Ord,Show)

-- | Vector type.
data Vec a = Vec V_Id Int [a] deriving (Typeable,Eq,Ord,Show)

-- | 'Id' of 'V_Id' of 'Vec'.
vec_id :: Vec t -> Id
vec_id (Vec (V_Id k) _ _) = k

-- | Concise pretty printer and 'Show' instance for 'Vec'.
--
-- > vec_concise (Vec (V_Id 0) 1 [0]) == "vec(0,1)"
vec_concise :: Vec a -> String
vec_concise (Vec (V_Id k) n _) = concat ["vec(",show k,",",show n,")"]

-- * K

-- | Sum type for wire values.
-- N = nil, B = boolean, I = integer, F = floating point, V = vector (array).
data K = N ()
       | B Bool
       | I Int32
       | F Float
       | V (Vec Float)
           deriving(Eq)

-- | 'Typeable' instance for 'K'.
--
-- map k_typeOf [B False,I 0,F 0.0] == [bool_t,int32_t,float_t]
k_typeOf :: K -> TypeRep
k_typeOf k =
    case k of
      N () -> nil_t
      B _ -> bool_t
      I _ -> int32_t
      F _ -> float_t
      V _ -> vec_float_t

deriving instance Typeable K -- where typeRep = k_typeOf

-- | Concise pretty printer and 'Show' instance for 'K'.
k_concise :: K -> String
k_concise k =
    case k of
      N () -> "()"
      B b -> show b
      I i -> show i
      F f -> show f
      V v -> vec_concise v

instance Show K where show = k_concise

-- * TypeRep constants

-- | 'typeOf' @()@.
nil_t :: TypeRep
nil_t = typeOf ()

-- | 'typeOf' of 'Bool'.
bool_t :: TypeRep
bool_t = typeOf (undefined::Bool)

-- | 'typeOf' of 'Int32'.
int32_t :: TypeRep
int32_t = typeOf (undefined::Int32)

-- | 'typeOf' of 'Float'.
float_t :: TypeRep
float_t = typeOf (undefined::Float)

-- | 'typeOf' of ('Vec' 'Float').
vec_float_t :: TypeRep
vec_float_t = typeOf (undefined::Vec Float)

-- * Type classes

-- | Class for values that can be lifted to 'K'.
class (Typeable a,Eq a,Ord a,Show a) => K' a where
    to_k :: a -> K

instance K' () where to_k () = N ()
instance K' Bool where to_k b = B b
instance K' Int32 where to_k i = I i
instance K' Float where to_k f = F f
instance K' (Vec Float) where to_k v = V v

-- | Composite of 'Ord' and `K'`.
class (K' a,Ord a) => K_Ord a where
instance K_Ord Bool
instance K_Ord Int32
instance K_Ord Float

-- | Composite of 'K_Ord' and 'Num'.
class (K_Ord a,Num a) => K_Num a where
instance K_Num Int32
instance K_Num Float