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

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


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

instance Type' t' => Tree (SmType'CaseCT t')
instance Type' t' => WithBody t' (SmType'CaseCT t')
    where body :: SmType'CaseCT t' -> t'
body (SmType'CaseT'C t'
_ t'
b) = t'
b
instance Type' t' => CaseTree t' t' (SmType'CaseCT t')
    where pat :: SmType'CaseCT t' -> t'
pat (SmType'CaseT'C t'
p t'
_) = t'
p
instance Type' t' => Type'Case t' (SmType'CaseCT t')

--------------------------------------------------------------------------- F --

instance Type' t' => Tree (FuncParamClause' t')
instance Type' t' => SyntaxValuesClauses t' (FuncParamClause' t')
    where values :: FuncParamClause' t' -> [t']
values (FuncParamClause' [t']
vs) = [t']
vs

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

instance Type' t' => Tree (SmArgClauseT' t')
instance Type' t' => SyntaxValuesClauses t' (SmArgClauseT' t')
    where values :: SmArgClauseT' t' -> [t']
values (SmArgClauseT' [t']
vs) = [t']
vs
instance Type' t' => ArgClause t' (SmArgClauseT' t')
instance Type' t' => ArgClauseT' t' (SmArgClauseT' t')


instance Type' t' => Tree (SmBounds' t')
instance Type' t' => Bounds' t' (SmBounds' t')
    where lo :: SmBounds' t' -> Maybe t'
lo (SmBounds' Maybe t'
l Maybe t'
_) = Maybe t'
l
          hi :: SmBounds' t' -> Maybe t'
hi (SmBounds' Maybe t'
_ Maybe t'
h) = Maybe t'
h


instance ( NameT' t'n
         , ParamClauseT' m n p' t' b' pc'
         ) => Tree (SmType'Def m n t'n p' t' b' pc')
instance ( NameT' t'n
         , ParamClauseT' m n p' t' b' pc'
         ) => Member t'n (SmType'Def m n t'n p' t' b' pc')
    where name :: SmType'Def m n t'n p' t' b' pc' -> t'n
name (T'DType' (SmType'S [m]
_ t'n
n pc'
_ b'
_)) = t'n
n
          name (T'DType (SmTypeS [m]
_ t'n
n pc'
_ t'
_ b'
_)) = t'n
n
instance ( NameT' t'n
         , ParamClauseT' m n p' t' b' pc'
         ) => MemberT' t'n (SmType'Def m n t'n p' t' b' pc')
instance ( NameT' t'n
         , ParamClauseT' m n p' t' b' pc'
         ) => WithMods m (SmType'Def m n t'n p' t' b' pc')
    where mods :: SmType'Def m n t'n p' t' b' pc' -> [m]
mods (T'DType' (SmType'S [m]
ms t'n
_ pc'
_ b'
_)) = [m]
ms
          mods (T'DType (SmTypeS [m]
ms t'n
_ pc'
_ t'
_ b'
_)) = [m]
ms
instance ( NameT' t'n
         , ParamClauseT' m n p' t' b' pc'
         ) => WithT'ParamClause m n p' t' b' pc' (SmType'Def m n t'n p' t' b' pc')
    where t'paramClause :: SmType'Def m n t'n p' t' b' pc' -> pc'
t'paramClause (T'DType' (SmType'S [m]
_ t'n
_ pc'
pc b'
_)) = pc'
pc
          t'paramClause (T'DType (SmTypeS [m]
_ t'n
_ pc'
pc t'
_ b'
_)) = pc'
pc
instance ( NameT' t'n
         , ParamClauseT' m n p' t' b' pc'
         ) => Type'Def m n t'n p' t' b' pc' (SmType'Def m n t'n p' t' b' pc')
    where bounds' :: SmType'Def m n t'n p' t' b' pc' -> b'
bounds' (T'DType' (SmType'S [m]
_ t'n
_ pc'
_ b'
bs)) = b'
bs
          bounds' (T'DType (SmTypeS [m]
_ t'n
_ pc'
_ t'
_ b'
bs)) = b'
bs


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

instance ( NameT' t'n
         , Type' t'
         ) => Tree (SmApplyInfixT' t'n t')
instance ( NameT' t'n
         , Type' t'
         ) => Infix t' t'n t' (SmApplyInfixT' t'n t')
    where lhs :: SmApplyInfixT' t'n t' -> t'
lhs (SmApplyInfixT' t'
l t'n
_ t'
_) = t'
l
          op :: SmApplyInfixT' t'n t' -> t'n
op  (SmApplyInfixT' t'
_ t'n
op t'
_) = t'n
op
          arg :: SmApplyInfixT' t'n t' -> t'
arg (SmApplyInfixT' t'
_ t'n
_ t'
r) = t'
r

instance Type' t' => Tree (SmContextFunctionT' t')
instance Type' t' => WithBody t' (SmContextFunctionT' t')
    where body :: SmContextFunctionT' t' -> t'
body (SmContextFunctionT' FuncParamClause' t'
_ t'
r) = t'
r
instance Type' t' => Function t' (FuncParamClause' t') t' (SmContextFunctionT' t')
    where paramClause :: SmContextFunctionT' t' -> FuncParamClause' t'
paramClause (SmContextFunctionT' FuncParamClause' t'
pc t'
_) = FuncParamClause' t'
pc
instance ( Type' t'
         ) => FunctionT' t' (SmContextFunctionT' t')
    where res :: SmContextFunctionT' t' -> t'
res (SmContextFunctionT' FuncParamClause' t'
_ t'
r) = t'
r

instance ( Type' t'
         , Stat s
         ) => Tree (SmExistentialT' t' s)
instance ( Type' t'
         , Stat s
         ) => WithExprs s (SmExistentialT' t' s)
    where exprs :: SmExistentialT' t' s -> [s]
exprs (SmExistentialT' t'
_ [s]
ss) = [s]
ss
instance ( Type' t'
         , Stat s
         ) => WithStats s (SmExistentialT' t' s)

instance Type' t' => Tree (SmFunctionT' t')
instance Type' t' => WithBody t' (SmFunctionT' t')
    where body :: SmFunctionT' t' -> t'
body (SmFunctionT' FuncParamClause' t'
_ t'
r) = t'
r
instance Type' t' => Function t' (FuncParamClause' t') t' (SmFunctionT' t')
    where paramClause :: SmFunctionT' t' -> FuncParamClause' t'
paramClause (SmFunctionT' FuncParamClause' t'
pc t'
_) = FuncParamClause' t'
pc
instance ( Type' t'
         ) => FunctionT' t' (SmFunctionT' t')
    where res :: SmFunctionT' t' -> t'
res (SmFunctionT' FuncParamClause' t'
_ t'
r) = t'
r

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

instance Term t => Tree (SmMacroT' t)
instance Term t => WithBody t (SmMacroT' t)
    where body :: SmMacroT' t -> t
body (SmMacroT' t
b) = t
b

instance Type'Case t' ct => Tree (SmMatchT' t' ct)
instance ( Tree ct
         , Type'Case t' ct
         ) => WithExprs ct (SmMatchT' t' ct)
    where exprs :: SmMatchT' t' ct -> [ct]
exprs (SmMatchT' t'
_ [ct]
cs) = [ct]
cs
instance Type'Case t' ct => WithCases t' t' ct (SmMatchT' t' ct)

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

instance ( Type' t'
         , Stat s
         ) => Tree (SmRefineT' t' s)
instance ( Type' t'
         , Stat s
         ) => WithExprs s (SmRefineT' t' s)
    where exprs :: SmRefineT' t' s -> [s]
exprs (SmRefineT' Maybe t'
_ [s]
ss) = [s]
ss
instance ( Type' t'
         , Stat s
         ) => WithStats s (SmRefineT' t' s)

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

instance NameT' n => Tree (SmVarT' n)
instance NameT' n => Member n (SmVarT' n)
    where name :: SmVarT' n -> n
name (SmVarT' n
n) = n
n
instance NameT' n => MemberT' n (SmVarT' n)


instance Tree SmType'
instance Type' SmType'


instance ( Mod m
         , Name n
         , Bounds' t' b'
         ) => Tree (SmParamT' m n t' b')
instance ( Mod m
         , Name n
         , Bounds' t' b'
         ) => Member n (SmParamT' m n t' b')
    where name :: SmParamT' m n t' b' -> n
name (SmParamT' [m]
_ n
n pc'
_ b'
_ [t']
_ [t']
_) = n
n
instance ( Mod m
         , Name n
         , Bounds' t' b'
         ) => Param m n (SmParamT' m n t' b')
    where mods' :: SmParamT' m n t' b' -> [m]
mods' (SmParamT' [m]
ms n
_ pc'
_ b'
_ [t']
_ [t']
_) = [m]
ms
instance ( p' ~ SmParamT' m n t' b'
         , pc' ~ SmParamClauseT' m n p' t' b'
         , Mod m
         , Name n
         , Bounds' t' b'
         , ParamT' m n p' t' b' pc'
         , ParamClauseT' m n p' t' b' pc'
         ) => WithT'ParamClause m n p' t' b' pc' (SmParamT' m n t' b')
    where t'paramClause :: SmParamT' m n t' b' -> pc'
t'paramClause (SmParamT' [m]
_ n
_ pc'
t'pc b'
_ [t']
_ [t']
_) = pc'
pc'
t'pc
instance ( p' ~ SmParamT' m n t' b'
         , pc' ~ SmParamClauseT' m n p' t' b'
         , Mod m
         , Name n
         , Bounds' t' b'
         ) => ParamT' m n (SmParamT' m n t' b') t' b' pc'
    where tbounds' :: SmParamT' m n t' b' -> b'
tbounds' (SmParamT' [m]
_ n
_ pc'
_ b'
tbs [t']
_ [t']
_) = b'
tbs
          vbounds' :: SmParamT' m n t' b' -> [t']
vbounds' (SmParamT' [m]
_ n
_ pc'
_ b'
_ [t']
vbs [t']
_) = [t']
vbs
          cbounds' :: SmParamT' m n t' b' -> [t']
cbounds' (SmParamT' [m]
_ n
_ pc'
_ b'
_ [t']
_ [t']
cbs) = [t']
cbs


instance ( Mod m
         , Name n
         , Bounds' t' b'
         ) => Tree (SmParamClauseT' m n p' t' b')
instance ( p' ~ SmParamT' m n t' b'
         , Mod m
         , Name n
         , Bounds' t' b'
         ) => SyntaxValuesClauses p' (SmParamClauseT' m n p' t' b')
    where values :: SmParamClauseT' m n p' t' b' -> [p']
values (SmParamClauseT' [p']
vs) = [p']
vs
instance ( p' ~ SmParamT' m n t' b'
         , Mod m
         , Name n
         , Bounds' t' b'
         ) => ParamClause m n p' (SmParamClauseT' m n p' t' b')
instance ( p' ~ SmParamT' m n t' b'
         , Mod m
         , Name n
         , Bounds' t' b'
         ) => ParamClauseT' m n p' t' b' (SmParamClauseT' m n p' t' b')