{-# 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 = StateT Int Identity Int
forall (m :: * -> *) s. Monad m => StateT s m s
State.get StateT Int Identity Int
-> (Int -> StateT Int Identity Int) -> StateT Int Identity Int
forall a b.
StateT Int Identity a
-> (a -> StateT Int Identity b) -> StateT Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
n -> Int -> StateT Int Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
State.put (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) StateT Int Identity ()
-> StateT Int Identity Int -> StateT Int Identity Int
forall a b.
StateT Int Identity a
-> StateT Int Identity b -> StateT Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> StateT Int Identity Int
forall a. a -> StateT Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n

instance Uid IO where
  generateUid :: IO Int
generateUid = (Unique -> Int) -> IO Unique -> IO Int
forall a b. (a -> b) -> IO a -> IO b
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 = (t -> m Int) -> ReaderT t m Int
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
Reader.ReaderT (m Int -> t -> m Int
forall a b. a -> b -> a
const m Int
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 = Identity t -> t
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 = Uid_St t -> Int -> t
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 = (b, a) -> (a, b)
forall {b} {a}. (b, a) -> (a, b)
swap (State a b -> a -> (b, a)
forall s a. State s a -> s -> (a, s)
State.runState State a b
x a
n)
  in (Int, [t]) -> ([t], Int)
forall {b} {a}. (b, a) -> (a, b)
swap ((Int, [t]) -> ([t], Int))
-> ([Uid_St t] -> (Int, [t])) -> [Uid_St t] -> ([t], Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Uid_St t -> (Int, t)) -> Int -> [Uid_St t] -> (Int, [t])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Int -> Uid_St t -> (Int, t)
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_ = ([t], Int) -> [t]
forall a b. (a, b) -> a
fst (([t], Int) -> [t])
-> ([Uid_St t] -> ([t], Int)) -> [Uid_St t] -> [t]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Uid_St t] -> ([t], Int)
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 <- m Int
forall (m :: * -> *). Uid m => m Int
generateUid
  b -> m b
forall a. a -> m a
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 <- m Int
forall (m :: * -> *). Uid m => m Int
generateUid
  c -> m c
forall a. a -> m a
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 <- m Int
forall (m :: * -> *). Uid m => m Int
generateUid
  d -> m d
forall a. a -> m a
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 <- m Int
forall (m :: * -> *). Uid m => m Int
generateUid
  e -> m e
forall a. a -> m a
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 <- m Int
forall (m :: * -> *). Uid m => m Int
generateUid
  f -> m f
forall a. a -> m a
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 <- m Int
forall (m :: * -> *). Uid m => m Int
generateUid
  g -> m g
forall a. a -> m a
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 <- m Int
forall (m :: * -> *). Uid m => m Int
generateUid
  k -> m k
forall a. a -> m a
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 <- m Int
forall (m :: * -> *). Uid m => m Int
generateUid
  l -> m l
forall a. a -> m a
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 = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> (a -> Word32) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash32 -> Word32
Murmur32.asWord32 (Hash32 -> Word32) -> (a -> Hash32) -> a -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Hash32
forall a. Hashable32 a => a -> Hash32
Murmur32.hash32

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

{- | /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 = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
n [a -> Int
forall a. ID a => a -> Int
resolveID a
x ..]