{-# LANGUAGE ForeignFunctionInterface, TypeFamilies,
  MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances,
  EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-}
module HROOT.Tree.TTree.RawType where
import Foreign.Ptr
import FFICXX.Runtime.Cast

data RawTTree

newtype TTree = TTree (Ptr RawTTree)
                  deriving (TTree -> TTree -> Bool
(TTree -> TTree -> Bool) -> (TTree -> TTree -> Bool) -> Eq TTree
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TTree -> TTree -> Bool
== :: TTree -> TTree -> Bool
$c/= :: TTree -> TTree -> Bool
/= :: TTree -> TTree -> Bool
Eq, Eq TTree
Eq TTree
-> (TTree -> TTree -> Ordering)
-> (TTree -> TTree -> Bool)
-> (TTree -> TTree -> Bool)
-> (TTree -> TTree -> Bool)
-> (TTree -> TTree -> Bool)
-> (TTree -> TTree -> TTree)
-> (TTree -> TTree -> TTree)
-> Ord TTree
TTree -> TTree -> Bool
TTree -> TTree -> Ordering
TTree -> TTree -> TTree
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TTree -> TTree -> Ordering
compare :: TTree -> TTree -> Ordering
$c< :: TTree -> TTree -> Bool
< :: TTree -> TTree -> Bool
$c<= :: TTree -> TTree -> Bool
<= :: TTree -> TTree -> Bool
$c> :: TTree -> TTree -> Bool
> :: TTree -> TTree -> Bool
$c>= :: TTree -> TTree -> Bool
>= :: TTree -> TTree -> Bool
$cmax :: TTree -> TTree -> TTree
max :: TTree -> TTree -> TTree
$cmin :: TTree -> TTree -> TTree
min :: TTree -> TTree -> TTree
Ord, Int -> TTree -> ShowS
[TTree] -> ShowS
TTree -> String
(Int -> TTree -> ShowS)
-> (TTree -> String) -> ([TTree] -> ShowS) -> Show TTree
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TTree -> ShowS
showsPrec :: Int -> TTree -> ShowS
$cshow :: TTree -> String
show :: TTree -> String
$cshowList :: [TTree] -> ShowS
showList :: [TTree] -> ShowS
Show)

instance () => FPtr (TTree) where
        type Raw TTree = RawTTree
        get_fptr :: TTree -> Ptr (Raw TTree)
get_fptr (TTree Ptr RawTTree
ptr) = Ptr (Raw TTree)
Ptr RawTTree
ptr
        cast_fptr_to_obj :: Ptr (Raw TTree) -> TTree
cast_fptr_to_obj = Ptr (Raw TTree) -> TTree
Ptr RawTTree -> TTree
TTree