{-# LANGUAGE FlexibleInstances #-} -- | Unique identifier class for use by non-deterministic (noise) and -- non-sharable (demand) unit generators. module Sound.SC3.UGen.UId where import Control.Monad {- base -} import Data.Functor.Identity {- base -} import Data.List {- base -} import qualified Data.Unique as U {- base -} import qualified Control.Monad.Trans.Reader as R {- transformers -} import qualified Control.Monad.Trans.State as S {- transformers -} import Sound.SC3.UGen.Type {- hsc3 -} -- | A class indicating a monad (and functor and applicative) that will -- generate a sequence of unique integer identifiers. class (Functor m,Applicative m,Monad m) => UId m where generateUId :: m Int -- | 'S.State' UId. type UId_ST = S.State Int -- | 'S.evalState' with initial state of zero. -- -- > uid_st_eval (replicateM 3 generateUId) == [0,1,2] uid_st_eval :: UId_ST t -> t uid_st_eval x = S.evalState x 0 -- | Thread state through sequence of 'S.runState'. uid_st_seq :: [UId_ST t] -> ([t],Int) uid_st_seq = let swap (p,q) = (q,p) step_f n x = swap (S.runState x n) in swap . mapAccumL step_f 0 -- | 'fst' of 'uid_st_seq'. -- -- > uid_st_seq_ (replicate 3 generateUId) == [0,1,2] uid_st_seq_ :: [UId_ST t] -> [t] uid_st_seq_ = fst . uid_st_seq instance UId (S.StateT Int Identity) where generateUId = S.get >>= \n -> S.put (n + 1) >> return n instance UId IO where generateUId = liftM U.hashUnique U.newUnique instance UId m => UId (R.ReaderT t m) where generateUId = R.ReaderT (const generateUId) -- * Lift -- | Unary function. type Fn1 a b = a -> b -- | Binary function. type Fn2 a b c = a -> b -> c -- | Ternary function. type Fn3 a b c d = a -> b -> c -> d -- | Quaternary function. type Fn4 a b c d e = a -> b -> c -> d -> e -- | Unary UId lift. liftUId :: UId m => (Int -> Fn1 a b) -> Fn1 a (m b) liftUId f a = do n <- generateUId return (f n a) -- | Binary UId lift. liftUId2 :: UId m => (Int -> Fn2 a b c) -> Fn2 a b (m c) liftUId2 f a b = do n <- generateUId return (f n a b) -- | Ternary UId lift. liftUId3 :: UId m => (Int -> Fn3 a b c d) -> Fn3 a b c (m d) liftUId3 f a b c = do n <- generateUId return (f n a b c) -- | Quaternary UId lift. liftUId4 :: UId m => (Int -> Fn4 a b c d e) -> Fn4 a b c d (m e) liftUId4 f a b c d = do n <- generateUId return (f n a b c d) -- * Clone -- | Clone a unit generator (mce . replicateM). clone :: (UId m) => Int -> m UGen -> m UGen clone n = liftM mce . replicateM n