{-# Language FlexibleInstances #-}

{- | Unique identifier types and classes.
Used by non-deterministic (noise) and non-sharable (demand) unit generators.
-}
module Sound.Sc3.Common.Uid where

import Data.Functor.Identity {- base -}
import Data.List {- base -}
import qualified Data.Unique as Unique {- base -}

import qualified Control.Monad.Trans.Reader as Reader {- transformers -}
import qualified Control.Monad.Trans.State as State {- transformers -}

import qualified Data.Digest.Murmur32 as Murmur32 {- murmur-hash -}

import qualified Sound.Sc3.Common.Base as Base {- hsc3 -}

-- * Id & Uid

-- | Identifiers are integers.
type Id = Int

-- | 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

-- | Requires FlexibleInstances.
instance Uid (State.StateT Int Identity) where
    generateUid :: StateT Int Identity Int
generateUid = forall (m :: * -> *) s. Monad m => StateT s m s
State.get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
n -> forall (m :: * -> *) s. Monad m => s -> StateT s m ()
State.put (Int
n forall a. Num a => a -> a -> a
+ Int
1) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Int
n

instance Uid IO where
    generateUid :: IO Int
generateUid = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Unique -> Int
Unique.hashUnique IO Unique
Unique.newUnique

instance Uid m => Uid (Reader.ReaderT t m) where
   generateUid :: ReaderT t m Int
generateUid = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
Reader.ReaderT (forall a b. a -> b -> a
const forall (m :: * -> *). Uid m => m Int
generateUid)

-- * Uid_St

-- | 'State.State' Uid.
type Uid_St = State.State Int

-- | Alias for 'runIdentity'.
uid_id_eval :: Identity t -> t
uid_id_eval :: forall t. Identity t -> t
uid_id_eval = forall t. Identity t -> t
runIdentity

{- | 'State.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 :: forall t. Uid_St t -> t
uid_st_eval Uid_St t
x = forall s a. State s a -> s -> a
State.evalState Uid_St t
x Int
0

-- | Thread state through sequence of 'State.runState'.
uid_st_seq :: [Uid_St t] -> ([t],Int)
uid_st_seq :: forall t. [Uid_St t] -> ([t], Int)
uid_st_seq =
    let swap :: (b, a) -> (a, b)
swap (b
p,a
q) = (a
q,b
p)
        step_f :: a -> State a b -> (a, b)
step_f a
n State a b
x = forall {b} {a}. (b, a) -> (a, b)
swap (forall s a. State s a -> s -> (a, s)
State.runState State a b
x a
n)
    in forall {b} {a}. (b, a) -> (a, b)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL forall {a} {b}. a -> State a b -> (a, b)
step_f Int
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_ :: forall t. [Uid_St t] -> [t]
uid_st_seq_ = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. [Uid_St t] -> ([t], Int)
uid_st_seq

-- * Lift

-- | Unary Uid lift.
liftUid1 :: Uid m => (Int -> Base.Fn1 a b) -> Base.Fn1 a (m b)
liftUid1 :: forall (m :: * -> *) a b. Uid m => (Int -> Fn1 a b) -> Fn1 a (m b)
liftUid1 Int -> Fn1 a b
fn a
a = do
  Int
z <- forall (m :: * -> *). Uid m => m Int
generateUid
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Fn1 a b
fn Int
z a
a)

-- | Binary Uid lift.
liftUid2 :: Uid m => (Int -> Base.Fn2 a b c) -> Base.Fn2 a b (m c)
liftUid2 :: forall (m :: * -> *) a b c.
Uid m =>
(Int -> Fn2 a b c) -> Fn2 a b (m c)
liftUid2 Int -> Fn2 a b c
fn a
a b
b = do
  Int
z <- forall (m :: * -> *). Uid m => m Int
generateUid
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Fn2 a b c
fn Int
z a
a b
b)

-- | Ternary Uid lift.
liftUid3 :: Uid m => (Int -> Base.Fn3 a b c d) -> Base.Fn3 a b c (m d)
liftUid3 :: forall (m :: * -> *) a b c d.
Uid m =>
(Int -> Fn3 a b c d) -> Fn3 a b c (m d)
liftUid3 Int -> Fn3 a b c d
fn a
a b
b c
c = do
  Int
z <- forall (m :: * -> *). Uid m => m Int
generateUid
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Fn3 a b c d
fn Int
z a
a b
b c
c)

-- | Quaternary Uid lift.
liftUid4 :: Uid m => (Int -> Base.Fn4 a b c d e) -> Base.Fn4 a b c d (m e)
liftUid4 :: forall (m :: * -> *) a b c d e.
Uid m =>
(Int -> Fn4 a b c d e) -> Fn4 a b c d (m e)
liftUid4 Int -> Fn4 a b c d e
fn a
a b
b c
c d
d = do
  Int
z <- forall (m :: * -> *). Uid m => m Int
generateUid
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Fn4 a b c d e
fn Int
z a
a b
b c
c d
d)

-- | 5-parameter Uid lift.
liftUid5 :: Uid m => (Int -> Base.Fn5 a b c d e f) -> Base.Fn5 a b c d e (m f)
liftUid5 :: forall (m :: * -> *) a b c d e f.
Uid m =>
(Int -> Fn5 a b c d e f) -> Fn5 a b c d e (m f)
liftUid5 Int -> Fn5 a b c d e f
fn a
a b
b c
c d
d e
e = do
  Int
z <- forall (m :: * -> *). Uid m => m Int
generateUid
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Fn5 a b c d e f
fn Int
z a
a b
b c
c d
d e
e)

-- | 6-parameter Uid lift.
liftUid6 :: Uid m => (Int -> Base.Fn6 a b c d e f g) -> Base.Fn6 a b c d e f (m g)
liftUid6 :: forall (m :: * -> *) a b c d e f g.
Uid m =>
(Int -> Fn6 a b c d e f g) -> Fn6 a b c d e f (m g)
liftUid6 Int -> Fn6 a b c d e f g
fn a
a b
b c
c d
d e
e f
f = do
  Int
z <- forall (m :: * -> *). Uid m => m Int
generateUid
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Fn6 a b c d e f g
fn Int
z a
a b
b c
c d
d e
e f
f)

-- | 10-parameter Uid lift.
liftUid10 :: Uid m => (Int -> Base.Fn10 a b c d e f g h i j k) -> Base.Fn10 a b c d e f g h i j (m k)
liftUid10 :: forall (m :: * -> *) a b c d e f g h i j k.
Uid m =>
(Int -> Fn10 a b c d e f g h i j k)
-> Fn10 a b c d e f g h i j (m k)
liftUid10 Int -> Fn10 a b c d e f g h i j k
fn a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j = do
  Int
z <- forall (m :: * -> *). Uid m => m Int
generateUid
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Fn10 a b c d e f g h i j k
fn Int
z a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j)

-- | 11-parameter Uid lift.
liftUid11 :: Uid m => (Int -> Base.Fn11 a b c d e f g h i j k l) -> Base.Fn11 a b c d e f g h i j k (m l)
liftUid11 :: forall (m :: * -> *) a b c d e f g h i j k l.
Uid m =>
(Int -> Fn11 a b c d e f g h i j k l)
-> Fn11 a b c d e f g h i j k (m l)
liftUid11 Int -> Fn11 a b c d e f g h i j k l
fn a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k = do
  Int
z <- forall (m :: * -> *). Uid m => m Int
generateUid
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Fn11 a b c d e f g h i j k l
fn Int
z a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k)

-- * ID

{- | Typeclass to constrain Ugen identifiers.
Char inputs are hashed to generate longer seeds for when ir (constant) random Ugens are optimised.

> map resolveID [0::Int,1] == [0, 1]
> map resolveID ['α', 'β'] == [1439603815, 4131151318]
> map resolveID [('α', 'β'),('β', 'α')] == [3538183581, 3750624898]
> map resolveID [('α',('α', 'β')),('β',('α', 'β'))] == [0020082907, 2688286317]
> map resolveID [('α', 'α', 'β'),('β', 'α', 'β')] == [0020082907, 2688286317]
-}
class Murmur32.Hashable32 a => ID a where
    resolveID :: a -> Id
    resolveID = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash32 -> Word32
Murmur32.asWord32 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Hashable32 a => a -> Hash32
Murmur32.hash32

instance ID Char where
instance ID Int where resolveID :: Int -> Int
resolveID = forall a. a -> a
id
instance (ID p,ID q) => ID (p,q) where
instance (ID p,ID q,ID r) => ID (p,q,r) where

{- | /n/ identifiers from /x/.

> id_seq 10 'α' == [1439603815 .. 1439603824]
-}
id_seq :: ID a => Int -> a -> [Id]
id_seq :: forall a. ID a => Int -> a -> [Int]
id_seq Int
n a
x = forall a. Int -> [a] -> [a]
take Int
n [forall a. ID a => a -> Int
resolveID a
x ..]