module CsoundExpr.Translator.ExprTree.ExprTree 
   (
 -- types
    ExprTree, Expr, OutPort, Purity(..), Id, Size, Tag,
 -- constructors
    pure, unpure, outPort, singlePort,
 -- modifiers
    labelUnpure, mapRootLabel, mapTag, mapOp, mapType, mapPurity, mapPort,
 -- selectors
    exprTreeTag, exprTag, exprPurity, exprOutPort, exprOp, exprType
   ) 
where

import CsoundExpr.Translator.Cs.Utils
import CsoundExpr.Translator.ExprTree.Tree


type ExprTree a b c = Tree (Expr a b c)

data Expr a b c = Expr OutPort (Purity a) (Tag b c)
                  deriving (Show, Eq, Ord)

type OutPort  = Id

data Purity a = Pure | Unpure (Maybe a)
                deriving (Show, Eq, Ord)

type Tag a b = (Types a, Op b)
type Types a = [a]
type Op    a = a

type Id   = Int
type Size = Int


pure :: Op c -> [ExprTree a b c] -> ExprTree a b c
pure f xs = Node (Expr singlePort Pure ([], f)) xs

unpure :: Op c -> [ExprTree a b c] -> ExprTree a b c
unpure f xs = Node (Expr singlePort (Unpure Nothing) ([], f)) xs


outPort :: Int -> ExprTree a b c -> ExprTree a b c
outPort id = mapPort (const id) 

singlePort = 0

labelUnpure :: a -> ExprTree a b c -> ExprTree a b c
labelUnpure lab = mapPurity (const $ Unpure $ Just lab)


mapRootLabel :: (a -> a) -> Tree a -> Tree a
mapRootLabel f (Node v xs) = Node (f v) xs


mapTag :: (Tag b c -> Tag b c) -> ExprTree a b c -> ExprTree a b c
mapTag f = mapRootLabel $ \(Expr o p x) -> (Expr o p (f x))


mapType :: (Types b -> Types b) -> ExprTree a b c -> ExprTree a b c
mapType f = mapTag $ mapFst f

mapOp :: (Op c -> Op c) -> ExprTree a b c -> ExprTree a b c
mapOp f = mapTag $ mapSnd f

mapPurity :: (Purity a -> Purity a) -> ExprTree a b c -> ExprTree a b c
mapPurity f = mapRootLabel $ \(Expr o p x) -> (Expr o (f p) x)


mapPort :: (OutPort -> OutPort) -> ExprTree a b c -> ExprTree a b c
mapPort f = mapRootLabel $ \(Expr o p x) -> (Expr (f o) p x)

-------------------------------------------------------
-- selectors

exprTreeTag :: ExprTree a b c -> Tag b c
exprTreeTag (Node (Expr _ _ t) _) = t

exprTag     (Expr _ _ t) = t
exprPurity  (Expr _ p _) = p
exprOutPort (Expr x _ _) = x


exprType = fst
exprOp   = snd