{-# LANGUAGE TypeFamilies #-}
module HaScalaM.Instances.Term where

import HaScalaM.Classes
import HaScalaM.Classes.Base
import HaScalaM.Classes.Enums
import HaScalaM.Classes.Pat
import HaScalaM.Classes.Stat
import HaScalaM.Classes.Term
import HaScalaM.Classes.Type
import HaScalaM.Types.Term
import HaScalaM.Types.Tilde


--------------------------------------------------------------------------- C --

instance ( Pat p
         , Term t
         ) => Tree (SmCaseCT p t)
instance ( Pat p
         , Term t
         ) => WithBody t (SmCaseCT p t)
    where body :: SmCaseCT p t -> t
body (SmCaseC p
_ Maybe t
_ t
b) = t
b
instance ( Pat p
         , Term t
         ) => CaseTree p t (SmCaseCT p t)
    where pat :: SmCaseCT p t -> p
pat (SmCaseC p
p Maybe t
_ t
_) = p
p
instance ( Pat p
         , Term t
         ) => WithCondOpt t (SmCaseCT p t)
    where cond' :: SmCaseCT p t -> Maybe t
cond' (SmCaseC p
_ Maybe t
c t
_) = Maybe t
c
instance ( Pat p
         , Term t
         ) => Case p t (SmCaseCT p t)

--------------------------------------------------------------------------- T --

instance Tree SmTerm
instance Term SmTerm

instance ArgClauseT m t ac => Tree (SmApplyT m t ac)
instance ArgClauseT m t ac => Apply t t ac (SmApplyT m t ac)
    where fun :: SmApplyT m t ac -> t
fun       (SmApplyT t
f ac
_) = t
f
          fun       (SmApplyUsingT t
f ac
_) = t
f
          argClause :: SmApplyT m t ac -> ac
argClause (SmApplyT t
_ ac
ac) = ac
ac
          argClause (SmApplyUsingT t
_ ac
ac) = ac
ac

instance ( NameT tn
         , ArgClauseT' t' ac'
         , ArgClauseT m t ac
         ) => Tree (SmApplyInfixT m tn t t' ac' ac)
instance ( NameT tn
         , ArgClauseT' t' ac'
         , ArgClauseT m t ac
         ) => Infix t tn ac (SmApplyInfixT m tn t t' ac' ac)
    where lhs :: SmApplyInfixT m tn t t' ac' ac -> t
lhs (SmApplyInfixT t
l tn
_ ac'
_ ac
_) = t
l
          op :: SmApplyInfixT m tn t t' ac' ac -> tn
op  (SmApplyInfixT t
_ tn
n ac'
_ ac
_) = tn
n
          arg :: SmApplyInfixT m tn t t' ac' ac -> ac
arg (SmApplyInfixT t
_ tn
_ ac'
_ ac
ac) = ac
ac

instance ( Term t
         , ArgClauseT' t' ac'
         ) => Tree (SmApplyType'T t t' ac')
instance ( Term t
         , ArgClauseT' t' ac'
         ) => Apply t t' ac' (SmApplyType'T t t' ac')
    where fun :: SmApplyType'T t t' ac' -> t
fun       (SmApplyType'T t
f ac'
_) = t
f
          argClause :: SmApplyType'T t t' ac' -> ac'
argClause (SmApplyType'T t
_ ac'
ac') = ac'
ac'

instance Term t => Tree (SmAssignT t)
instance Term t => WithBody t (SmAssignT t)
    where body :: SmAssignT t -> t
body (SmAssignT t
_ t
r) = t
r

instance Stat s => Tree (SmBlockT s)
instance Stat s => WithExprs s (SmBlockT s)
    where exprs :: SmBlockT s -> [s]
exprs (SmBlockT [s]
ss) = [s]
ss
instance Stat s => WithStats s (SmBlockT s)

instance ParamClauseT m n p t' t pc => Tree (SmContextFunctionT m n p t' t pc)
instance ParamClauseT m n p t' t pc => WithBody t (SmContextFunctionT m n p t' t pc)
    where body :: SmContextFunctionT m n p t' t pc -> t
body (SmContextFunctionT pc
_ t
b) = t
b
instance ParamClauseT m n p t' t pc => Function p pc t (SmContextFunctionT m n p t' t pc)
    where paramClause :: SmContextFunctionT m n p t' t pc -> pc
paramClause (SmContextFunctionT pc
pc t
_) = pc
pc

instance Term t => Tree (SmDoT t)
instance Term t => WithBody t (SmDoT t)
    where body :: SmDoT t -> t
body (SmDoT t
b t
_) = t
b
instance Term t => WithCond t (SmDoT t)
    where cond :: SmDoT t -> t
cond (SmDoT t
_ t
c) = t
c

instance ( Enumerator e
         , Term t
         ) => Tree (SmForT e t)
instance ( Enumerator e
         , Term t
         ) => WithBody t (SmForT e t)
    where body :: SmForT e t -> t
body (SmForT [e]
_ t
b) = t
b
instance ( Enumerator e
         , Term t
         ) => WithExprs e (SmForT e t)
    where exprs :: SmForT e t -> [e]
exprs (SmForT [e]
es t
_) = [e]
es
instance ( Enumerator e
         , Term t
         ) => WithEnums e (SmForT e t)

instance ( Enumerator e
         , Term t
         ) => Tree (SmForYieldT e t)
instance ( Enumerator e
         , Term t
         ) => WithBody t (SmForYieldT e t)
    where body :: SmForYieldT e t -> t
body (SmForYieldT [e]
_ t
b) = t
b
instance ( Enumerator e
         , Term t
         ) => WithExprs e (SmForYieldT e t)
    where exprs :: SmForYieldT e t -> [e]
exprs (SmForYieldT [e]
es t
_) = [e]
es
instance ( Enumerator e
         , Term t
         ) => WithEnums e (SmForYieldT e t)

instance ParamClauseT m n p t' t pc => Tree (SmFunctionT m n p t' t pc)
instance ParamClauseT m n p t' t pc => WithBody t (SmFunctionT m n p t' t pc)
    where body :: SmFunctionT m n p t' t pc -> t
body (SmFunctionT pc
_ t
b) = t
b
instance ParamClauseT m n p t' t pc => Function p pc t (SmFunctionT m n p t' t pc)
    where paramClause :: SmFunctionT m n p t' t pc -> pc
paramClause (SmFunctionT pc
pc t
_) = pc
pc
instance ParamClauseT m n p t' t pc => FunctionT m n p pc t' t (SmFunctionT m n p t' t pc)

instance ( Mod m
         , Term t
         ) => Tree (SmIfT m t)
instance ( Mod m
         , Term t
         ) => WithCond t (SmIfT m t)
    where cond :: SmIfT m t -> t
cond (SmIfT t
c t
_ t
_ [m]
_) = t
c
instance ( Mod m
         , Term t
         ) => WithMods m (SmIfT m t)
    where mods :: SmIfT m t -> [m]
mods (SmIfT t
_ t
_ t
_ [m]
ms) = [m]
ms

instance ( Pat p
         , Term t
         , Case p t ct
         ) => Tree (SmMatchT p t ct)
instance ( Pat p
         , Term t
         , Case p t ct
         ) => WithExprs ct (SmMatchT p t ct)
    where exprs :: SmMatchT p t ct -> [ct]
exprs (SmMatchT t
_ [ct]
cs) = [ct]
cs

instance Template m n t' t ac i p s e => Tree (SmNewAnonymousT m n t' t ac i p s e)
instance Template m n t' t ac i p s e => WithTemplate m n t' t ac i p s e (SmNewAnonymousT m n t' t ac i p s e)
    where templ :: SmNewAnonymousT m n t' t ac i p s e -> e
templ (SmNewAnonymousT e
t) = e
t

instance ( Pat p
         , Term t
         , Case p t ct
         ) => Tree (SmPartialFunctionT p t ct)
instance ( Pat p
         , Term t
         , Case p t ct
         ) => WithExprs ct (SmPartialFunctionT p t ct)
    where exprs :: SmPartialFunctionT p t ct -> [ct]
exprs (SmPartialFunctionT [ct]
cs) = [ct]
cs
instance ( Pat p
         , Term t
         , Case p t ct
         ) => WithCases p t ct (SmPartialFunctionT p t ct)

instance ( ParamClauseT' m n p' t' b' pc'
         , Term t
         ) => Tree (SmPolyFunctionT m n p' t' b' pc' t)
instance ( ParamClauseT' m n p' t' b' pc'
         , Term t
         ) => WithBody t (SmPolyFunctionT m n p' t' b' pc' t)
    where body :: SmPolyFunctionT m n p' t' b' pc' t -> t
body (SmPolyFunctionT pc'
_ t
body) = t
body
instance ( ParamClauseT' m n p' t' b' pc'
         , Term t
         ) => Function p' pc' t (SmPolyFunctionT m n p' t' b' pc' t)
    where paramClause :: SmPolyFunctionT m n p' t' b' pc' t -> pc'
paramClause (SmPolyFunctionT pc'
t'pc t
_) = pc'
t'pc
instance ( ParamClauseT' m n p' t' b' pc'
         , Term t
         ) => WithT'ParamClause m n p' t' b' pc' (SmPolyFunctionT m n p' t' b' pc' t)
    where t'paramClause :: SmPolyFunctionT m n p' t' b' pc' t -> pc'
t'paramClause (SmPolyFunctionT pc'
t'pc t
_) = pc'
t'pc

instance Case p t ct => Tree (SmTryT p t ct)
instance Case p t ct => WithExprs ct (SmTryT p t ct)
    where exprs :: SmTryT p t ct -> [ct]
exprs (SmTryT t
_ [ct]
cs Maybe t
_) = [ct]
cs
instance Case p t ct => WithCases p t ct (SmTryT p t ct)

instance Term t => Tree (SmTupleT t)
instance Term t => Tuple t (SmTupleT t)
    where args :: SmTupleT t -> [t]
args (SmTupleT [t]
as) = [t]
as

instance Term t => Tree (SmWhileT t)
instance Term t => WithBody t (SmWhileT t)
    where body :: SmWhileT t -> t
body (SmWhileT t
_ t
b) = t
b
instance Term t => WithCond t (SmWhileT t)
    where cond :: SmWhileT t -> t
cond (SmWhileT t
c t
_) = t
c


instance ( ArgsType m
         , Term t
         ) => Tree (SmArgClauseT m t)
instance ( t ~ SmTerm
         , ArgsType m
         , Term t
         ) => SyntaxValuesClauses t (SmArgClauseT m t)
    where values :: SmArgClauseT m t -> [t]
values (SmArgClauseT [t]
v Maybe m
_) = [t]
v
instance ( t ~ SmTerm
         , ArgsType m
         , Term t
         ) => ArgClause t (SmArgClauseT m t)
instance ( m ~ SmMod
         , t ~ SmTerm
         , ArgsType m
         , Term t
         ) => ArgClauseT m t (SmArgClauseT m t)
    where mod :: SmArgClauseT m t -> Maybe m
mod (SmArgClauseT [t]
_ Maybe m
m) = Maybe m
m


instance ( Mod m
         , Name n
         , Type' t'
         , Term t
         ) => Tree (SmParamT m n t' t)
instance ( Mod m
         , Name n
         , Type' t'
         , Term t
         ) => Member n (SmParamT m n t' t)
    where name :: SmParamT m n t' t -> n
name (SmParamT [m]
_ n
n Maybe t'
_ Maybe t
_) = n
n
instance ( Mod m
         , Name n
         , Type' t'
         , Term t
         ) => Param m n (SmParamT m n t' t)
    where mods' :: SmParamT m n t' t -> [m]
mods' (SmParamT [m]
ms n
_ Maybe t'
_ Maybe t
_) = [m]
ms
instance ( Mod m
         , Name n
         , Type' t'
         , Term t
         ) => WithDeclTpeOpt t' (SmParamT m n t' t)
    where decltpe' :: SmParamT m n t' t -> Maybe t'
decltpe' (SmParamT [m]
_ n
_ Maybe t'
dt Maybe t
_) = Maybe t'
dt
instance ( Mod m
         , Name n
         , Type' t'
         , Term t
         ) => ParamT m n (SmParamT m n t' t) t' t
    where defaultOpt :: SmParamT m n t' t -> Maybe t
defaultOpt (SmParamT [m]
_ n
_ Maybe t'
_ Maybe t
d) = Maybe t
d


instance ( p ~ SmParamT m n t' t
         , ParamsType m
         , ParamT m n p t' t
         ) => Tree (SmParamClauseT m n p t' t)
instance ( p ~ SmParamT m n t' t
         , ParamsType m
         , ParamT m n p t' t
         ) => SyntaxValuesClauses p (SmParamClauseT m n p t' t)
    where values :: SmParamClauseT m n p t' t -> [p]
values (SmParamClauseT [p]
vs Maybe m
_) = [p]
vs
instance ( p ~ SmParamT m n t' t
         , ParamsType m
         , ParamT m n p t' t
         ) => ParamClause m n p (SmParamClauseT m n p t' t)
instance ( p ~ SmParamT m n t' t
         , ParamsType m
         , ParamT m n p t' t
         ) => ParamClauseT m n p t' t (SmParamClauseT m n p t' t)
    where mod' :: SmParamClauseT m n p t' t -> Maybe m
mod' (SmParamClauseT [p]
_ Maybe m
m) = Maybe m
m