-- cf. SuperCollider.SoundMap
-- this module shall replace InstrumentMap in the long term
module Haskore.Interface.CSound.SoundMap where

import qualified Haskore.Interface.CSound.Orchestra as Orchestra

import Haskore.Interface.CSound.Orchestra
          (SigExp, noteDur, noteVel, notePit, pField, )
import Haskore.Interface.CSound (PField, Instrument, )

import Data.Maybe.HT (toMaybe, )
import Data.Maybe (mapMaybe, )


type SoundId = Instrument
type InstrumentId = SoundId
type DrumId = SoundId

type Attribute = PField
type AttributeList = [Attribute]
type ToSound instr = instr -> (AttributeList, SoundId)


attributeControl :: Int -> SigExp
attributeControl n = pField (6+n)


type InstrumentTable out instr = [(instr, InstrumentSigExp out)]

type InstrumentTableWithAttributes out instr = [InstrumentAssociation out instr]

type InstrumentSigExp out = SigExp -> SigExp -> SigExp -> out

data InstrumentAssociation out instr =
        InstrumentAssociation InstrumentId (instr -> Maybe AttributeList) out

lookupInstrument :: InstrumentTableWithAttributes out instr -> ToSound instr
lookupInstrument table instr =
   case mapMaybe (\(InstrumentAssociation name toAttributes _) ->
                     fmap (\ps -> (ps,name)) (toAttributes instr)) table of
      [] -> error "SuperCollider.InstrumentMap.lookup: instrument not found"
      [x] -> x
      _ -> error "SuperCollider.InstrumentMap.lookup: multiple instruments found"

instrumentTableToInstrBlocks ::
   InstrumentTableWithAttributes out instr -> [Orchestra.InstrBlock out]
instrumentTableToInstrBlocks =
   map (\(InstrumentAssociation i _ out) -> Orchestra.InstrBlock i 0 out [])

addInstrumentControls :: InstrumentSigExp out -> out
addInstrumentControls graph = graph noteDur noteVel notePit


instrumentAssociation ::
   (parameterTuple -> AttributeList) ->
   (graph -> InstrumentSigExp out) ->
      InstrumentId -> (instr -> Maybe parameterTuple) ->
      graph ->
      InstrumentAssociation out instr
instrumentAssociation makeAttributeList makeInstrumentSigExp name select graph =
   InstrumentAssociation
      name
      (fmap makeAttributeList . select)
      (addInstrumentControls $ makeInstrumentSigExp graph)


instrument ::
   InstrumentId -> (instr -> Maybe ()) -> (InstrumentSigExp out) ->
      InstrumentAssociation out instr
instrument = instrumentAssociation (\() -> []) id

-- simplified variant of 'instrument' for comparable @instrument@ types
instrumentEq :: Eq instrument =>
   InstrumentId -> instrument -> (InstrumentSigExp out) ->
      InstrumentAssociation out instrument
instrumentEq name instrumentId =
   instrument name (\x -> toMaybe (instrumentId==x) ())

instrument1 ::
   InstrumentId -> (instr -> Maybe Attribute) ->
      (SigExp -> InstrumentSigExp out) ->
      InstrumentAssociation out instr
instrument1 =
   instrumentAssociation
      (\p0 -> [p0])
      (\graph -> graph (attributeControl 0))


instrument2 ::
   InstrumentId -> (instr -> Maybe (Attribute, Attribute)) ->
      (SigExp -> SigExp -> InstrumentSigExp out) ->
      InstrumentAssociation out instr
instrument2 =
   instrumentAssociation
      (\(p0,p1) -> [p0,p1])
      (\graph -> graph
         (attributeControl 0)
         (attributeControl 1))

instrument3 ::
   InstrumentId -> (instr -> Maybe (Attribute, Attribute, Attribute)) ->
      (SigExp -> SigExp -> SigExp -> InstrumentSigExp out) ->
      InstrumentAssociation out instr
instrument3 =
   instrumentAssociation
      (\(p0,p1,p2) -> [p0,p1,p2])
      (\graph -> graph
         (attributeControl 0)
         (attributeControl 1)
         (attributeControl 2))

instrument4 ::
   InstrumentId -> (instr -> Maybe (Attribute, Attribute, Attribute, Attribute)) ->
      (SigExp -> SigExp -> SigExp -> SigExp -> InstrumentSigExp out) ->
      InstrumentAssociation out instr
instrument4 =
   instrumentAssociation
      (\(p0,p1,p2,p3) -> [p0,p1,p2,p3])
      (\graph -> graph
         (attributeControl 0)
         (attributeControl 1)
         (attributeControl 2)
         (attributeControl 3))



type DrumTable out drum = [(drum, DrumSigExp out)]

type DrumTableWithAttributes out drum = [DrumAssociation out drum]

type DrumSigExp out = SigExp -> SigExp -> out

data DrumAssociation out drum =
        DrumAssociation DrumId (drum -> Maybe AttributeList) out

lookupDrum :: DrumTableWithAttributes out drum -> ToSound drum
lookupDrum table drumId =
   case mapMaybe (\(DrumAssociation name toAttributes _) ->
                     fmap (\ps -> (ps,name)) (toAttributes drumId)) table of
      [] -> error "SuperCollider.InstrumentMap.lookup: drum not found"
      [x] -> x
      _ -> error "SuperCollider.InstrumentMap.lookup: multiple drums found"

drumTableToInstrBlocks :: DrumTableWithAttributes out instr -> [Orchestra.InstrBlock out]
drumTableToInstrBlocks =
   map (\(DrumAssociation i _ out) -> Orchestra.InstrBlock i 0 out [])

addDrumControls :: DrumSigExp out -> out
addDrumControls graph = graph noteDur noteVel

drumAssociation ::
   (parameterTuple -> AttributeList) ->
   (graph -> DrumSigExp out) ->
      DrumId -> (drum -> Maybe parameterTuple) ->
      graph ->
      DrumAssociation out drum
drumAssociation makeAttributeList makeDrumSigExp name select graph =
   DrumAssociation
      name
      (fmap makeAttributeList . select)
      (addDrumControls $ makeDrumSigExp graph)


drum ::
   DrumId -> (drum -> Maybe ()) -> (DrumSigExp out) ->
      DrumAssociation out drum
drum = drumAssociation (\() -> []) id

-- simplified variant of 'drum' for comparable @drum@ types
drumEq :: Eq drum =>
   DrumId -> drum -> (DrumSigExp out) ->
      DrumAssociation out drum
drumEq name drumId =
   drum name (\x -> toMaybe (drumId==x) ())

drum1 ::
   DrumId -> (drum -> Maybe Attribute) ->
      (SigExp -> DrumSigExp out) ->
      DrumAssociation out drum
drum1 =
   drumAssociation
      (\p0 -> [p0])
      (\graph -> graph (attributeControl 0))

drum2 ::
   DrumId -> (drum -> Maybe (Attribute, Attribute)) ->
      (SigExp -> SigExp -> DrumSigExp out) ->
      DrumAssociation out drum
drum2 =
   drumAssociation
      (\(p0,p1) -> [p0,p1])
      (\graph -> graph
         (attributeControl 0)
         (attributeControl 1))

drum3 ::
   DrumId -> (drum -> Maybe (Attribute, Attribute, Attribute)) ->
      (SigExp -> SigExp -> SigExp -> DrumSigExp out) ->
      DrumAssociation out drum
drum3 =
   drumAssociation
      (\(p0,p1,p2) -> [p0,p1,p2])
      (\graph -> graph
         (attributeControl 0)
         (attributeControl 1)
         (attributeControl 2))

drum4 ::
   DrumId -> (drum -> Maybe (Attribute, Attribute, Attribute, Attribute)) ->
      (SigExp -> SigExp -> SigExp -> SigExp -> DrumSigExp out) ->
      DrumAssociation out drum
drum4 =
   drumAssociation
      (\(p0,p1,p2,p3) -> [p0,p1,p2,p3])
      (\graph -> graph
         (attributeControl 0)
         (attributeControl 1)
         (attributeControl 2)
         (attributeControl 3))