{-# LANGUAGE TypeFamilies #-}
module HaScalaM.Instances.Stat.Decl where

import HaScalaM.Classes.Base
import HaScalaM.Classes.Pat
import HaScalaM.Classes.Stat
import HaScalaM.Classes.Term
import HaScalaM.Classes.Type
import HaScalaM.Classes
import HaScalaM.Types.Stat
import HaScalaM.Types.Ref
import HaScalaM.Types.Term
import HaScalaM.Types.Type
import HaScalaM.Types.Tilde
import Data.Maybe (listToMaybe)


--------------------------------------------------------------------------- D --

instance ( NameT tn
         , ParamClauseGroup m n p p' t' b' t pc pc' g
         ) => Tree (SmDef'S m n tn p p' t' b' t pc pc' g)
instance ( NameT tn
         , ParamClauseGroup m n p p' t' b' t pc pc' g
         ) => Decl (SmDef'S m n tn p p' t' b' t pc pc' g)
instance ( NameT tn
         , ParamClauseGroup m n p p' t' b' t pc pc' g
         ) => Member tn (SmDef'S m n tn p p' t' b' t pc pc' g)
    where name :: SmDef'S m n tn p p' t' b' t pc pc' g -> tn
name (SmDef'S [m]
_ tn
n [g]
_ t'
_) = tn
n
instance ( NameT tn
         , ParamClauseGroup m n p p' t' b' t pc pc' g
         ) => MemberT tn (SmDef'S m n tn p p' t' b' t pc pc' g)
instance ( NameT tn
         , ParamClauseGroup m n p p' t' b' t pc pc' g
         ) => WithMods m (SmDef'S m n tn p p' t' b' t pc pc' g)
    where mods :: SmDef'S m n tn p p' t' b' t pc pc' g -> [m]
mods (SmDef'S [m]
ms tn
_ [g]
_ t'
_) = [m]
ms
instance ( g ~ SmParamClauseGroup m n p p' t' b' t pc pc'
         , NameT tn
         , ParamClauseGroup m n p p' t' b' t pc pc' g
         ) => WithParamClauses m n p t' t pc (SmDef'S m n tn p p' t' b' t pc pc' g)
    where paramClauses :: SmDef'S m n tn p p' t' b' t pc pc' g -> [pc]
paramClauses (SmDef'S [m]
_ tn
_ [g]
gs t'
_) = case [g] -> Maybe g
forall a. [a] -> Maybe a
listToMaybe [g]
gs
                                            of Just (SmParamClauseGroup pc'
_ [pc]
pcs) -> [pc]
pcs
                                               Maybe g
Nothing                         -> []
instance ( g ~ SmParamClauseGroup m n p p' t' b' t pc pc'
         , NameT tn
         , ParamClauseGroup m n p p' t' b' t pc pc' g
         ) => WithParamClauseGroup m n p p' t' b' t pc pc' g (SmDef'S m n tn p p' t' b' t pc pc' g)
    where paramClauseGroup :: SmDef'S m n tn p p' t' b' t pc pc' g -> Maybe g
paramClauseGroup (SmDef'S [m]
_ tn
_ [g]
gs t'
_) = [g] -> Maybe g
forall a. [a] -> Maybe a
listToMaybe [g]
gs
instance ( NameT tn
         , ParamClauseGroup m n p p' t' b' t pc pc' g
         ) => WithParamClauseGroups m n p p' t' b' t pc pc' g (SmDef'S m n tn p p' t' b' t pc pc' g)
    where paramClauseGroups :: SmDef'S m n tn p p' t' b' t pc pc' g -> [g]
paramClauseGroups (SmDef'S [m]
_ tn
_ [g]
gs t'
_) = [g]
gs
instance ( NameT tn
         , ParamClauseGroup m n p p' t' b' t pc pc' g
         ) => WithDeclTpe t' (SmDef'S m n tn p p' t' b' t pc pc' g)
    where decltpe :: SmDef'S m n tn p p' t' b' t pc pc' g -> t'
decltpe (SmDef'S [m]
_ tn
_ [g]
_ t'
dt) = t'
dt

--------------------------------------------------------------------------- G --

instance ( NameT tn
         , ParamClauseGroup m n p p' t' b' t pc pc' g
         ) => Tree (SmGiven'S m n tn p p' t' b' t pc pc' g)
instance ( NameT tn
         , ParamClauseGroup m n p p' t' b' t pc pc' g
         ) => Decl (SmGiven'S m n tn p p' t' b' t pc pc' g)
instance ( NameT tn
         , ParamClauseGroup m n p p' t' b' t pc pc' g
         ) => Member tn (SmGiven'S m n tn p p' t' b' t pc pc' g)
    where name :: SmGiven'S m n tn p p' t' b' t pc pc' g -> tn
name (SmGiven'S [m]
_ tn
n Maybe g
_ t'
_) = tn
n
instance ( NameT tn
         , ParamClauseGroup m n p p' t' b' t pc pc' g
         ) => MemberT tn (SmGiven'S m n tn p p' t' b' t pc pc' g)
instance ( NameT tn
         , ParamClauseGroup m n p p' t' b' t pc pc' g
         ) => WithMods m (SmGiven'S m n tn p p' t' b' t pc pc' g)
    where mods :: SmGiven'S m n tn p p' t' b' t pc pc' g -> [m]
mods (SmGiven'S [m]
ms tn
_ Maybe g
_ t'
_) = [m]
ms
instance ( g ~ SmParamClauseGroup m n p p' t' b' t pc pc'
         , NameT tn
         , ParamClauseGroup m n p p' t' b' t pc pc' g
         ) => WithParamClauses m n p t' t pc (SmGiven'S m n tn p p' t' b' t pc pc' g)
    where paramClauses :: SmGiven'S m n tn p p' t' b' t pc pc' g -> [pc]
paramClauses (SmGiven'S [m]
_ tn
_ Maybe g
pcg t'
_) = case Maybe g
pcg
                                               of Just (SmParamClauseGroup pc'
_ [pc]
pcs) -> [pc]
pcs
                                                  Maybe g
Nothing                         -> []
instance ( g ~ SmParamClauseGroup m n p p' t' b' t pc pc'
         , NameT tn
         , ParamClauseGroup m n p p' t' b' t pc pc' g
         ) => WithParamClauseGroup m n p p' t' b' t pc pc' g (SmGiven'S m n tn p p' t' b' t pc pc' g)
    where paramClauseGroup :: SmGiven'S m n tn p p' t' b' t pc pc' g -> Maybe g
paramClauseGroup (SmGiven'S [m]
_ tn
_ Maybe g
pcg t'
_) = Maybe g
pcg
instance ( NameT tn
         , ParamClauseGroup m n p p' t' b' t pc pc' g
         ) => WithDeclTpe t' (SmGiven'S m n tn p p' t' b' t pc pc' g)
    where decltpe :: SmGiven'S m n tn p p' t' b' t pc pc' g -> t'
decltpe (SmGiven'S [m]
_ tn
_ Maybe g
_ t'
dt) = t'
dt

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

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

--------------------------------------------------------------------------- V --

instance ( Mod m
         , Pat p
         , Type' t'
         ) => Tree (SmVal'S m p t')
instance ( Mod m
         , Pat p
         , Type' t'
         ) => Decl (SmVal'S m p t')
instance ( Mod m
         , Pat p
         , Type' t'
         ) => WithMods m (SmVal'S m p t')
    where mods :: SmVal'S m p t' -> [m]
mods (SmVal'S [m]
ms [p]
_ t'
_) = [m]
ms
instance ( Mod m
         , Pat p
         , Type' t'
         ) => WithPats p (SmVal'S m p t')
    where pats :: SmVal'S m p t' -> [p]
pats (SmVal'S [m]
_ [p]
ps t'
_) = [p]
ps
instance ( Mod m
         , Pat p
         , Type' t'
         ) => WithDeclTpe t' (SmVal'S m p t')
    where decltpe :: SmVal'S m p t' -> t'
decltpe (SmVal'S [m]
_ [p]
_ t'
dt) = t'
dt

instance ( Mod m
         , Pat p
         , Type' t'
         ) => Tree (SmVar'S m p t')
instance ( Mod m
         , Pat p
         , Type' t'
         ) => Decl (SmVar'S m p t')
instance ( Mod m
         , Pat p
         , Type' t'
         ) => WithMods m (SmVar'S m p t')
    where mods :: SmVar'S m p t' -> [m]
mods (SmVar'S [m]
ms [p]
_ t'
_) = [m]
ms
instance ( Mod m
         , Pat p
         , Type' t'
         ) => WithPats p (SmVar'S m p t')
    where pats :: SmVar'S m p t' -> [p]
pats (SmVar'S [m]
_ [p]
ps t'
_) = [p]
ps
instance ( Mod m
         , Pat p
         , Type' t'
         ) => WithDeclTpe t' (SmVar'S m p t')
    where decltpe :: SmVar'S m p t' -> t'
decltpe (SmVar'S [m]
_ [p]
_ t'
dt) = t'
dt