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

import HaScalaM.Classes
import HaScalaM.Classes.Base
import HaScalaM.Classes.Ref
import HaScalaM.Classes.Stat
import HaScalaM.Classes.Term
import HaScalaM.Types.Base
import HaScalaM.Types.Ref
import HaScalaM.Types.Stat
import HaScalaM.Types.Tilde
import HaScalaM.Instances.Ref


--------------------------------------------------------------------------- I --

instance Tree SmImportee
instance Importee SmImportee

instance ( RefT r
         , Importee i
         ) => Tree (SmImporter r i)
instance ( r ~ SmRef
         , i ~ SmImportee
         , RefT r
         , Importee i
         ) => Importer r i (SmImporter r i)
    where ref :: SmImporter r i -> r
ref       (SmImporter r
r [i]
_) = r
r
          importees :: SmImporter r i -> [i]
importees (SmImporter r
_ [i]
is) = [i]
is

instance Importer r i t => Tree (SmImportExportStatS r i t)
instance Importer r i t => ImportExportStat r i t (SmImportExportStatS r i t)
    where importers :: SmImportExportStatS r i t -> [t]
importers (SmImportS [t]
is) = [t]
is
          importers (SmExportS [t]
is) = [t]
is

--------------------------------------------------------------------------- P --

instance Stat s => Tree (SmPkgS SmRef s)
instance Stat s => Member SmNameT (SmPkgS SmRef s)
    where name :: SmPkgS SmRef s -> SmNameT
name (SmPkgS (RTName SmNameT
n) [s]
_) = SmNameT
n
          name (SmPkgS (RTSelect (SmSelectRT t
_ tn
n)) [s]
_) = tn
SmNameT
n
instance Stat s => MemberT SmNameT (SmPkgS SmRef s)
instance Stat s => WithExprs s (SmPkgS SmRef s)
    where exprs :: SmPkgS SmRef s -> [s]
exprs (SmPkgS SmRef
_ [s]
ss) = [s]
ss
instance Stat s => WithStats s (SmPkgS SmRef s)

instance ( NameT tn
         , Template m n t' t ac i p s e
         ) => Tree (SmPkgObjectS m n p tn t' t ac i s e)
instance ( NameT tn
         , Template m n t' t ac i p s e
         ) => WithMods m (SmPkgObjectS m n p tn t' t ac i s e)
    where mods :: SmPkgObjectS m n p tn t' t ac i s e -> [m]
mods (SmPkgObjectS [m]
ms p
_ e
_) = [m]
ms
instance ( NameT tn
         , Template m n t' t ac i p s e
         ) => WithTemplate m n t' t ac i p s e (SmPkgObjectS m n p tn t' t ac i s e)
    where templ :: SmPkgObjectS m n p tn t' t ac i s e -> e
templ (SmPkgObjectS [m]
_ p
_ e
t) = e
t

--------------------------------------------------------------------------- S --

instance Tree SmStat
instance Stat SmStat