{-# LANGUAGE EmptyDataDecls, ExistentialQuantification,
  FlexibleContexts, FlexibleInstances, ForeignFunctionInterface,
  MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies,
  TypeSynonymInstances #-}
module HROOT.Tree.TTree.Interface where
import Data.Word
import Data.Int
import Foreign.C
import Foreign.Ptr
import FFICXX.Runtime.Cast
import HROOT.Tree.TTree.RawType
import HROOT.Tree.TBranch.RawType
import HROOT.Core.TNamed.Interface
import HROOT.Core.TAttLine.Interface
import HROOT.Core.TAttFill.Interface
import HROOT.Core.TAttMarker.Interface

class (ITNamed a, ITAttLine a, ITAttFill a, ITAttMarker a) =>
      ITTree a where
        branch ::
                 (Castable c0 CString) => a -> c0 -> CInt -> CInt -> IO CInt
        
        branch1 ::
                  (Castable c1 CString, Castable c0 CString) =>
                  a -> c0 -> Ptr () -> c1 -> CInt -> IO TBranch
        
        fillTree :: () => a -> IO CInt

upcastTTree :: forall a . (FPtr a, ITTree a) => a -> TTree
upcastTTree :: forall a. (FPtr a, ITTree a) => a -> TTree
upcastTTree a
h
  = let fh :: Ptr (Raw a)
fh = a -> Ptr (Raw a)
forall a. FPtr a => a -> Ptr (Raw a)
get_fptr a
h
        Ptr RawTTree
fh2 :: Ptr RawTTree = Ptr (Raw a) -> Ptr RawTTree
forall a b. Ptr a -> Ptr b
castPtr Ptr (Raw a)
fh
      in Ptr (Raw TTree) -> TTree
forall a. FPtr a => Ptr (Raw a) -> a
cast_fptr_to_obj Ptr (Raw TTree)
Ptr RawTTree
fh2

downcastTTree :: forall a . (FPtr a, ITTree a) => TTree -> a
downcastTTree :: forall a. (FPtr a, ITTree a) => TTree -> a
downcastTTree TTree
h
  = let fh :: Ptr (Raw TTree)
fh = TTree -> Ptr (Raw TTree)
forall a. FPtr a => a -> Ptr (Raw a)
get_fptr TTree
h
        fh2 :: Ptr (Raw a)
fh2 = Ptr RawTTree -> Ptr (Raw a)
forall a b. Ptr a -> Ptr b
castPtr Ptr (Raw TTree)
Ptr RawTTree
fh
      in Ptr (Raw a) -> a
forall a. FPtr a => Ptr (Raw a) -> a
cast_fptr_to_obj Ptr (Raw a)
fh2