{-# Language FlexibleInstances #-}
module Sound.SC3.Common.UId where
import Control.Monad
import Data.Functor.Identity
import Data.List
import qualified Data.Unique as Unique
import qualified Control.Monad.Trans.Reader as Reader
import qualified Control.Monad.Trans.State as State
import qualified Data.Digest.Murmur32 as Murmur32
import qualified Sound.SC3.Common.Base as Base
type Id = Int
class (Functor m,Applicative m,Monad m) => UId m where
generateUId :: m Int
instance UId (State.StateT Int Identity) where
generateUId = State.get >>= \n -> State.put (n + 1) >> return n
instance UId IO where
generateUId = liftM Unique.hashUnique Unique.newUnique
instance UId m => UId (Reader.ReaderT t m) where
generateUId = Reader.ReaderT (const generateUId)
type UId_ST = State.State Int
uid_st_eval :: UId_ST t -> t
uid_st_eval x = State.evalState x 0
uid_st_seq :: [UId_ST t] -> ([t],Int)
uid_st_seq =
let swap (p,q) = (q,p)
step_f n x = swap (State.runState x n)
in swap . mapAccumL step_f 0
uid_st_seq_ :: [UId_ST t] -> [t]
uid_st_seq_ = fst . uid_st_seq
liftUId1 :: UId m => (Int -> Base.Fn1 a b) -> Base.Fn1 a (m b)
liftUId1 f a = do
n <- generateUId
return (f n a)
liftUId2 :: UId m => (Int -> Base.Fn2 a b c) -> Base.Fn2 a b (m c)
liftUId2 f a b = do
n <- generateUId
return (f n a b)
liftUId3 :: UId m => (Int -> Base.Fn3 a b c d) -> Base.Fn3 a b c (m d)
liftUId3 f a b c = do
n <- generateUId
return (f n a b c)
liftUId4 :: UId m => (Int -> Base.Fn4 a b c d e) -> Base.Fn4 a b c d (m e)
liftUId4 f a b c d = do
n <- generateUId
return (f n a b c d)
class Murmur32.Hashable32 a => ID a where
resolveID :: a -> Id
resolveID = fromIntegral . Murmur32.asWord32 . Murmur32.hash32
instance ID Char where
instance ID Int where
instance (ID p,ID q) => ID (p,q) where
id_seq :: ID a => Int -> a -> [Id]
id_seq n x = take n [resolveID x ..]