module Csound.Exp(
    E, RatedExp(..), RatedVar(..), onExp, Exp, toPrimOr, PrimOr(..), MainExp(..), Name,
    VarType(..), Var(..), Info(..), OpcType(..), Rate(..), 
    Signature(..), isProcedure, isInfix, isPrefix,    
    Prim(..), Tab(..), TabMap,
    Inline(..), InlineExp(..), PreInline(..),
    BoolExp, CondInfo, CondOp(..), isTrue, isFalse,    
    NumExp, NumOp(..)    
) where

import Control.Applicative
import Data.Monoid
import Data.Traversable
import Data.Foldable hiding (concat)

import Data.Map(Map)
import qualified Data.IntMap as IM
import qualified Data.Map    as M
import Data.Fix

-- | The inner representation of csound expressions.
type E = Fix RatedExp

type Name = String

data RatedExp a = RatedExp 
    { ratedExpRate      :: Maybe Rate
    , ratedExpDepends   :: Maybe a
    , ratedExpExp       :: Exp a
    } deriving (Show, Eq, Ord)

data RatedVar = RatedVar 
    { ratedVarRate :: Rate 
    , ratedVarId   :: Int 
    } deriving (Show)

onExp :: (Exp a -> Exp a) -> RatedExp a -> RatedExp a
onExp f a = a{ ratedExpExp = f (ratedExpExp a) }

data VarType = LocalVar | GlobalVar
    deriving (Show, Eq, Ord)

type Exp a = MainExp (PrimOr a)

toPrimOr :: E -> PrimOr E
toPrimOr a = PrimOr $ case ratedExpExp $ unFix a of
    ExpPrim (PString _) -> Right a
    ExpPrim p -> Left p
    _         -> Right a

newtype PrimOr a = PrimOr { unPrimOr :: Either Prim a }
    deriving (Show, Eq, Ord)

data MainExp a 
    = ExpPrim Prim
    | Tfm Info [a]
    | ConvertRate Rate Rate a
    | Select Rate Int a
    | If (CondInfo a) a a    
    | ExpBool (BoolExp a)
    | ExpNum (NumExp a)
    | ReadVar Var
    | WriteVar Var a    
    deriving (Show, Eq, Ord)  

data Var 
    = Var
        { varType :: VarType
        , varRate :: Rate
        , varName :: Name } 
    | VarVerbatim 
        { varRate :: Rate
        , varName :: Name        
        } deriving (Show, Eq, Ord)       
        

data Info = Info 
    { infoName          :: Name     
    , infoSignature     :: Signature
    , infoOpcType       :: OpcType
    , infoNextSE        :: Maybe Int
    } deriving (Show, Eq, Ord)           
  
isPrefix, isInfix, isProcedure :: Info -> Bool

isPrefix = (Prefix ==) . infoOpcType
isInfix  = (Infix  ==) . infoOpcType
isProcedure = (Procedure ==) . infoOpcType
  
data OpcType = Prefix | Infix | Procedure
    deriving (Show, Eq, Ord)

-- | The Csound rates.
data Rate = Xr | Ar | Kr | Ir | Sr | Fr
    deriving (Show, Eq, Ord, Enum, Bounded)
    
data Signature 
    = SingleRate (Map Rate [Rate])
    | MultiRate 
        { outMultiRate :: [Rate] 
        , inMultiRate  :: [Rate] } 
    deriving (Show, Eq, Ord)
 
data Prim 
    = P Int 
    | PString Int       -- >> p-string: 
    | PrimInt Int 
    | PrimDouble Double 
    | PrimTab Tab 
    | PrimString String 
    deriving (Show, Eq, Ord)
   
type TabMap = M.Map Tab Int
 
-- | Csound f-tables. You can make a value of 'Tab' with the function 'gen'.
data Tab = Tab 
    { tabSize    :: Int
    , tabGen     :: Int
    , tabArgs    :: [Double]
    } deriving (Show, Eq, Ord)

------------------------------------------------------------
-- types for arithmetic and boolean expressions

data Inline a b = Inline 
    { inlineExp :: InlineExp a
    , inlineEnv :: IM.IntMap b    
    } deriving (Show, Eq, Ord)

data InlineExp a
    = InlinePrim Int
    | InlineExp a [InlineExp a]
    deriving (Show, Eq, Ord)

data PreInline a b = PreInline a [b]
    deriving (Show, Eq, Ord)

-- booleans

type BoolExp a = PreInline CondOp a
type CondInfo a = Inline CondOp a

data CondOp  
    = TrueOp | FalseOp | Not | And | Or
    | Equals | NotEquals | Less | Greater | LessEquals | GreaterEquals
    deriving (Show, Eq, Ord)    

isTrue, isFalse :: CondInfo a -> Bool

isTrue  = isCondOp TrueOp
isFalse = isCondOp FalseOp

isCondOp op = maybe False (op == ) . getCondInfoOp

getCondInfoOp :: CondInfo a -> Maybe CondOp
getCondInfoOp x = case inlineExp x of
    InlineExp op _ -> Just op
    _ -> Nothing

-- numbers

type NumExp a = PreInline NumOp a

data NumOp 
    = Add | Sub | Neg | Mul | Div
    | Pow | Mod 
    | Sin | Cos | Sinh | Cosh | Tan | Tanh | Sininv | Cosinv | Taninv
    | Abs | Ceil | ExpOp | Floor | Frac| IntOp | Log | Log10 | Logbtwo | Round | Sqrt    
    | Ampdb | Ampdbfs | Dbamp | Dbfsamp 
    | Cpspch
    deriving (Show, Eq, Ord)

-------------------------------------------------------
-- instances for cse

instance Functor RatedExp where
    fmap f (RatedExp r d a) = RatedExp r (fmap f d) (fmap (fmap f) a)

instance Foldable RatedExp where
    foldMap f (RatedExp _ d a) = foldMap f d <> foldMap (foldMap f) a
    
instance Traversable RatedExp where
    traverse f (RatedExp r d a) = RatedExp r <$> traverse f d <*> traverse (traverse f) a

instance Functor PrimOr where
    fmap f (PrimOr a) = PrimOr (fmap f a)

instance Foldable PrimOr where
    foldMap f x = case unPrimOr x of
        Left _  -> mempty
        Right a -> f a

instance Traversable PrimOr where
    traverse f x = case unPrimOr x of
        Left  p -> pure $ PrimOr $ Left p
        Right a -> PrimOr . Right <$> f a

instance Functor MainExp where
    fmap f x = case x of
        ExpPrim p -> ExpPrim p
        Tfm t xs -> Tfm t $ map f xs
        ConvertRate ra rb a -> ConvertRate ra rb $ f a
        Select r n a -> Select r n $ f a
        If info a b -> If (fmap f info) (f a) (f b)
        ExpBool a -> ExpBool $ fmap f a
        ExpNum  a -> ExpNum  $ fmap f a
        ReadVar v -> ReadVar v
        WriteVar v a -> WriteVar v (f a)        


instance Foldable MainExp where
    foldMap f x = case x of
        ExpPrim p -> mempty
        Tfm t xs -> foldMap f xs
        ConvertRate ra rb a -> f a
        Select r n a -> f a
        If info a b -> foldMap f info <> f a <> f b
        ExpBool a -> foldMap f a
        ExpNum  a -> foldMap f a
        ReadVar v -> mempty
        WriteVar v a -> f a
        
instance Traversable MainExp where
    traverse f x = case x of
        ExpPrim p -> pure $ ExpPrim p
        Tfm t xs -> Tfm t <$> traverse f xs
        ConvertRate ra rb a -> ConvertRate ra rb <$> f a
        Select r n a -> Select r n <$> f a
        If info a b -> If <$> traverse f info <*> f a <*> f b
        ExpBool a -> ExpBool <$> traverse f a
        ExpNum  a -> ExpNum  <$> traverse f a
        ReadVar v -> pure $ ReadVar v
        WriteVar v a -> WriteVar v <$> f a

instance Functor (Inline a) where
    fmap f a = a{ inlineEnv = fmap f $ inlineEnv a }

instance Foldable (Inline a) where
    foldMap f a = foldMap f $ inlineEnv a

instance Traversable (Inline a) where
    traverse f (Inline a b) = Inline a <$> traverse f b

instance Functor (PreInline a) where
    fmap f (PreInline op as) = PreInline op $ fmap f as

instance Foldable (PreInline a) where
    foldMap f (PreInline _ as) = foldMap f as

instance Traversable (PreInline a) where
    traverse f (PreInline op as) = PreInline op <$> traverse f as



-- comments
-- 
-- p-string 
--
--    separate p-param for strings (we need it to read strings from global table) 
--    Csound doesn't permits us to use more than four string params so we need to
--    keep strings in the global table and use `strget` to read them