content: module NameMapsDecorate where
  import NameMaps
  import TiDecorate
  import TiTypes
  import TiKinds
  --import NameMapsBase(bothtype,bothval)
  import HsIdent(mapHsIdent2)
  import HsDeclMaps(mapFunDeps)
  import MapDeclM
  import MapDeclMBaseStruct()
  import MUtils
  
  instance AccNames i (TiDecls i) where
    accNames f (Decs ds (ks,ts)) = accNames f ds . accNames f ts -- hmm, ks?
  
  instance AccNames i (TiDecl i) where
    accNames f (Dec d) = accNames f d
  
  instance AccNames i (TiExp i) where
    accNames f (Exp e) = accNames f e
    accNames f (TiSpec i _ ts) = accNames f i . accNames f ts
    accNames f (TiTyped e t) = a e . a t
      where a x = accNames f x
  
  instance AccNames i (TiPat i) where
    accNames f (Pat p) = accNames f p
    accNames f (TiPApp p1 p2) = accNames f p1 . accNames f p2
    accNames f (TiPSpec i _ ts) = accNames f i . accNames f ts
    accNames f (TiPTyped p t) = accNames f p . accNames f t
  
  instance AccNames i t => AccNames i (Typing x t) where
    accNames f (x:>:t) = accNames f t -- hmm, x?
  
  instance AccNames i (Scheme i) where
    accNames f (Forall _ _ qt) = accNames f qt
  
  instance AccNames i t => AccNames i (Qual i t) where
    accNames f (ps:=>t) = accNames f ps . accNames f t
  --------------------------------------------------------------------------------
  
  instance MapNames i1 (TiDecls i1) i2 (TiDecls i2) where
    mapNames2 c f (Decs ds (ks,ts)) = Decs (m ds) (mks ks,mts c f ts)
      where
        m x = mapNames2 c f x
        mks = map mk
        mk (i:>:(k,ti)) = bothtype mapHsIdent2 f i:>:(k,m ti)
  
  instance MapNames i1 (TiDecl i1) i2 (TiDecl i2) where
    mapNames2 c f (Dec d) = Dec (mapNames2 c f d)
  
  instance MapNames i1 (TiExp i1) i2 (TiExp i2) where
    mapNames2 c f (Exp e) = Exp (mapNames2 c f e)
    mapNames2 c f (TiSpec i sc ts)= TiSpec (bothval mapHsIdent2 f i) (m sc) (m ts)
      where m x = mapNames2 c f x
    mapNames2 c f (TiTyped e t) = TiTyped (m e) (m t)
      where m x = mapNames2 c f x
  
  instance MapNames i1 (TiPat i1) i2 (TiPat i2) where
    mapNames2 c f (Pat p) = Pat (mapNames2 c f p)
    mapNames2 c f (TiPApp p1 p2) = TiPApp (mapNames2 c f p1) (mapNames2 c f p2)
    mapNames2 c f (TiPSpec i sc ts) =
        TiPSpec (bothval mapHsIdent2 f i) (mapNames2 c f sc) (mapNames2 c f ts)
    mapNames2 c f (TiPTyped p t) = TiPTyped (mapNames2 c f p) (mapNames2 c f t)
  
  instance MapNames i1 (Scheme i1) i2 (Scheme i2) where
    mapNames2 c f (Forall as vs qt) =
        Forall (mktvs f as) (mktvs f vs) (mapNames2 c f qt)
  
  mtvs (vf,_) = map (vf (Def Local,ClassOrTypeNames))
  mktvs (vf,_) = map (emap (vf (Def Local,ClassOrTypeNames)))
  
  mts c f = map mt
    where mt (i:>:t) = bothval mapHsIdent2 f i:>:mapNames2 c f t
  
  instance MapNames i1 (TypeInfo i1) i2 (TypeInfo i2) where
    mapNames2 c f ti =
        case ti of
          Data -> Data
          Newtype -> Newtype
          Class ps vs fdeps as ->
            Class (m ps) (mktvs f vs) ({-mapFunDeps tvarf-} fdeps) (mts c f as)
          Synonym vs t -> Synonym (mtvs f vs) (m t)
          Tyvar -> Tyvar
      where
        m x = mapNames2 c f x
        tvarf = fst f usetype
  
  
  instance MapNames i1 t1 i2 t2
        => MapNames i1 (Qual i1 t1) i2 (Qual i2 t2) where
    mapNames2 c f (ps:=>t) = m ps:=>m t
      where m x = mapNames2 c f x
  
  {-
  instance MapNames i1 Kind i2 Kind where
    mapNames2 c f k = k
    mapNames f k = k
  -}
  --------------------------------------------------------------------------------
  
  instance MapDeclM (TiDecls i) (TiDecls i) where
    mapDeclM f (Decs ds dt) = flip Decs dt # mapDeclM f ds
  
  instance MapDeclM (TiDecl i) (TiDecls i) where mapDeclM  = std_mapDeclM
  
  instance MapDeclM (TiExp i) (TiDecls i) where
    mapDeclM f (Exp e) = Exp # mapDeclM f e
    mapDeclM f (TiTyped e t) = flip TiTyped t # mapDeclM f e
    mapDeclM f e@(TiSpec{}) = return e
  
  