BasicExtensions.hs

{-# LANGUAGE TypeFamilies
            ,TypeOperators
            ,MultiParamTypeClasses
            ,FlexibleContexts
            ,DeriveFunctor #-}

module Language.XDsp.Semantics.BasicExtensions (
  StringVar (..)
 ,Buffer (..)
 ,BufferR (..)
 ,VKtl (..)
 ,VBuf (..)
 ,LblBlock (..)
 ,NumArgs (..)
 ,TList (..)
 ,tlist0
 ,unTList
 ,unTList'
 ,unsafeTList
 ,defaultRunBlock
 ,Phasor (..)
 ,Oscil (..)
)

where

import           Language.XDsp.Semantics.Core
import           Data.TypeLevel.Num


-- a few very common extensions.


-- ---------------------------------
-- ---------------------------------
-- some basic extensions

-- | Support for string variables.
class Dsp repr => StringVar repr where
  data VString repr :: *
  fromStr :: String -> VString repr

-- | Audio buffer or other data table.
class Dsp repr => Buffer repr where
  type Buf repr :: *
  emptyBuffer :: Int -> repr (Buf repr)

-- | Table lookup
class Buffer repr => BufferR repr out a where
  lookupAt :: Buf repr -> a -> repr out

-- | Creates a runnable labelled block.
-- This block can only be run at compile time.  Creating runnable blocks at
-- runtime is a to-be-implemented class.
class Dsp repr => LblBlock repr where
  type ArgTag repr :: * -- type-level number to tag the length of the arglist
  type ArgTyp repr :: * -- argument type
  data Block repr  :: *
  lblBlock :: Int -> repr a -> repr (Block repr)
  runBlock :: Block repr
              -> Double
              -> Double
              -> TList (ArgTag repr) (ArgTyp repr)
              -> repr ()

-- | Gets an argument from a runnable context
class (Nat n, Nat m, m :>=: n) => NumArgs repr m n where
  getArg :: n -> repr m (INum (repr m))

data TList n a = TList [a] deriving (Eq, Show, Functor)

defaultRunBlock ::
 (ArgTag repr ~ D3, LblBlock repr) =>
  Block repr
  -> Double
  -> Double
  -> repr ()
defaultRunBlock blk st dr = runBlock blk st dr tlist0

tlist0 :: (Nat n, n :>=: D3) => TList n a
tlist0 = TList []

unTList :: TList n a -> [a]
unTList (TList l) = l

unTList' :: n -> TList n a -> [a]
unTList' _ = unTList

unsafeTList :: Nat n => n -> [a] -> TList n a
unsafeTList _ l = TList l

-- ---------------------------------
-- ---------------------------------
-- external input functions

-- | Get data from an external source
class Dsp repr => VKtl repr where
  vktl :: String -> repr (KSig repr)

-- | Create a sized buffer which is updated by an external source
class Buffer repr => VBuf repr where
  vbuf :: String -> Int -> repr (Buf repr)

-- ---------------------------------
-- ---------------------------------
-- basic audio

-- | Phasor (output sawtooth range 0-1 at specified frequency)
class Phasor repr out a where
  phasor :: a -> repr out

-- | A basic table-lookup oscillator, interpolating and non-interpolating
class Buffer repr => Oscil repr out a b where
  oscil  :: a -> b -> Buf repr -> repr out
  oscil' :: a -> b -> Buf repr -> INum repr -> repr out