{-# LANGUAGE 
        MultiParamTypeClasses, 
        TypeSynonymInstances, 
        FlexibleContexts #-}

module CsoundExpr.Translator.Types (
   Time, Dur,	
   Id,   
   ExprLayer, LaExpr, 
   mkLayer, layerOut, layerOp, layerIn,
   GlobalInits,
   FtableId, FtableInfo,
   Instr, MidiInstr, InstrOrder, InstrOrderInfo,
   Note, ValueId,
   SignalOut(..), outList, fromSignalOut,
   Header, SignalInit(..),
   Arate(..), Krate(..), Irate(..), X(..), K(..), MO(..),
   BoolRate(..), 
   toValue, toCsRate, gRate, isArgOut 
)
where

import qualified Data.Set as Set
import qualified Data.Map as Map

import CsoundExpr.Translator.ExprTree.ExprTree
import CsoundExpr.Translator.Cs.IM
import qualified CsoundExpr.Translator.Cs.CsTree     as La
import qualified CsoundExpr.Translator.Cs.CsoundFile as Cs
import CsoundExpr.Translator.Cs.CsBoolean 

type Time = Double
type Dur  = Time


-- exprSeq

--type CsExprSeq   = ExprSeq   La.Rate La.CsExpr
--type CsExprLayer = ExprLayer [(La.Rate, Id)] La.CsExpr Int

type LaExpr = Expr La.Label La.Rate La.CsExpr

-- type ExprSeq   a b = [ExprLayer [(a, Id)] b Id]
type ExprLayer a b c = (a, (b, [c]))

layerOut (a, (b, c)) = a
layerOp  (a, (b, c)) = b
layerIn  (a, (b, c)) = c

mkLayer a b c = (a, (b, c))

-- globals

type GlobalInits = Set.Set (La.Name, La.Rate)

-- ftables

type FtableId   = (Purity Id, La.Ftable)
type FtableInfo = Map.Map FtableId Id

-- instr

type Instr      = [La.CsTree]
type MidiInstr  = Instr
type InstrOrder = [Instr]

type InstrOrderInfo = Map.Map Instr Id

-- scores

type Note     = (Time, Time, [ValueId])
type ValueId  = (Purity Id, La.Value)

-- rates

-- | audio signal 
data Arate = Arate La.CsTree

-- | control signal 
data Krate = Krate La.CsTree

-- | init variable
data Irate = Irate La.CsTree


-- | boolean signal. Type for comparison of control or init rate signals.
data BoolRate = BoolRate CsBool

-- rate classes

-- IM

instance IM La.CsTree Arate where
    from = Arate . mapType (const [La.A])
    to (Arate t) = t


instance IM La.CsTree Krate where
    from = Krate . mapType (const [La.K])
    to (Krate t) = t


instance IM La.CsTree Irate where
    from = Irate . mapType (const [La.I])
    to (Irate t) = t


instance IM La.CsTree String where
    from x = error "from string is undefined"
    to     = La.string

-- MO

class MO a where
    rateMO :: [La.Rate] -> a -> a

instance MO Arate where
    rateMO rs (Arate x) = Arate $ mapType (const rs) x

instance MO Krate where
    rateMO rs (Krate x) = Krate $ mapType (const rs) x

instance MO Irate where
    rateMO rs (Irate x) = Irate $ mapType (const rs) x

-- X, K

-- | 'X' = 'Arate' | 'Krate' | 'Irate'
class (IM La.CsTree a, MO a) => X a where
  	arate :: a -> Arate
	krate :: a -> Krate
	irate :: a -> Irate


-- | 'K' = 'Krate' | 'Irate'
class X a => K a

instance X Arate where
	arate = id
	krate = from . pure (La.opc "downsamp") . return . toCsTree
	irate = from . pure (La.opr ["i(", ")"])  . return . toCsTree . krate 

instance X Krate where
	arate = from . pure (La.opc "upsamp") . return . toCsTree
	krate = id
	irate = from . pure (La.opr ["i(", ")"]) . return . toCsTree
	
instance X Irate where
	arate = from . pure (La.opc "upsamp")  . return . toCsTree
	krate = from . pure (La.opr ["k(", ")"]) . return . toCsTree
	irate = id

toCsTree :: X a => a -> La.CsTree
toCsTree = to

instance K Krate
instance K Irate

-- signal out

-- | Output of opcodes that produce no value in csound code (out, outs, xtratim, etc.)
data SignalOut = SignalOut Instr
                 deriving (Eq, Ord)

-- | Join several output opcodes
--
-- Example :
-- 
-- >        instr q
-- > a1     upsamp   1
-- >        out      a1
-- > gaSig  =        a1
-- >        endin
--
-- > q = outList [out x, gar "Sig" <=> x]
-- >         where x = upsamp $ num 1
--
outList :: [SignalOut] -> SignalOut
outList = SignalOut . (fromSignalOut =<< )


fromSignalOut :: SignalOut -> Instr
fromSignalOut (SignalOut x) = x

-- signal init

-- | Header section
type Header = [SignalInit]

data SignalInit = Instr0 SignalOut
                | Massign   [Int] Int SignalOut
                | Pgmassign [Int] Int SignalOut
                | InstrOrder [SignalOut]
                  deriving (Eq, Ord)

-------------------------------------------------------
-- predicates

isArgOut :: ExprLayer Int LaExpr Int -> Bool
isArgOut x = (not $ null $ layerIn x) && (La.isArg $ exprOp $ exprTag $ layerOp x) 

-------------------------------------------------------
-- converters


toValue :: La.Value -> Cs.Value
toValue x =  case x of
               (La.ValueDouble v)  ->  Cs.ValueDouble v
               (La.ValueString v)  ->  Cs.ValueString v
               (La.ValueInt    v)  ->  Cs.ValueInt    v


toCsRate :: La.Rate -> Cs.Rate
toCsRate x = 
    case x of
      La.A -> Cs.A
      La.K -> Cs.K
      La.I -> Cs.I
      La.S -> Cs.S
              
      La.GA -> Cs.GA
      La.GK -> Cs.GK
      La.GI -> Cs.GI
      La.GS -> Cs.GS
               
      La.SetupRate -> Cs.SetupRate
              


gRate :: Cs.Rate -> Cs.Rate
gRate x = case x of
            Cs.A -> Cs.GA
            Cs.K -> Cs.GK
            Cs.I -> Cs.GI