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

data RawGraphIO

newtype GraphIO = GraphIO (Ptr RawGraphIO)
                    deriving (GraphIO -> GraphIO -> Bool
(GraphIO -> GraphIO -> Bool)
-> (GraphIO -> GraphIO -> Bool) -> Eq GraphIO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GraphIO -> GraphIO -> Bool
== :: GraphIO -> GraphIO -> Bool
$c/= :: GraphIO -> GraphIO -> Bool
/= :: GraphIO -> GraphIO -> Bool
Eq, Eq GraphIO
Eq GraphIO
-> (GraphIO -> GraphIO -> Ordering)
-> (GraphIO -> GraphIO -> Bool)
-> (GraphIO -> GraphIO -> Bool)
-> (GraphIO -> GraphIO -> Bool)
-> (GraphIO -> GraphIO -> Bool)
-> (GraphIO -> GraphIO -> GraphIO)
-> (GraphIO -> GraphIO -> GraphIO)
-> Ord GraphIO
GraphIO -> GraphIO -> Bool
GraphIO -> GraphIO -> Ordering
GraphIO -> GraphIO -> GraphIO
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 :: GraphIO -> GraphIO -> Ordering
compare :: GraphIO -> GraphIO -> Ordering
$c< :: GraphIO -> GraphIO -> Bool
< :: GraphIO -> GraphIO -> Bool
$c<= :: GraphIO -> GraphIO -> Bool
<= :: GraphIO -> GraphIO -> Bool
$c> :: GraphIO -> GraphIO -> Bool
> :: GraphIO -> GraphIO -> Bool
$c>= :: GraphIO -> GraphIO -> Bool
>= :: GraphIO -> GraphIO -> Bool
$cmax :: GraphIO -> GraphIO -> GraphIO
max :: GraphIO -> GraphIO -> GraphIO
$cmin :: GraphIO -> GraphIO -> GraphIO
min :: GraphIO -> GraphIO -> GraphIO
Ord, Int -> GraphIO -> ShowS
[GraphIO] -> ShowS
GraphIO -> String
(Int -> GraphIO -> ShowS)
-> (GraphIO -> String) -> ([GraphIO] -> ShowS) -> Show GraphIO
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GraphIO -> ShowS
showsPrec :: Int -> GraphIO -> ShowS
$cshow :: GraphIO -> String
show :: GraphIO -> String
$cshowList :: [GraphIO] -> ShowS
showList :: [GraphIO] -> ShowS
Show)

instance () => FPtr (GraphIO) where
        type Raw GraphIO = RawGraphIO
        get_fptr :: GraphIO -> Ptr (Raw GraphIO)
get_fptr (GraphIO Ptr RawGraphIO
ptr) = Ptr (Raw GraphIO)
Ptr RawGraphIO
ptr
        cast_fptr_to_obj :: Ptr (Raw GraphIO) -> GraphIO
cast_fptr_to_obj = Ptr (Raw GraphIO) -> GraphIO
Ptr RawGraphIO -> GraphIO
GraphIO