diff --git a/CHANGES b/CHANGES deleted file mode 100644 --- a/CHANGES +++ /dev/null @@ -1,39 +0,0 @@ -0.5.0: 31 Jul 2011 - * initial preview release - -0.5.1: 3 Aug 2011 - * support for delete - -0.6: 16 Aug 2011 - * implement Deletable. delete method for every object - * refactor HROOT generated file names (Interface.hs, Implementation.hs, FFI.hs) - -0.6.3: 22 Sep 2011 - * Implement Existential Types - -0.6.4: 28 Sep 2011 - * add many TH2 class methods - -0.6.6: 7 Oct 2011 - * do not need OverlappingInstances, IncoherentInstances, UndecidableInstances - - -0.6.7: 18 Oct 2011 - * implement almost all TH1 class methods - -0.6.8: 20 Oct 2011 - * implement almost all class methods of TH2, TH3, TFormula, TF1 and TGraph - -0.6.9: 20 Oct 2011 - * implement almost all class methods of TLine, TAttLine, TAttMarker, TAttText and TAttPad - -0.7 : 8 Nov 2011 - * separate all class interfaces and implementation in different modules - * overhaul Existential - -0.7.1 : 12 Nov 2011 - * support for static methods - * add TROOT - -0.8 : 17 Jun 2014 - * separate packages into HROOT-core, HROOT-hist, HROOT-io, HROOT-math, HROOT-graf and HROOT is now an umbrella package diff --git a/Config.hs b/Config.hs deleted file mode 100644 --- a/Config.hs +++ /dev/null @@ -1,85 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} - -module Config where - -import Distribution.Simple -import Distribution.Simple.Setup -import Distribution.PackageDescription -import Distribution.Simple.LocalBuildInfo - -import System.Exit -import System.Process - -config :: LocalBuildInfo -> IO (Maybe HookedBuildInfo) -config bInfo = do - (excode, out, err) <- readProcessWithExitCode "root-config" ["--glibs"] "" - liboptset' <- case excode of - ExitSuccess -> do - return . Just . mkLibraryOptionSet . words $ out - _ -> do - putStrLn $ "root-config failure but I am installing HROOT without ROOT. It will not work. This is only for documentation." - return Nothing - (excode2,out2,err2) <- readProcessWithExitCode "root-config" ["--incdir"] "" - incdir' <- case excode2 of - ExitSuccess -> do - return . Just . head . words $ out2 - _ -> do - putStrLn $ "root-config failure but I am installing HROOT without ROOT. It will not work. This is only for documentation." - return Nothing - let Just lib = library . localPkgDescr $ bInfo - buildinfo = libBuildInfo lib - let (r :: Maybe HookedBuildInfo) = case liboptset' of - Nothing -> Nothing - Just liboptset -> - case incdir' of - Nothing -> Nothing - Just incdir -> - let hbi = emptyBuildInfo { extraLibs = extraLibs buildinfo - ++ libs liboptset - , extraLibDirs = libdirs liboptset - , includeDirs = incdir : includeDirs buildinfo - } - in Just (Just hbi, []) - return r - - -data LibraryOptionSet = LibraryOptionSet { - libs :: [String], - libdirs :: [String], - libopts :: [String] -} deriving Show - -data LibraryOption = Lib String - | Dir String - | Opt String - deriving Show - -mkLibraryOptionSet :: [String] -> LibraryOptionSet -mkLibraryOptionSet strs = let opts = libraryOptions strs - in foldr f (LibraryOptionSet [] [] []) opts - where f x (LibraryOptionSet l d o) = case x of - Lib st -> LibraryOptionSet (st:l) d o - Dir st -> LibraryOptionSet l (st:d) o - Opt st -> LibraryOptionSet l d (st:o) - -libraryOptions :: [String] -> [LibraryOption] -- LibraryOptionSet -libraryOptions = map f - where f x = let r = parseLibraryOptionClassifier x - in case r of - Left msg -> error (show msg) - Right result -> result - - -parseLibraryOptionClassifier :: String -> Either String LibraryOption -parseLibraryOptionClassifier [] = Left "empty option" -parseLibraryOptionClassifier str@(x:xs) = - case x of - '-' -> if null xs - then Left "parse error" - else let (y:ys) = xs - in case y of - 'L' -> Right (Dir ys) - 'l' -> Right (Lib ys) - _ -> Right (Opt str) - _ -> Right (Opt str) - diff --git a/HROOT-core.cabal b/HROOT-core.cabal --- a/HROOT-core.cabal +++ b/HROOT-core.cabal @@ -1,19 +1,17 @@ -Name: HROOT-core -Version: 0.8 -Synopsis: Haskell binding to ROOT Core modules -Description: HROOT is a haskell Foreign Function Interface (FFI) binding to ROOT. ROOT(http://root.cern.ch) is an object-oriented program and library developed by CERN for physics data analysis. +Name: HROOT-core +Version: 0.9 +Synopsis: Haskell binding to ROOT Core modules +Description: HROOT is a haskell Foreign Function Interface (FFI) binding to ROOT. ROOT(http://root.cern.ch) is an object-oriented program and library developed by CERN for physics data analysis. Homepage: http://ianwookim.org/HROOT -License: LGPL-2.1 -License-file: LICENSE -Author: Ian-Woo Kim -Maintainer: Ian-Woo Kim +license: LGPL-2.1 +license-file: LICENSE +Author: Ian-Woo Kim +Maintainer: Ian-Woo Kim Category: Graphics, Statistics, Math, Numerical Tested-with: GHC >= 7.6 -Build-Type: Custom +Build-Type: Custom cabal-version: >=1.10 -Extra-source-files: - CHANGES - Config.hs +Extra-source-files: csrc/HROOT-coreTopLevel.h csrc/HROOTCoreDeletable.h csrc/HROOTCoreTApplication.h @@ -91,7 +89,8 @@ hs-source-dirs: src ghc-options: -Wall -funbox-strict-fields -fno-warn-unused-do-bind -fno-warn-orphans -fno-warn-unused-imports ghc-prof-options: -caf-all -auto-all - Build-Depends: base>4 && < 5, fficxx-runtime >= 0.0.999 + cc-options: -std=c++14 + Build-Depends: base>4 && < 5, fficxx >= 0.3, fficxx-runtime >= 0.3, template-haskell Exposed-Modules: HROOT.Core HROOT.Core.Deletable @@ -292,13 +291,13 @@ HROOT.Core.TSeqCollection.Implementation HROOT.Core.TSystem.Implementation HROOT.Core.TVirtualPad.Implementation - + Other-Modules: extra-lib-dirs: extra-libraries: stdc++ - Include-dirs: csrc - Install-includes: + Include-dirs: csrc + Install-includes: HROOT-coreType.h HROOTCoreDeletable.h HROOTCoreTApplication.h @@ -334,7 +333,7 @@ HROOTCoreTSystem.h HROOTCoreTVirtualPad.h - C-sources: + C-sources: csrc/HROOT-coreTopLevel.cpp csrc/HROOTCoreDeletable.cpp csrc/HROOTCoreTApplication.cpp @@ -369,8 +368,5 @@ csrc/HROOTCoreTSeqCollection.cpp csrc/HROOTCoreTSystem.cpp csrc/HROOTCoreTVirtualPad.cpp - - - diff --git a/csrc/HROOT-coreTopLevel.cpp b/csrc/HROOT-coreTopLevel.cpp --- a/csrc/HROOT-coreTopLevel.cpp +++ b/csrc/HROOT-coreTopLevel.cpp @@ -1,5 +1,4 @@ #include - #include "HROOT-coreTopLevel.h" #include "HROOTCoreTGlobal.h" @@ -11,31 +10,9 @@ #include "HROOTCoreTROOT.h" #include "HROOTCoreTSystem.h" -using namespace std; using namespace ROOT; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -52,5 +29,4 @@ TSystem_p TopLevel_gSystem ( ) { return to_nonconst((TSystem*)gSystem); } - diff --git a/csrc/HROOT-coreTopLevel.h b/csrc/HROOT-coreTopLevel.h --- a/csrc/HROOT-coreTopLevel.h +++ b/csrc/HROOT-coreTopLevel.h @@ -1,12 +1,11 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TOPLEVEL__ #define __HROOT_CORE__TOPLEVEL__ #include "HROOT-coreType.h" - #include "HROOTCoreTROOT.h" #include "HROOTCoreTSystem.h" @@ -19,3 +18,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOT-coreType.h b/csrc/HROOT-coreType.h --- a/csrc/HROOT-coreType.h +++ b/csrc/HROOT-coreType.h @@ -10,168 +10,202 @@ typedef Deletable_t * Deletable_p; typedef Deletable_t const* const_Deletable_p; + // Opaque type definition for TApplication typedef struct TApplication_tag TApplication_t; typedef TApplication_t * TApplication_p; typedef TApplication_t const* const_TApplication_p; + // Opaque type definition for TArray typedef struct TArray_tag TArray_t; typedef TArray_t * TArray_p; typedef TArray_t const* const_TArray_p; + // Opaque type definition for TArrayC typedef struct TArrayC_tag TArrayC_t; typedef TArrayC_t * TArrayC_p; typedef TArrayC_t const* const_TArrayC_p; + // Opaque type definition for TArrayD typedef struct TArrayD_tag TArrayD_t; typedef TArrayD_t * TArrayD_p; typedef TArrayD_t const* const_TArrayD_p; + // Opaque type definition for TArrayF typedef struct TArrayF_tag TArrayF_t; typedef TArrayF_t * TArrayF_p; typedef TArrayF_t const* const_TArrayF_p; + // Opaque type definition for TArrayI typedef struct TArrayI_tag TArrayI_t; typedef TArrayI_t * TArrayI_p; typedef TArrayI_t const* const_TArrayI_p; + // Opaque type definition for TArrayL typedef struct TArrayL_tag TArrayL_t; typedef TArrayL_t * TArrayL_p; typedef TArrayL_t const* const_TArrayL_p; + // Opaque type definition for TArrayL64 typedef struct TArrayL64_tag TArrayL64_t; typedef TArrayL64_t * TArrayL64_p; typedef TArrayL64_t const* const_TArrayL64_p; + // Opaque type definition for TArrayS typedef struct TArrayS_tag TArrayS_t; typedef TArrayS_t * TArrayS_p; typedef TArrayS_t const* const_TArrayS_p; + // Opaque type definition for TAtt3D typedef struct TAtt3D_tag TAtt3D_t; typedef TAtt3D_t * TAtt3D_p; typedef TAtt3D_t const* const_TAtt3D_p; + // Opaque type definition for TAttAxis typedef struct TAttAxis_tag TAttAxis_t; typedef TAttAxis_t * TAttAxis_p; typedef TAttAxis_t const* const_TAttAxis_p; + // Opaque type definition for TAttBBox typedef struct TAttBBox_tag TAttBBox_t; typedef TAttBBox_t * TAttBBox_p; typedef TAttBBox_t const* const_TAttBBox_p; + // Opaque type definition for TAttCanvas typedef struct TAttCanvas_tag TAttCanvas_t; typedef TAttCanvas_t * TAttCanvas_p; typedef TAttCanvas_t const* const_TAttCanvas_p; + // Opaque type definition for TAttFill typedef struct TAttFill_tag TAttFill_t; typedef TAttFill_t * TAttFill_p; typedef TAttFill_t const* const_TAttFill_p; + // Opaque type definition for TAttLine typedef struct TAttLine_tag TAttLine_t; typedef TAttLine_t * TAttLine_p; typedef TAttLine_t const* const_TAttLine_p; + // Opaque type definition for TAttMarker typedef struct TAttMarker_tag TAttMarker_t; typedef TAttMarker_t * TAttMarker_p; typedef TAttMarker_t const* const_TAttMarker_p; + // Opaque type definition for TAttPad typedef struct TAttPad_tag TAttPad_t; typedef TAttPad_t * TAttPad_p; typedef TAttPad_t const* const_TAttPad_p; + // Opaque type definition for TAttText typedef struct TAttText_tag TAttText_t; typedef TAttText_t * TAttText_p; typedef TAttText_t const* const_TAttText_p; + // Opaque type definition for TClass typedef struct TClass_tag TClass_t; typedef TClass_t * TClass_p; typedef TClass_t const* const_TClass_p; + // Opaque type definition for TCollection typedef struct TCollection_tag TCollection_t; typedef TCollection_t * TCollection_p; typedef TCollection_t const* const_TCollection_p; + // Opaque type definition for TDictionary typedef struct TDictionary_tag TDictionary_t; typedef TDictionary_t * TDictionary_p; typedef TDictionary_t const* const_TDictionary_p; + // Opaque type definition for TDirectory typedef struct TDirectory_tag TDirectory_t; typedef TDirectory_t * TDirectory_p; typedef TDirectory_t const* const_TDirectory_p; + // Opaque type definition for TGlobal typedef struct TGlobal_tag TGlobal_t; typedef TGlobal_t * TGlobal_p; typedef TGlobal_t const* const_TGlobal_p; + // Opaque type definition for TKey typedef struct TKey_tag TKey_t; typedef TKey_t * TKey_p; typedef TKey_t const* const_TKey_p; + // Opaque type definition for TNamed typedef struct TNamed_tag TNamed_t; typedef TNamed_t * TNamed_p; typedef TNamed_t const* const_TNamed_p; + // Opaque type definition for TObjArray typedef struct TObjArray_tag TObjArray_t; typedef TObjArray_t * TObjArray_p; typedef TObjArray_t const* const_TObjArray_p; + // Opaque type definition for TObject typedef struct TObject_tag TObject_t; typedef TObject_t * TObject_p; typedef TObject_t const* const_TObject_p; + // Opaque type definition for TQObject typedef struct TQObject_tag TQObject_t; typedef TQObject_t * TQObject_p; typedef TQObject_t const* const_TQObject_p; + // Opaque type definition for TROOT typedef struct TROOT_tag TROOT_t; typedef TROOT_t * TROOT_p; typedef TROOT_t const* const_TROOT_p; + // Opaque type definition for TSeqCollection typedef struct TSeqCollection_tag TSeqCollection_t; typedef TSeqCollection_t * TSeqCollection_p; typedef TSeqCollection_t const* const_TSeqCollection_p; + // Opaque type definition for TSystem typedef struct TSystem_tag TSystem_t; typedef TSystem_t * TSystem_p; typedef TSystem_t const* const_TSystem_p; + // Opaque type definition for TVirtualPad typedef struct TVirtualPad_tag TVirtualPad_t; typedef TVirtualPad_t * TVirtualPad_p; typedef TVirtualPad_t const* const_TVirtualPad_p; + #endif // __HROOT_CORE__ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreDeletable.cpp b/csrc/HROOTCoreDeletable.cpp --- a/csrc/HROOTCoreDeletable.cpp +++ b/csrc/HROOTCoreDeletable.cpp @@ -1,39 +1,15 @@ #include - #include "HROOTCoreDeletable.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ IIF( CHECKPROTECT(cname,mname) ) ( \ (to_nonconst), \ (to_nonconst) ) - diff --git a/csrc/HROOTCoreDeletable.h b/csrc/HROOTCoreDeletable.h --- a/csrc/HROOTCoreDeletable.h +++ b/csrc/HROOTCoreDeletable.h @@ -1,6 +1,6 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__Deletable__ #define __HROOT_CORE__Deletable__ @@ -8,12 +8,11 @@ #include "HROOT-coreType.h" - -#undef DELETABLE_DECL_VIRT +#undef DELETABLE_DECL_VIRT #define DELETABLE_DECL_VIRT(Type) \ void Type ## _delete ( Type ## _p p ) -#undef DELETABLE_DECL_NONVIRT +#undef DELETABLE_DECL_NONVIRT #define DELETABLE_DECL_NONVIRT(Type) \ @@ -35,3 +34,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTApplication.cpp b/csrc/HROOTCoreTApplication.cpp --- a/csrc/HROOTCoreTApplication.cpp +++ b/csrc/HROOTCoreTApplication.cpp @@ -1,34 +1,11 @@ #include - #include "HROOTCoreTObject.h" #include "HROOTCoreTQObject.h" #include "TApplication.h" #include "HROOTCoreTApplication.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -44,5 +21,4 @@ TAPPLICATION_DEF_VIRT(TApplication) TAPPLICATION_DEF_NONVIRT(TApplication) - diff --git a/csrc/HROOTCoreTApplication.h b/csrc/HROOTCoreTApplication.h --- a/csrc/HROOTCoreTApplication.h +++ b/csrc/HROOTCoreTApplication.h @@ -1,21 +1,20 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TApplication__ #define __HROOT_CORE__TApplication__ #include "HROOT-coreType.h" - #include "HROOTCoreTObject.h" #include "HROOTCoreTQObject.h" #include "HROOTCoreDeletable.h" -#undef TAPPLICATION_DECL_VIRT +#undef TAPPLICATION_DECL_VIRT #define TAPPLICATION_DECL_VIRT(Type) \ void Type ## _Run ( Type ## _p p, int retrn ) -#undef TAPPLICATION_DECL_NONVIRT +#undef TAPPLICATION_DECL_NONVIRT #define TAPPLICATION_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTApplication ( const char* appClassName, int* argc, char** argv ) @@ -50,3 +49,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTArray.cpp b/csrc/HROOTCoreTArray.cpp --- a/csrc/HROOTCoreTArray.cpp +++ b/csrc/HROOTCoreTArray.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreDeletable.h" #include "TArray.h" #include "HROOTCoreTArray.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -41,5 +18,4 @@ TARRAY_DEF_VIRT(TArray) TARRAY_DEF_NONVIRT(TArray) - diff --git a/csrc/HROOTCoreTArray.h b/csrc/HROOTCoreTArray.h --- a/csrc/HROOTCoreTArray.h +++ b/csrc/HROOTCoreTArray.h @@ -1,19 +1,18 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TArray__ #define __HROOT_CORE__TArray__ #include "HROOT-coreType.h" - #include "HROOTCoreDeletable.h" -#undef TARRAY_DECL_VIRT +#undef TARRAY_DECL_VIRT #define TARRAY_DECL_VIRT(Type) \ -#undef TARRAY_DECL_NONVIRT +#undef TARRAY_DECL_NONVIRT #define TARRAY_DECL_NONVIRT(Type) \ @@ -39,3 +38,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTArrayC.cpp b/csrc/HROOTCoreTArrayC.cpp --- a/csrc/HROOTCoreTArrayC.cpp +++ b/csrc/HROOTCoreTArrayC.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreTArray.h" #include "TArrayC.h" #include "HROOTCoreTArrayC.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -42,5 +19,4 @@ TARRAYC_DEF_VIRT(TArrayC) TARRAYC_DEF_NONVIRT(TArrayC) - diff --git a/csrc/HROOTCoreTArrayC.h b/csrc/HROOTCoreTArrayC.h --- a/csrc/HROOTCoreTArrayC.h +++ b/csrc/HROOTCoreTArrayC.h @@ -1,20 +1,19 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TArrayC__ #define __HROOT_CORE__TArrayC__ #include "HROOT-coreType.h" - #include "HROOTCoreTArray.h" #include "HROOTCoreDeletable.h" -#undef TARRAYC_DECL_VIRT +#undef TARRAYC_DECL_VIRT #define TARRAYC_DECL_VIRT(Type) \ -#undef TARRAYC_DECL_NONVIRT +#undef TARRAYC_DECL_NONVIRT #define TARRAYC_DECL_NONVIRT(Type) \ @@ -41,3 +40,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTArrayD.cpp b/csrc/HROOTCoreTArrayD.cpp --- a/csrc/HROOTCoreTArrayD.cpp +++ b/csrc/HROOTCoreTArrayD.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreTArray.h" #include "TArrayD.h" #include "HROOTCoreTArrayD.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -42,5 +19,4 @@ TARRAYD_DEF_VIRT(TArrayD) TARRAYD_DEF_NONVIRT(TArrayD) - diff --git a/csrc/HROOTCoreTArrayD.h b/csrc/HROOTCoreTArrayD.h --- a/csrc/HROOTCoreTArrayD.h +++ b/csrc/HROOTCoreTArrayD.h @@ -1,20 +1,19 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TArrayD__ #define __HROOT_CORE__TArrayD__ #include "HROOT-coreType.h" - #include "HROOTCoreTArray.h" #include "HROOTCoreDeletable.h" -#undef TARRAYD_DECL_VIRT +#undef TARRAYD_DECL_VIRT #define TARRAYD_DECL_VIRT(Type) \ -#undef TARRAYD_DECL_NONVIRT +#undef TARRAYD_DECL_NONVIRT #define TARRAYD_DECL_NONVIRT(Type) \ @@ -41,3 +40,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTArrayF.cpp b/csrc/HROOTCoreTArrayF.cpp --- a/csrc/HROOTCoreTArrayF.cpp +++ b/csrc/HROOTCoreTArrayF.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreTArray.h" #include "TArrayF.h" #include "HROOTCoreTArrayF.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -42,5 +19,4 @@ TARRAYF_DEF_VIRT(TArrayF) TARRAYF_DEF_NONVIRT(TArrayF) - diff --git a/csrc/HROOTCoreTArrayF.h b/csrc/HROOTCoreTArrayF.h --- a/csrc/HROOTCoreTArrayF.h +++ b/csrc/HROOTCoreTArrayF.h @@ -1,20 +1,19 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TArrayF__ #define __HROOT_CORE__TArrayF__ #include "HROOT-coreType.h" - #include "HROOTCoreTArray.h" #include "HROOTCoreDeletable.h" -#undef TARRAYF_DECL_VIRT +#undef TARRAYF_DECL_VIRT #define TARRAYF_DECL_VIRT(Type) \ -#undef TARRAYF_DECL_NONVIRT +#undef TARRAYF_DECL_NONVIRT #define TARRAYF_DECL_NONVIRT(Type) \ @@ -41,3 +40,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTArrayI.cpp b/csrc/HROOTCoreTArrayI.cpp --- a/csrc/HROOTCoreTArrayI.cpp +++ b/csrc/HROOTCoreTArrayI.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreTArray.h" #include "TArrayI.h" #include "HROOTCoreTArrayI.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -42,5 +19,4 @@ TARRAYI_DEF_VIRT(TArrayI) TARRAYI_DEF_NONVIRT(TArrayI) - diff --git a/csrc/HROOTCoreTArrayI.h b/csrc/HROOTCoreTArrayI.h --- a/csrc/HROOTCoreTArrayI.h +++ b/csrc/HROOTCoreTArrayI.h @@ -1,20 +1,19 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TArrayI__ #define __HROOT_CORE__TArrayI__ #include "HROOT-coreType.h" - #include "HROOTCoreTArray.h" #include "HROOTCoreDeletable.h" -#undef TARRAYI_DECL_VIRT +#undef TARRAYI_DECL_VIRT #define TARRAYI_DECL_VIRT(Type) \ -#undef TARRAYI_DECL_NONVIRT +#undef TARRAYI_DECL_NONVIRT #define TARRAYI_DECL_NONVIRT(Type) \ @@ -41,3 +40,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTArrayL.cpp b/csrc/HROOTCoreTArrayL.cpp --- a/csrc/HROOTCoreTArrayL.cpp +++ b/csrc/HROOTCoreTArrayL.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreTArray.h" #include "TArrayL.h" #include "HROOTCoreTArrayL.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -42,5 +19,4 @@ TARRAYL_DEF_VIRT(TArrayL) TARRAYL_DEF_NONVIRT(TArrayL) - diff --git a/csrc/HROOTCoreTArrayL.h b/csrc/HROOTCoreTArrayL.h --- a/csrc/HROOTCoreTArrayL.h +++ b/csrc/HROOTCoreTArrayL.h @@ -1,20 +1,19 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TArrayL__ #define __HROOT_CORE__TArrayL__ #include "HROOT-coreType.h" - #include "HROOTCoreTArray.h" #include "HROOTCoreDeletable.h" -#undef TARRAYL_DECL_VIRT +#undef TARRAYL_DECL_VIRT #define TARRAYL_DECL_VIRT(Type) \ -#undef TARRAYL_DECL_NONVIRT +#undef TARRAYL_DECL_NONVIRT #define TARRAYL_DECL_NONVIRT(Type) \ @@ -41,3 +40,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTArrayL64.cpp b/csrc/HROOTCoreTArrayL64.cpp --- a/csrc/HROOTCoreTArrayL64.cpp +++ b/csrc/HROOTCoreTArrayL64.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreTArray.h" #include "TArrayL64.h" #include "HROOTCoreTArrayL64.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -42,5 +19,4 @@ TARRAYL64_DEF_VIRT(TArrayL64) TARRAYL64_DEF_NONVIRT(TArrayL64) - diff --git a/csrc/HROOTCoreTArrayL64.h b/csrc/HROOTCoreTArrayL64.h --- a/csrc/HROOTCoreTArrayL64.h +++ b/csrc/HROOTCoreTArrayL64.h @@ -1,20 +1,19 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TArrayL64__ #define __HROOT_CORE__TArrayL64__ #include "HROOT-coreType.h" - #include "HROOTCoreTArray.h" #include "HROOTCoreDeletable.h" -#undef TARRAYL64_DECL_VIRT +#undef TARRAYL64_DECL_VIRT #define TARRAYL64_DECL_VIRT(Type) \ -#undef TARRAYL64_DECL_NONVIRT +#undef TARRAYL64_DECL_NONVIRT #define TARRAYL64_DECL_NONVIRT(Type) \ @@ -41,3 +40,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTArrayS.cpp b/csrc/HROOTCoreTArrayS.cpp --- a/csrc/HROOTCoreTArrayS.cpp +++ b/csrc/HROOTCoreTArrayS.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreTArray.h" #include "TArrayS.h" #include "HROOTCoreTArrayS.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -42,5 +19,4 @@ TARRAYS_DEF_VIRT(TArrayS) TARRAYS_DEF_NONVIRT(TArrayS) - diff --git a/csrc/HROOTCoreTArrayS.h b/csrc/HROOTCoreTArrayS.h --- a/csrc/HROOTCoreTArrayS.h +++ b/csrc/HROOTCoreTArrayS.h @@ -1,20 +1,19 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TArrayS__ #define __HROOT_CORE__TArrayS__ #include "HROOT-coreType.h" - #include "HROOTCoreTArray.h" #include "HROOTCoreDeletable.h" -#undef TARRAYS_DECL_VIRT +#undef TARRAYS_DECL_VIRT #define TARRAYS_DECL_VIRT(Type) \ -#undef TARRAYS_DECL_NONVIRT +#undef TARRAYS_DECL_NONVIRT #define TARRAYS_DECL_NONVIRT(Type) \ @@ -41,3 +40,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTAtt3D.cpp b/csrc/HROOTCoreTAtt3D.cpp --- a/csrc/HROOTCoreTAtt3D.cpp +++ b/csrc/HROOTCoreTAtt3D.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreDeletable.h" #include "TAtt3D.h" #include "HROOTCoreTAtt3D.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -41,5 +18,4 @@ TATT3D_DEF_VIRT(TAtt3D) TATT3D_DEF_NONVIRT(TAtt3D) - diff --git a/csrc/HROOTCoreTAtt3D.h b/csrc/HROOTCoreTAtt3D.h --- a/csrc/HROOTCoreTAtt3D.h +++ b/csrc/HROOTCoreTAtt3D.h @@ -1,19 +1,18 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TAtt3D__ #define __HROOT_CORE__TAtt3D__ #include "HROOT-coreType.h" - #include "HROOTCoreDeletable.h" -#undef TATT3D_DECL_VIRT +#undef TATT3D_DECL_VIRT #define TATT3D_DECL_VIRT(Type) \ -#undef TATT3D_DECL_NONVIRT +#undef TATT3D_DECL_NONVIRT #define TATT3D_DECL_NONVIRT(Type) \ @@ -39,3 +38,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTAttAxis.cpp b/csrc/HROOTCoreTAttAxis.cpp --- a/csrc/HROOTCoreTAttAxis.cpp +++ b/csrc/HROOTCoreTAttAxis.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreDeletable.h" #include "TAttAxis.h" #include "HROOTCoreTAttAxis.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -41,5 +18,4 @@ TATTAXIS_DEF_VIRT(TAttAxis) TATTAXIS_DEF_NONVIRT(TAttAxis) - diff --git a/csrc/HROOTCoreTAttAxis.h b/csrc/HROOTCoreTAttAxis.h --- a/csrc/HROOTCoreTAttAxis.h +++ b/csrc/HROOTCoreTAttAxis.h @@ -1,15 +1,14 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TAttAxis__ #define __HROOT_CORE__TAttAxis__ #include "HROOT-coreType.h" - #include "HROOTCoreDeletable.h" -#undef TATTAXIS_DECL_VIRT +#undef TATTAXIS_DECL_VIRT #define TATTAXIS_DECL_VIRT(Type) \ int Type ## _GetNdivisions ( Type ## _p p ); \ int Type ## _GetAxisColor ( Type ## _p p ); \ @@ -33,7 +32,7 @@ void Type ## _SetTitleColor ( Type ## _p p, int color ); \ void Type ## _SetTitleFont ( Type ## _p p, int font ) -#undef TATTAXIS_DECL_NONVIRT +#undef TATTAXIS_DECL_NONVIRT #define TATTAXIS_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTAttAxis ( ) @@ -146,3 +145,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTAttBBox.cpp b/csrc/HROOTCoreTAttBBox.cpp --- a/csrc/HROOTCoreTAttBBox.cpp +++ b/csrc/HROOTCoreTAttBBox.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreDeletable.h" #include "TAttBBox.h" #include "HROOTCoreTAttBBox.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -41,5 +18,4 @@ TATTBBOX_DEF_VIRT(TAttBBox) TATTBBOX_DEF_NONVIRT(TAttBBox) - diff --git a/csrc/HROOTCoreTAttBBox.h b/csrc/HROOTCoreTAttBBox.h --- a/csrc/HROOTCoreTAttBBox.h +++ b/csrc/HROOTCoreTAttBBox.h @@ -1,19 +1,18 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TAttBBox__ #define __HROOT_CORE__TAttBBox__ #include "HROOT-coreType.h" - #include "HROOTCoreDeletable.h" -#undef TATTBBOX_DECL_VIRT +#undef TATTBBOX_DECL_VIRT #define TATTBBOX_DECL_VIRT(Type) \ -#undef TATTBBOX_DECL_NONVIRT +#undef TATTBBOX_DECL_NONVIRT #define TATTBBOX_DECL_NONVIRT(Type) \ @@ -39,3 +38,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTAttCanvas.cpp b/csrc/HROOTCoreTAttCanvas.cpp --- a/csrc/HROOTCoreTAttCanvas.cpp +++ b/csrc/HROOTCoreTAttCanvas.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreDeletable.h" #include "TAttCanvas.h" #include "HROOTCoreTAttCanvas.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -41,5 +18,4 @@ TATTCANVAS_DEF_VIRT(TAttCanvas) TATTCANVAS_DEF_NONVIRT(TAttCanvas) - diff --git a/csrc/HROOTCoreTAttCanvas.h b/csrc/HROOTCoreTAttCanvas.h --- a/csrc/HROOTCoreTAttCanvas.h +++ b/csrc/HROOTCoreTAttCanvas.h @@ -1,19 +1,18 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TAttCanvas__ #define __HROOT_CORE__TAttCanvas__ #include "HROOT-coreType.h" - #include "HROOTCoreDeletable.h" -#undef TATTCANVAS_DECL_VIRT +#undef TATTCANVAS_DECL_VIRT #define TATTCANVAS_DECL_VIRT(Type) \ -#undef TATTCANVAS_DECL_NONVIRT +#undef TATTCANVAS_DECL_NONVIRT #define TATTCANVAS_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTAttCanvas ( ) @@ -43,3 +42,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTAttFill.cpp b/csrc/HROOTCoreTAttFill.cpp --- a/csrc/HROOTCoreTAttFill.cpp +++ b/csrc/HROOTCoreTAttFill.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreDeletable.h" #include "TAttFill.h" #include "HROOTCoreTAttFill.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -41,5 +18,4 @@ TATTFILL_DEF_VIRT(TAttFill) TATTFILL_DEF_NONVIRT(TAttFill) - diff --git a/csrc/HROOTCoreTAttFill.h b/csrc/HROOTCoreTAttFill.h --- a/csrc/HROOTCoreTAttFill.h +++ b/csrc/HROOTCoreTAttFill.h @@ -1,20 +1,19 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TAttFill__ #define __HROOT_CORE__TAttFill__ #include "HROOT-coreType.h" - #include "HROOTCoreDeletable.h" -#undef TATTFILL_DECL_VIRT +#undef TATTFILL_DECL_VIRT #define TATTFILL_DECL_VIRT(Type) \ void Type ## _SetFillColor ( Type ## _p p, int color ); \ void Type ## _SetFillStyle ( Type ## _p p, int style ) -#undef TATTFILL_DECL_NONVIRT +#undef TATTFILL_DECL_NONVIRT #define TATTFILL_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTAttFill ( int fcolor, int fstyle ) @@ -51,3 +50,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTAttLine.cpp b/csrc/HROOTCoreTAttLine.cpp --- a/csrc/HROOTCoreTAttLine.cpp +++ b/csrc/HROOTCoreTAttLine.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreDeletable.h" #include "TAttLine.h" #include "HROOTCoreTAttLine.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -41,5 +18,4 @@ TATTLINE_DEF_VIRT(TAttLine) TATTLINE_DEF_NONVIRT(TAttLine) - diff --git a/csrc/HROOTCoreTAttLine.h b/csrc/HROOTCoreTAttLine.h --- a/csrc/HROOTCoreTAttLine.h +++ b/csrc/HROOTCoreTAttLine.h @@ -1,15 +1,14 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TAttLine__ #define __HROOT_CORE__TAttLine__ #include "HROOT-coreType.h" - #include "HROOTCoreDeletable.h" -#undef TATTLINE_DECL_VIRT +#undef TATTLINE_DECL_VIRT #define TATTLINE_DECL_VIRT(Type) \ int Type ## _GetLineColor ( Type ## _p p ); \ int Type ## _GetLineStyle ( Type ## _p p ); \ @@ -20,7 +19,7 @@ void Type ## _SetLineStyle ( Type ## _p p, int lstyle ); \ void Type ## _SetLineWidth ( Type ## _p p, int lwidth ) -#undef TATTLINE_DECL_NONVIRT +#undef TATTLINE_DECL_NONVIRT #define TATTLINE_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTAttLine ( int lcolor, int lstyle, int lwidth ); \ int Type ## _tAttLineDistancetoLine ( Type ## _p p, int px, int py, double xp1, double yp1, double xp2, double yp2 ) @@ -86,3 +85,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTAttMarker.cpp b/csrc/HROOTCoreTAttMarker.cpp --- a/csrc/HROOTCoreTAttMarker.cpp +++ b/csrc/HROOTCoreTAttMarker.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreDeletable.h" #include "TAttMarker.h" #include "HROOTCoreTAttMarker.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -41,5 +18,4 @@ TATTMARKER_DEF_VIRT(TAttMarker) TATTMARKER_DEF_NONVIRT(TAttMarker) - diff --git a/csrc/HROOTCoreTAttMarker.h b/csrc/HROOTCoreTAttMarker.h --- a/csrc/HROOTCoreTAttMarker.h +++ b/csrc/HROOTCoreTAttMarker.h @@ -1,15 +1,14 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TAttMarker__ #define __HROOT_CORE__TAttMarker__ #include "HROOT-coreType.h" - #include "HROOTCoreDeletable.h" -#undef TATTMARKER_DECL_VIRT +#undef TATTMARKER_DECL_VIRT #define TATTMARKER_DECL_VIRT(Type) \ int Type ## _GetMarkerColor ( Type ## _p p ); \ int Type ## _GetMarkerStyle ( Type ## _p p ); \ @@ -20,7 +19,7 @@ void Type ## _SetMarkerStyle ( Type ## _p p, int mstyle ); \ void Type ## _SetMarkerSize ( Type ## _p p, int msize ) -#undef TATTMARKER_DECL_NONVIRT +#undef TATTMARKER_DECL_NONVIRT #define TATTMARKER_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTAttMarker ( int color, int style, int msize ) @@ -81,3 +80,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTAttPad.cpp b/csrc/HROOTCoreTAttPad.cpp --- a/csrc/HROOTCoreTAttPad.cpp +++ b/csrc/HROOTCoreTAttPad.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreDeletable.h" #include "TAttPad.h" #include "HROOTCoreTAttPad.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -41,5 +18,4 @@ TATTPAD_DEF_VIRT(TAttPad) TATTPAD_DEF_NONVIRT(TAttPad) - diff --git a/csrc/HROOTCoreTAttPad.h b/csrc/HROOTCoreTAttPad.h --- a/csrc/HROOTCoreTAttPad.h +++ b/csrc/HROOTCoreTAttPad.h @@ -1,15 +1,14 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TAttPad__ #define __HROOT_CORE__TAttPad__ #include "HROOT-coreType.h" - #include "HROOTCoreDeletable.h" -#undef TATTPAD_DECL_VIRT +#undef TATTPAD_DECL_VIRT #define TATTPAD_DECL_VIRT(Type) \ void Type ## _ResetAttPad ( Type ## _p p, const char* option ); \ void Type ## _SetBottomMargin ( Type ## _p p, double bottommargin ); \ @@ -24,7 +23,7 @@ void Type ## _SetXstat ( Type ## _p p, double xstat ); \ void Type ## _SetYstat ( Type ## _p p, double ystat ) -#undef TATTPAD_DECL_NONVIRT +#undef TATTPAD_DECL_NONVIRT #define TATTPAD_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTAttPad ( ); \ double Type ## _tAttPadGetBottomMargin ( Type ## _p p ); \ @@ -221,3 +220,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTAttText.cpp b/csrc/HROOTCoreTAttText.cpp --- a/csrc/HROOTCoreTAttText.cpp +++ b/csrc/HROOTCoreTAttText.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreDeletable.h" #include "TAttText.h" #include "HROOTCoreTAttText.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -41,5 +18,4 @@ TATTTEXT_DEF_VIRT(TAttText) TATTTEXT_DEF_NONVIRT(TAttText) - diff --git a/csrc/HROOTCoreTAttText.h b/csrc/HROOTCoreTAttText.h --- a/csrc/HROOTCoreTAttText.h +++ b/csrc/HROOTCoreTAttText.h @@ -1,15 +1,14 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TAttText__ #define __HROOT_CORE__TAttText__ #include "HROOT-coreType.h" - #include "HROOTCoreDeletable.h" -#undef TATTTEXT_DECL_VIRT +#undef TATTTEXT_DECL_VIRT #define TATTTEXT_DECL_VIRT(Type) \ int Type ## _GetTextAlign ( Type ## _p p ); \ double Type ## _GetTextAngle ( Type ## _p p ); \ @@ -25,7 +24,7 @@ void Type ## _SetTextSize ( Type ## _p p, double tsize ); \ void Type ## _SetTextSizePixels ( Type ## _p p, int npixels ) -#undef TATTTEXT_DECL_NONVIRT +#undef TATTTEXT_DECL_NONVIRT #define TATTTEXT_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTAttText ( int align, double angle, int color, int font, double tsize ) @@ -106,3 +105,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTClass.cpp b/csrc/HROOTCoreTClass.cpp --- a/csrc/HROOTCoreTClass.cpp +++ b/csrc/HROOTCoreTClass.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreTDictionary.h" #include "TClass.h" #include "HROOTCoreTClass.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -44,5 +21,4 @@ TCLASS_DEF_VIRT(TClass) TCLASS_DEF_NONVIRT(TClass) - diff --git a/csrc/HROOTCoreTClass.h b/csrc/HROOTCoreTClass.h --- a/csrc/HROOTCoreTClass.h +++ b/csrc/HROOTCoreTClass.h @@ -1,22 +1,21 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TClass__ #define __HROOT_CORE__TClass__ #include "HROOT-coreType.h" - #include "HROOTCoreTDictionary.h" #include "HROOTCoreTNamed.h" #include "HROOTCoreTObject.h" #include "HROOTCoreDeletable.h" -#undef TCLASS_DECL_VIRT +#undef TCLASS_DECL_VIRT #define TCLASS_DECL_VIRT(Type) \ -#undef TCLASS_DECL_NONVIRT +#undef TCLASS_DECL_NONVIRT #define TCLASS_DECL_NONVIRT(Type) \ @@ -45,3 +44,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTCollection.cpp b/csrc/HROOTCoreTCollection.cpp --- a/csrc/HROOTCoreTCollection.cpp +++ b/csrc/HROOTCoreTCollection.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreTObject.h" #include "TCollection.h" #include "HROOTCoreTCollection.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -42,5 +19,4 @@ TCOLLECTION_DEF_VIRT(TCollection) TCOLLECTION_DEF_NONVIRT(TCollection) - diff --git a/csrc/HROOTCoreTCollection.h b/csrc/HROOTCoreTCollection.h --- a/csrc/HROOTCoreTCollection.h +++ b/csrc/HROOTCoreTCollection.h @@ -1,20 +1,19 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TCollection__ #define __HROOT_CORE__TCollection__ #include "HROOT-coreType.h" - #include "HROOTCoreTObject.h" #include "HROOTCoreDeletable.h" -#undef TCOLLECTION_DECL_VIRT +#undef TCOLLECTION_DECL_VIRT #define TCOLLECTION_DECL_VIRT(Type) \ -#undef TCOLLECTION_DECL_NONVIRT +#undef TCOLLECTION_DECL_NONVIRT #define TCOLLECTION_DECL_NONVIRT(Type) \ @@ -41,3 +40,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTDictionary.cpp b/csrc/HROOTCoreTDictionary.cpp --- a/csrc/HROOTCoreTDictionary.cpp +++ b/csrc/HROOTCoreTDictionary.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreTNamed.h" #include "TDictionary.h" #include "HROOTCoreTDictionary.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -39,7 +16,6 @@ TNAMED_DEF_VIRT(TDictionary) TOBJECT_DEF_VIRT(TDictionary) DELETABLE_DEF_VIRT(TDictionary) - diff --git a/csrc/HROOTCoreTDictionary.h b/csrc/HROOTCoreTDictionary.h --- a/csrc/HROOTCoreTDictionary.h +++ b/csrc/HROOTCoreTDictionary.h @@ -1,21 +1,20 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TDictionary__ #define __HROOT_CORE__TDictionary__ #include "HROOT-coreType.h" - #include "HROOTCoreTNamed.h" #include "HROOTCoreTObject.h" #include "HROOTCoreDeletable.h" -#undef TDICTIONARY_DECL_VIRT +#undef TDICTIONARY_DECL_VIRT #define TDICTIONARY_DECL_VIRT(Type) \ -#undef TDICTIONARY_DECL_NONVIRT +#undef TDICTIONARY_DECL_NONVIRT #define TDICTIONARY_DECL_NONVIRT(Type) \ @@ -43,3 +42,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTDirectory.cpp b/csrc/HROOTCoreTDirectory.cpp --- a/csrc/HROOTCoreTDirectory.cpp +++ b/csrc/HROOTCoreTDirectory.cpp @@ -1,35 +1,12 @@ #include - #include "HROOTCoreTObject.h" #include "HROOTCoreTKey.h" #include "HROOTCoreTNamed.h" #include "TDirectory.h" #include "HROOTCoreTDirectory.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -45,5 +22,4 @@ TDIRECTORY_DEF_VIRT(TDirectory) TDIRECTORY_DEF_NONVIRT(TDirectory) - diff --git a/csrc/HROOTCoreTDirectory.h b/csrc/HROOTCoreTDirectory.h --- a/csrc/HROOTCoreTDirectory.h +++ b/csrc/HROOTCoreTDirectory.h @@ -1,17 +1,16 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TDirectory__ #define __HROOT_CORE__TDirectory__ #include "HROOT-coreType.h" - #include "HROOTCoreTNamed.h" #include "HROOTCoreTObject.h" #include "HROOTCoreDeletable.h" -#undef TDIRECTORY_DECL_VIRT +#undef TDIRECTORY_DECL_VIRT #define TDIRECTORY_DECL_VIRT(Type) \ void Type ## _Append ( Type ## _p p, TObject_p obj, int replace ); \ void Type ## _addD ( Type ## _p p, TObject_p obj, int replace ); \ @@ -20,7 +19,7 @@ TObject_p Type ## _Get ( Type ## _p p, const char* namecycle ); \ int Type ## _cd_TDirectory ( Type ## _p p, const char* path ) -#undef TDIRECTORY_DECL_NONVIRT +#undef TDIRECTORY_DECL_NONVIRT #define TDIRECTORY_DECL_NONVIRT(Type) \ void Type ## _tDirectoryAddDirectory ( int add ); \ int Type ## _tDirectoryAddDirectoryStatus ( ) @@ -79,3 +78,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTGlobal.cpp b/csrc/HROOTCoreTGlobal.cpp --- a/csrc/HROOTCoreTGlobal.cpp +++ b/csrc/HROOTCoreTGlobal.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreTDictionary.h" #include "TGlobal.h" #include "HROOTCoreTGlobal.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -44,5 +21,4 @@ TGLOBAL_DEF_VIRT(TGlobal) TGLOBAL_DEF_NONVIRT(TGlobal) - diff --git a/csrc/HROOTCoreTGlobal.h b/csrc/HROOTCoreTGlobal.h --- a/csrc/HROOTCoreTGlobal.h +++ b/csrc/HROOTCoreTGlobal.h @@ -1,22 +1,21 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TGlobal__ #define __HROOT_CORE__TGlobal__ #include "HROOT-coreType.h" - #include "HROOTCoreTDictionary.h" #include "HROOTCoreTNamed.h" #include "HROOTCoreTObject.h" #include "HROOTCoreDeletable.h" -#undef TGLOBAL_DECL_VIRT +#undef TGLOBAL_DECL_VIRT #define TGLOBAL_DECL_VIRT(Type) \ -#undef TGLOBAL_DECL_NONVIRT +#undef TGLOBAL_DECL_NONVIRT #define TGLOBAL_DECL_NONVIRT(Type) \ @@ -45,3 +44,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTKey.cpp b/csrc/HROOTCoreTKey.cpp --- a/csrc/HROOTCoreTKey.cpp +++ b/csrc/HROOTCoreTKey.cpp @@ -1,33 +1,12 @@ #include - +#include "HROOTCoreTClass.h" +#include "HROOTCoreTDirectory.h" #include "HROOTCoreTNamed.h" #include "TKey.h" #include "HROOTCoreTKey.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -43,5 +22,4 @@ TKEY_DEF_VIRT(TKey) TKEY_DEF_NONVIRT(TKey) - diff --git a/csrc/HROOTCoreTKey.h b/csrc/HROOTCoreTKey.h --- a/csrc/HROOTCoreTKey.h +++ b/csrc/HROOTCoreTKey.h @@ -1,23 +1,22 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TKey__ #define __HROOT_CORE__TKey__ #include "HROOT-coreType.h" - #include "HROOTCoreTNamed.h" #include "HROOTCoreTObject.h" #include "HROOTCoreDeletable.h" -#undef TKEY_DECL_VIRT +#undef TKEY_DECL_VIRT #define TKEY_DECL_VIRT(Type) \ -#undef TKEY_DECL_NONVIRT +#undef TKEY_DECL_NONVIRT #define TKEY_DECL_NONVIRT(Type) \ - +Type ## _p Type ## _newTKey ( const char* name, const char* title, TClass_p cl, int nbytes, TDirectory_p motherDir ) #undef TKEY_DEF_VIRT #define TKEY_DEF_VIRT(Type)\ @@ -25,7 +24,11 @@ #undef TKEY_DEF_NONVIRT #define TKEY_DEF_NONVIRT(Type)\ - +Type ## _p Type ## _newTKey ( const char* name, const char* title, TClass_p cl, int nbytes, TDirectory_p motherDir )\ +{\ +Type * newp = new Type (name, title, to_nonconst(cl), nbytes, to_nonconst(motherDir)); \ +return to_nonconst(newp);\ +} TNAMED_DECL_VIRT(TKey); TOBJECT_DECL_VIRT(TKey); @@ -43,3 +46,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTNamed.cpp b/csrc/HROOTCoreTNamed.cpp --- a/csrc/HROOTCoreTNamed.cpp +++ b/csrc/HROOTCoreTNamed.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreTObject.h" #include "TNamed.h" #include "HROOTCoreTNamed.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -42,5 +19,4 @@ TNAMED_DEF_VIRT(TNamed) TNAMED_DEF_NONVIRT(TNamed) - diff --git a/csrc/HROOTCoreTNamed.h b/csrc/HROOTCoreTNamed.h --- a/csrc/HROOTCoreTNamed.h +++ b/csrc/HROOTCoreTNamed.h @@ -1,22 +1,21 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TNamed__ #define __HROOT_CORE__TNamed__ #include "HROOT-coreType.h" - #include "HROOTCoreTObject.h" #include "HROOTCoreDeletable.h" -#undef TNAMED_DECL_VIRT +#undef TNAMED_DECL_VIRT #define TNAMED_DECL_VIRT(Type) \ void Type ## _SetName ( Type ## _p p, const char* name ); \ void Type ## _SetNameTitle ( Type ## _p p, const char* name, const char* title ); \ void Type ## _SetTitle ( Type ## _p p, const char* name ) -#undef TNAMED_DECL_NONVIRT +#undef TNAMED_DECL_NONVIRT #define TNAMED_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTNamed ( const char* name, const char* title ) @@ -58,3 +57,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTObjArray.cpp b/csrc/HROOTCoreTObjArray.cpp --- a/csrc/HROOTCoreTObjArray.cpp +++ b/csrc/HROOTCoreTObjArray.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreTSeqCollection.h" #include "TObjArray.h" #include "HROOTCoreTObjArray.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -44,5 +21,4 @@ TOBJARRAY_DEF_VIRT(TObjArray) TOBJARRAY_DEF_NONVIRT(TObjArray) - diff --git a/csrc/HROOTCoreTObjArray.h b/csrc/HROOTCoreTObjArray.h --- a/csrc/HROOTCoreTObjArray.h +++ b/csrc/HROOTCoreTObjArray.h @@ -1,22 +1,21 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TObjArray__ #define __HROOT_CORE__TObjArray__ #include "HROOT-coreType.h" - #include "HROOTCoreTSeqCollection.h" #include "HROOTCoreTCollection.h" #include "HROOTCoreTObject.h" #include "HROOTCoreDeletable.h" -#undef TOBJARRAY_DECL_VIRT +#undef TOBJARRAY_DECL_VIRT #define TOBJARRAY_DECL_VIRT(Type) \ -#undef TOBJARRAY_DECL_NONVIRT +#undef TOBJARRAY_DECL_NONVIRT #define TOBJARRAY_DECL_NONVIRT(Type) \ @@ -45,3 +44,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTObject.cpp b/csrc/HROOTCoreTObject.cpp --- a/csrc/HROOTCoreTObject.cpp +++ b/csrc/HROOTCoreTObject.cpp @@ -1,34 +1,11 @@ #include - #include "HROOTCoreTClass.h" #include "HROOTCoreDeletable.h" #include "TObject.h" #include "HROOTCoreTObject.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -42,5 +19,4 @@ TOBJECT_DEF_VIRT(TObject) TOBJECT_DEF_NONVIRT(TObject) - diff --git a/csrc/HROOTCoreTObject.h b/csrc/HROOTCoreTObject.h --- a/csrc/HROOTCoreTObject.h +++ b/csrc/HROOTCoreTObject.h @@ -1,15 +1,14 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TObject__ #define __HROOT_CORE__TObject__ #include "HROOT-coreType.h" - #include "HROOTCoreDeletable.h" -#undef TOBJECT_DECL_VIRT +#undef TOBJECT_DECL_VIRT #define TOBJECT_DECL_VIRT(Type) \ void Type ## _Draw ( Type ## _p p, const char* option ); \ TObject_p Type ## _FindObject ( Type ## _p p, const char* name ); \ @@ -20,7 +19,7 @@ void Type ## _SaveAs ( Type ## _p p, const char* filename, const char* option ); \ int Type ## _Write ( Type ## _p p, const char* name, int option, int bufsize ) -#undef TOBJECT_DECL_NONVIRT +#undef TOBJECT_DECL_NONVIRT #define TOBJECT_DECL_NONVIRT(Type) \ Type ## _p Type ## _newTObject ( ); \ int Type ## _tObjectGetObjectStat ( ) @@ -86,3 +85,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTQObject.cpp b/csrc/HROOTCoreTQObject.cpp --- a/csrc/HROOTCoreTQObject.cpp +++ b/csrc/HROOTCoreTQObject.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreDeletable.h" #include "TQObject.h" #include "HROOTCoreTQObject.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -41,5 +18,4 @@ TQOBJECT_DEF_VIRT(TQObject) TQOBJECT_DEF_NONVIRT(TQObject) - diff --git a/csrc/HROOTCoreTQObject.h b/csrc/HROOTCoreTQObject.h --- a/csrc/HROOTCoreTQObject.h +++ b/csrc/HROOTCoreTQObject.h @@ -1,19 +1,18 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TQObject__ #define __HROOT_CORE__TQObject__ #include "HROOT-coreType.h" - #include "HROOTCoreDeletable.h" -#undef TQOBJECT_DECL_VIRT +#undef TQOBJECT_DECL_VIRT #define TQOBJECT_DECL_VIRT(Type) \ -#undef TQOBJECT_DECL_NONVIRT +#undef TQOBJECT_DECL_NONVIRT #define TQOBJECT_DECL_NONVIRT(Type) \ @@ -39,3 +38,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTROOT.cpp b/csrc/HROOTCoreTROOT.cpp --- a/csrc/HROOTCoreTROOT.cpp +++ b/csrc/HROOTCoreTROOT.cpp @@ -1,35 +1,12 @@ #include - #include "HROOTCoreTGlobal.h" #include "HROOTCoreTDirectory.h" #include "TROOT.h" #include "HROOTCoreTROOT.h" -using namespace std; using namespace ROOT; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -46,5 +23,4 @@ TROOT_DEF_VIRT(TROOT) TROOT_DEF_NONVIRT(TROOT) - diff --git a/csrc/HROOTCoreTROOT.h b/csrc/HROOTCoreTROOT.h --- a/csrc/HROOTCoreTROOT.h +++ b/csrc/HROOTCoreTROOT.h @@ -1,22 +1,21 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TROOT__ #define __HROOT_CORE__TROOT__ #include "HROOT-coreType.h" - #include "HROOTCoreTDirectory.h" #include "HROOTCoreTNamed.h" #include "HROOTCoreTObject.h" #include "HROOTCoreDeletable.h" -#undef TROOT_DECL_VIRT +#undef TROOT_DECL_VIRT #define TROOT_DECL_VIRT(Type) \ -#undef TROOT_DECL_NONVIRT +#undef TROOT_DECL_NONVIRT #define TROOT_DECL_NONVIRT(Type) \ TGlobal_p Type ## _tROOTGetGlobal ( Type ## _p p, const char* name, int load ); \ int Type ## _tROOTInitialized ( ) @@ -53,3 +52,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTSeqCollection.cpp b/csrc/HROOTCoreTSeqCollection.cpp --- a/csrc/HROOTCoreTSeqCollection.cpp +++ b/csrc/HROOTCoreTSeqCollection.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreTCollection.h" #include "TSeqCollection.h" #include "HROOTCoreTSeqCollection.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -43,5 +20,4 @@ TSEQCOLLECTION_DEF_VIRT(TSeqCollection) TSEQCOLLECTION_DEF_NONVIRT(TSeqCollection) - diff --git a/csrc/HROOTCoreTSeqCollection.h b/csrc/HROOTCoreTSeqCollection.h --- a/csrc/HROOTCoreTSeqCollection.h +++ b/csrc/HROOTCoreTSeqCollection.h @@ -1,21 +1,20 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TSeqCollection__ #define __HROOT_CORE__TSeqCollection__ #include "HROOT-coreType.h" - #include "HROOTCoreTCollection.h" #include "HROOTCoreTObject.h" #include "HROOTCoreDeletable.h" -#undef TSEQCOLLECTION_DECL_VIRT +#undef TSEQCOLLECTION_DECL_VIRT #define TSEQCOLLECTION_DECL_VIRT(Type) \ -#undef TSEQCOLLECTION_DECL_NONVIRT +#undef TSEQCOLLECTION_DECL_NONVIRT #define TSEQCOLLECTION_DECL_NONVIRT(Type) \ @@ -43,3 +42,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTSystem.cpp b/csrc/HROOTCoreTSystem.cpp --- a/csrc/HROOTCoreTSystem.cpp +++ b/csrc/HROOTCoreTSystem.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreTNamed.h" #include "TSystem.h" #include "HROOTCoreTSystem.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -43,5 +20,4 @@ TSYSTEM_DEF_VIRT(TSystem) TSYSTEM_DEF_NONVIRT(TSystem) - diff --git a/csrc/HROOTCoreTSystem.h b/csrc/HROOTCoreTSystem.h --- a/csrc/HROOTCoreTSystem.h +++ b/csrc/HROOTCoreTSystem.h @@ -1,21 +1,20 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TSystem__ #define __HROOT_CORE__TSystem__ #include "HROOT-coreType.h" - #include "HROOTCoreTNamed.h" #include "HROOTCoreTObject.h" #include "HROOTCoreDeletable.h" -#undef TSYSTEM_DECL_VIRT +#undef TSYSTEM_DECL_VIRT #define TSYSTEM_DECL_VIRT(Type) \ int Type ## _ProcessEvents ( Type ## _p p ) -#undef TSYSTEM_DECL_NONVIRT +#undef TSYSTEM_DECL_NONVIRT #define TSYSTEM_DECL_NONVIRT(Type) \ @@ -46,3 +45,4 @@ #ifdef __cplusplus } #endif + diff --git a/csrc/HROOTCoreTVirtualPad.cpp b/csrc/HROOTCoreTVirtualPad.cpp --- a/csrc/HROOTCoreTVirtualPad.cpp +++ b/csrc/HROOTCoreTVirtualPad.cpp @@ -1,33 +1,10 @@ #include - #include "HROOTCoreTObject.h" #include "TVirtualPad.h" #include "HROOTCoreTVirtualPad.h" -using namespace std; -template -const ToType* to_const(const FromType* x) { - return reinterpret_cast(x); -} - -template -ToType* to_nonconst(FromType* x) { - return reinterpret_cast(x); -} - -template -const ToType& to_constref(const FromType& x) { - return reinterpret_cast(x); -} - -template -ToType& to_nonconstref(FromType& x) { - return reinterpret_cast(x); -} - - #define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ @@ -42,5 +19,4 @@ TVIRTUALPAD_DEF_VIRT(TVirtualPad) TVIRTUALPAD_DEF_NONVIRT(TVirtualPad) - diff --git a/csrc/HROOTCoreTVirtualPad.h b/csrc/HROOTCoreTVirtualPad.h --- a/csrc/HROOTCoreTVirtualPad.h +++ b/csrc/HROOTCoreTVirtualPad.h @@ -1,16 +1,15 @@ #ifdef __cplusplus extern "C" { -#endif +#endif #ifndef __HROOT_CORE__TVirtualPad__ #define __HROOT_CORE__TVirtualPad__ #include "HROOT-coreType.h" - #include "HROOTCoreTObject.h" #include "HROOTCoreDeletable.h" -#undef TVIRTUALPAD_DECL_VIRT +#undef TVIRTUALPAD_DECL_VIRT #define TVIRTUALPAD_DECL_VIRT(Type) \ Type ## _p Type ## _cd ( Type ## _p p, int subpadnumber ); \ void Type ## _divide_tvirtualpad ( Type ## _p p, int nx, int ny, double xmargin, double ymargin, int color ); \ @@ -18,7 +17,7 @@ void Type ## _SetLogy ( Type ## _p p, int value ); \ void Type ## _SetLogz ( Type ## _p p, int value ) -#undef TVIRTUALPAD_DECL_NONVIRT +#undef TVIRTUALPAD_DECL_NONVIRT #define TVIRTUALPAD_DECL_NONVIRT(Type) \ @@ -64,3 +63,4 @@ #ifdef __cplusplus } #endif + diff --git a/src/HROOT/Core.hs b/src/HROOT/Core.hs --- a/src/HROOT/Core.hs +++ b/src/HROOT/Core.hs @@ -1,5 +1,5 @@ module HROOT.Core ( -module HROOT.Core.Deletable + module HROOT.Core.Deletable , module HROOT.Core.TApplication , module HROOT.Core.TArray , module HROOT.Core.TArrayC @@ -34,7 +34,7 @@ , module HROOT.Core.TVirtualPad , getROOT , gROOT -, gSystem +, gSystem ) where import HROOT.Core.Deletable @@ -76,15 +76,12 @@ import FFICXX.Runtime.Cast import HROOT.Core.TROOT.RawType import HROOT.Core.TSystem.RawType - -foreign import ccall "HROOT-coreTopLevel.h TopLevel_GetROOT" c_getroot - :: IO (Ptr RawTROOT) - -foreign import ccall "HROOT-coreTopLevel.h TopLevel_gROOT" c_groot - :: IO (Ptr RawTROOT) - -foreign import ccall "HROOT-coreTopLevel.h TopLevel_gSystem" c_gsystem - :: IO (Ptr RawTSystem) +foreign import ccall safe "HROOT-coreTopLevel.h TopLevel_GetROOT" + c_getroot :: IO (Ptr RawTROOT) +foreign import ccall safe "HROOT-coreTopLevel.h TopLevel_gROOT" + c_groot :: IO (Ptr RawTROOT) +foreign import ccall safe "HROOT-coreTopLevel.h TopLevel_gSystem" + c_gsystem :: IO (Ptr RawTSystem) getROOT :: IO TROOT getROOT = xformnull c_getroot @@ -94,3 +91,4 @@ gSystem :: IO TSystem gSystem = xformnull c_gsystem + diff --git a/src/HROOT/Core/Deletable.hs b/src/HROOT/Core/Deletable.hs --- a/src/HROOT/Core/Deletable.hs +++ b/src/HROOT/Core/Deletable.hs @@ -1,10 +1,4 @@ -module HROOT.Core.Deletable - ( - IDeletable(..) - ) where - +module HROOT.Core.Deletable (IDeletable(..)) where import HROOT.Core.Deletable.RawType import HROOT.Core.Deletable.Interface import HROOT.Core.Deletable.Implementation - - diff --git a/src/HROOT/Core/Deletable/Cast.hs b/src/HROOT/Core/Deletable/Cast.hs --- a/src/HROOT/Core/Deletable/Cast.hs +++ b/src/HROOT/Core/Deletable/Cast.hs @@ -1,18 +1,9 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.Deletable.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.Deletable.RawType import HROOT.Core.Deletable.Interface - - - - diff --git a/src/HROOT/Core/Deletable/FFI.hsc b/src/HROOT/Core/Deletable/FFI.hsc --- a/src/HROOT/Core/Deletable/FFI.hsc +++ b/src/HROOT/Core/Deletable/FFI.hsc @@ -1,21 +1,5 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.Deletable.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.Deletable.RawType - - -#include "HROOTCoreDeletable.h" - - - diff --git a/src/HROOT/Core/Deletable/Implementation.hs b/src/HROOT/Core/Deletable/Implementation.hs --- a/src/HROOT/Core/Deletable/Implementation.hs +++ b/src/HROOT/Core/Deletable/Implementation.hs @@ -1,35 +1,14 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.Deletable.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.Deletable.RawType import HROOT.Core.Deletable.FFI import HROOT.Core.Deletable.Interface import HROOT.Core.Deletable.Cast - - - -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - - - - - - - - - - - - - diff --git a/src/HROOT/Core/Deletable/Interface.hs b/src/HROOT/Core/Deletable/Interface.hs --- a/src/HROOT/Core/Deletable/Interface.hs +++ b/src/HROOT/Core/Deletable/Interface.hs @@ -1,31 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.Deletable.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.Deletable.RawType - ----- ============ ---- - - - class IDeletable a where - - delete :: a -> IO () - - - - - - + delete :: a -> IO () diff --git a/src/HROOT/Core/Deletable/RawType.hs b/src/HROOT/Core/Deletable/RawType.hs --- a/src/HROOT/Core/Deletable/RawType.hs +++ b/src/HROOT/Core/Deletable/RawType.hs @@ -1,11 +1,6 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.Deletable.RawType where - - -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast - - +import Foreign.Ptr +import FFICXX.Runtime.Cast diff --git a/src/HROOT/Core/TApplication.hs b/src/HROOT/Core/TApplication.hs --- a/src/HROOT/Core/TApplication.hs +++ b/src/HROOT/Core/TApplication.hs @@ -1,15 +1,7 @@ module HROOT.Core.TApplication - ( - TApplication(..) - , ITApplication(..) - , upcastTApplication - , downcastTApplication - , newTApplication - - ) where - + (TApplication(..), ITApplication(..), upcastTApplication, + downcastTApplication, newTApplication) + where import HROOT.Core.TApplication.RawType import HROOT.Core.TApplication.Interface import HROOT.Core.TApplication.Implementation - - diff --git a/src/HROOT/Core/TApplication/Cast.hs b/src/HROOT/Core/TApplication/Cast.hs --- a/src/HROOT/Core/TApplication/Cast.hs +++ b/src/HROOT/Core/TApplication/Cast.hs @@ -1,22 +1,18 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TApplication.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TApplication.RawType import HROOT.Core.TApplication.Interface -instance (ITApplication a, FPtr a) => Castable a (Ptr RawTApplication) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ +instance (ITApplication a, FPtr a) => Castable a + (Ptr RawTApplication) where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TApplication (Ptr RawTApplication) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TApplication/FFI.hsc b/src/HROOT/Core/TApplication/FFI.hsc --- a/src/HROOT/Core/TApplication/FFI.hsc +++ b/src/HROOT/Core/TApplication/FFI.hsc @@ -1,53 +1,54 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TApplication.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TApplication.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTCoreTApplication.h" - -foreign import ccall "HROOTCoreTApplication.h TApplication_Draw" c_tapplication_draw - :: (Ptr RawTApplication) -> CString -> IO () - -foreign import ccall "HROOTCoreTApplication.h TApplication_FindObject" c_tapplication_findobject - :: (Ptr RawTApplication) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe + "HROOTCoreTApplication.h TApplication_Draw" c_tapplication_draw :: + Ptr RawTApplication -> CString -> IO () -foreign import ccall "HROOTCoreTApplication.h TApplication_GetName" c_tapplication_getname - :: (Ptr RawTApplication) -> IO CString +foreign import ccall safe + "HROOTCoreTApplication.h TApplication_FindObject" + c_tapplication_findobject :: + Ptr RawTApplication -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTCoreTApplication.h TApplication_IsA" c_tapplication_isa - :: (Ptr RawTApplication) -> IO (Ptr RawTClass) +foreign import ccall safe + "HROOTCoreTApplication.h TApplication_GetName" + c_tapplication_getname :: Ptr RawTApplication -> IO CString -foreign import ccall "HROOTCoreTApplication.h TApplication_Paint" c_tapplication_paint - :: (Ptr RawTApplication) -> CString -> IO () +foreign import ccall safe + "HROOTCoreTApplication.h TApplication_IsA" c_tapplication_isa :: + Ptr RawTApplication -> IO (Ptr RawTClass) -foreign import ccall "HROOTCoreTApplication.h TApplication_printObj" c_tapplication_printobj - :: (Ptr RawTApplication) -> CString -> IO () +foreign import ccall safe + "HROOTCoreTApplication.h TApplication_Paint" c_tapplication_paint + :: Ptr RawTApplication -> CString -> IO () -foreign import ccall "HROOTCoreTApplication.h TApplication_SaveAs" c_tapplication_saveas - :: (Ptr RawTApplication) -> CString -> CString -> IO () +foreign import ccall safe + "HROOTCoreTApplication.h TApplication_printObj" + c_tapplication_printobj :: Ptr RawTApplication -> CString -> IO () -foreign import ccall "HROOTCoreTApplication.h TApplication_Write" c_tapplication_write - :: (Ptr RawTApplication) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe + "HROOTCoreTApplication.h TApplication_SaveAs" c_tapplication_saveas + :: Ptr RawTApplication -> CString -> CString -> IO () -foreign import ccall "HROOTCoreTApplication.h TApplication_delete" c_tapplication_delete - :: (Ptr RawTApplication) -> IO () +foreign import ccall safe + "HROOTCoreTApplication.h TApplication_Write" c_tapplication_write + :: Ptr RawTApplication -> CString -> CInt -> CInt -> IO CInt -foreign import ccall "HROOTCoreTApplication.h TApplication_newTApplication" c_tapplication_newtapplication - :: CString -> (Ptr CInt) -> (Ptr (CString)) -> IO (Ptr RawTApplication) +foreign import ccall safe + "HROOTCoreTApplication.h TApplication_delete" c_tapplication_delete + :: Ptr RawTApplication -> IO () -foreign import ccall "HROOTCoreTApplication.h TApplication_Run" c_tapplication_run - :: (Ptr RawTApplication) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTApplication.h TApplication_newTApplication" + c_tapplication_newtapplication :: + CString -> + (Ptr CInt) -> (Ptr (CString)) -> IO (Ptr RawTApplication) +foreign import ccall safe + "HROOTCoreTApplication.h TApplication_Run" c_tapplication_run :: + Ptr RawTApplication -> CInt -> IO () diff --git a/src/HROOT/Core/TApplication/Implementation.hs b/src/HROOT/Core/TApplication/Implementation.hs --- a/src/HROOT/Core/TApplication/Implementation.hs +++ b/src/HROOT/Core/TApplication/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TApplication.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TApplication.RawType import HROOT.Core.TApplication.FFI import HROOT.Core.TApplication.Interface @@ -24,54 +25,25 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - - instance ITApplication TApplication where - run = xform1 c_tapplication_run -instance ITObject TApplication where - draw = xform1 c_tapplication_draw - findObject = xform1 c_tapplication_findobject - getName = xform0 c_tapplication_getname - isA = xform0 c_tapplication_isa - paint = xform1 c_tapplication_paint - printObj = xform1 c_tapplication_printobj - saveAs = xform2 c_tapplication_saveas - write = xform3 c_tapplication_write -instance ITQObject TApplication where -instance IDeletable TApplication where - delete = xform0 c_tapplication_delete + run = xform1 c_tapplication_run -instance ITApplication (Exist TApplication) where - run (ETApplication x) = run x -instance ITObject (Exist TApplication) where - draw (ETApplication x) = draw x - findObject (ETApplication x) = findObject x - getName (ETApplication x) = getName x - isA (ETApplication x) = isA x - paint (ETApplication x) = paint x - printObj (ETApplication x) = printObj x - saveAs (ETApplication x) = saveAs x - write (ETApplication x) = write x -instance ITQObject (Exist TApplication) where +instance ITObject TApplication where + draw = xform1 c_tapplication_draw + findObject = xform1 c_tapplication_findobject + getName = xform0 c_tapplication_getname + isA = xform0 c_tapplication_isa + paint = xform1 c_tapplication_paint + printObj = xform1 c_tapplication_printobj + saveAs = xform2 c_tapplication_saveas + write = xform3 c_tapplication_write -instance IDeletable (Exist TApplication) where - delete (ETApplication x) = delete x +instance ITQObject TApplication +instance IDeletable TApplication where + delete = xform0 c_tapplication_delete -newTApplication :: CString -> (Ptr CInt) -> (Ptr CString) -> IO TApplication +newTApplication :: + Castable c0 CString => + c0 -> (Ptr CInt) -> (Ptr CString) -> IO TApplication newTApplication = xform2 c_tapplication_newtapplication - - - - - -instance FPtr (Exist TApplication) where - type Raw (Exist TApplication) = RawTApplication - get_fptr (ETApplication obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETApplication (cast_fptr_to_obj (fptr :: ForeignPtr RawTApplication) :: TApplication) diff --git a/src/HROOT/Core/TApplication/Interface.hs b/src/HROOT/Core/TApplication/Interface.hs --- a/src/HROOT/Core/TApplication/Interface.hs +++ b/src/HROOT/Core/TApplication/Interface.hs @@ -1,39 +1,29 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TApplication.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TApplication.RawType - import HROOT.Core.TObject.Interface import HROOT.Core.TQObject.Interface ----- ============ ---- - - -class (ITObject a,ITQObject a) => ITApplication a where - - run :: a -> CInt -> IO () - -instance Existable TApplication where - data Exist TApplication = forall a. (FPtr a, ITApplication a) => ETApplication a +class (ITObject a, ITQObject a) => ITApplication a where + run :: a -> CInt -> IO () -upcastTApplication :: (FPtr a, ITApplication a) => a -> TApplication -upcastTApplication h = let fh = get_fptr h - fh2 :: ForeignPtr RawTApplication = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTApplication :: + forall a . (FPtr a, ITApplication a) => a -> TApplication +upcastTApplication h + = let fh = get_fptr h + fh2 :: Ptr RawTApplication = castPtr fh + in cast_fptr_to_obj fh2 -downcastTApplication :: (FPtr a, ITApplication a) => TApplication -> a -downcastTApplication h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTApplication :: + forall a . (FPtr a, ITApplication a) => TApplication -> a +downcastTApplication h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TApplication/RawType.hs b/src/HROOT/Core/TApplication/RawType.hs --- a/src/HROOT/Core/TApplication/RawType.hs +++ b/src/HROOT/Core/TApplication/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TApplication.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTApplication -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TApplication = TApplication (Ptr RawTApplication) + deriving (Eq, Ord, Show) -data RawTApplication -newtype TApplication = TApplication (ForeignPtr RawTApplication) deriving (Eq, Ord, Show) instance FPtr TApplication where - type Raw TApplication = RawTApplication - get_fptr (TApplication fptr) = fptr - cast_fptr_to_obj = TApplication + type Raw TApplication = RawTApplication + get_fptr (TApplication ptr) = ptr + cast_fptr_to_obj = TApplication diff --git a/src/HROOT/Core/TArray.hs b/src/HROOT/Core/TArray.hs --- a/src/HROOT/Core/TArray.hs +++ b/src/HROOT/Core/TArray.hs @@ -1,15 +1,5 @@ module HROOT.Core.TArray - ( - TArray(..) - , ITArray - , upcastTArray - , downcastTArray - - - ) where - + (TArray(..), ITArray, upcastTArray, downcastTArray) where import HROOT.Core.TArray.RawType import HROOT.Core.TArray.Interface import HROOT.Core.TArray.Implementation - - diff --git a/src/HROOT/Core/TArray/Cast.hs b/src/HROOT/Core/TArray/Cast.hs --- a/src/HROOT/Core/TArray/Cast.hs +++ b/src/HROOT/Core/TArray/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TArray.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TArray.RawType import HROOT.Core.TArray.Interface instance (ITArray a, FPtr a) => Castable a (Ptr RawTArray) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TArray (Ptr RawTArray) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TArray/FFI.hsc b/src/HROOT/Core/TArray/FFI.hsc --- a/src/HROOT/Core/TArray/FFI.hsc +++ b/src/HROOT/Core/TArray/FFI.hsc @@ -1,22 +1,8 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TArray.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TArray.RawType - -#include "HROOTCoreTArray.h" - -foreign import ccall "HROOTCoreTArray.h TArray_delete" c_tarray_delete - :: (Ptr RawTArray) -> IO () - +foreign import ccall safe "HROOTCoreTArray.h TArray_delete" + c_tarray_delete :: Ptr RawTArray -> IO () diff --git a/src/HROOT/Core/TArray/Implementation.hs b/src/HROOT/Core/TArray/Implementation.hs --- a/src/HROOT/Core/TArray/Implementation.hs +++ b/src/HROOT/Core/TArray/Implementation.hs @@ -1,45 +1,22 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TArray.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TArray.RawType import HROOT.Core.TArray.FFI import HROOT.Core.TArray.Interface import HROOT.Core.TArray.Cast - import HROOT.Core.Deletable.RawType import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - +instance ITArray TArray -instance ITArray TArray where instance IDeletable TArray where - delete = xform0 c_tarray_delete - -instance ITArray (Exist TArray) where - -instance IDeletable (Exist TArray) where - delete (ETArray x) = delete x - - - - - - - -instance FPtr (Exist TArray) where - type Raw (Exist TArray) = RawTArray - get_fptr (ETArray obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETArray (cast_fptr_to_obj (fptr :: ForeignPtr RawTArray) :: TArray) + delete = xform0 c_tarray_delete diff --git a/src/HROOT/Core/TArray/Interface.hs b/src/HROOT/Core/TArray/Interface.hs --- a/src/HROOT/Core/TArray/Interface.hs +++ b/src/HROOT/Core/TArray/Interface.hs @@ -1,36 +1,25 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TArray.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TArray.RawType - import HROOT.Core.Deletable.Interface ----- ============ ---- - - -class (IDeletable a) => ITArray a where - -instance Existable TArray where - data Exist TArray = forall a. (FPtr a, ITArray a) => ETArray a +class IDeletable a => ITArray a -upcastTArray :: (FPtr a, ITArray a) => a -> TArray -upcastTArray h = let fh = get_fptr h - fh2 :: ForeignPtr RawTArray = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTArray :: forall a . (FPtr a, ITArray a) => a -> TArray +upcastTArray h + = let fh = get_fptr h + fh2 :: Ptr RawTArray = castPtr fh + in cast_fptr_to_obj fh2 -downcastTArray :: (FPtr a, ITArray a) => TArray -> a -downcastTArray h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTArray :: forall a . (FPtr a, ITArray a) => TArray -> a +downcastTArray h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TArray/RawType.hs b/src/HROOT/Core/TArray/RawType.hs --- a/src/HROOT/Core/TArray/RawType.hs +++ b/src/HROOT/Core/TArray/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TArray.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTArray -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TArray = TArray (Ptr RawTArray) + deriving (Eq, Ord, Show) -data RawTArray -newtype TArray = TArray (ForeignPtr RawTArray) deriving (Eq, Ord, Show) instance FPtr TArray where - type Raw TArray = RawTArray - get_fptr (TArray fptr) = fptr - cast_fptr_to_obj = TArray + type Raw TArray = RawTArray + get_fptr (TArray ptr) = ptr + cast_fptr_to_obj = TArray diff --git a/src/HROOT/Core/TArrayC.hs b/src/HROOT/Core/TArrayC.hs --- a/src/HROOT/Core/TArrayC.hs +++ b/src/HROOT/Core/TArrayC.hs @@ -1,15 +1,5 @@ module HROOT.Core.TArrayC - ( - TArrayC(..) - , ITArrayC - , upcastTArrayC - , downcastTArrayC - - - ) where - + (TArrayC(..), ITArrayC, upcastTArrayC, downcastTArrayC) where import HROOT.Core.TArrayC.RawType import HROOT.Core.TArrayC.Interface import HROOT.Core.TArrayC.Implementation - - diff --git a/src/HROOT/Core/TArrayC/Cast.hs b/src/HROOT/Core/TArrayC/Cast.hs --- a/src/HROOT/Core/TArrayC/Cast.hs +++ b/src/HROOT/Core/TArrayC/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TArrayC.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TArrayC.RawType import HROOT.Core.TArrayC.Interface instance (ITArrayC a, FPtr a) => Castable a (Ptr RawTArrayC) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TArrayC (Ptr RawTArrayC) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TArrayC/FFI.hsc b/src/HROOT/Core/TArrayC/FFI.hsc --- a/src/HROOT/Core/TArrayC/FFI.hsc +++ b/src/HROOT/Core/TArrayC/FFI.hsc @@ -1,22 +1,8 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TArrayC.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TArrayC.RawType - -#include "HROOTCoreTArrayC.h" - -foreign import ccall "HROOTCoreTArrayC.h TArrayC_delete" c_tarrayc_delete - :: (Ptr RawTArrayC) -> IO () - +foreign import ccall safe "HROOTCoreTArrayC.h TArrayC_delete" + c_tarrayc_delete :: Ptr RawTArrayC -> IO () diff --git a/src/HROOT/Core/TArrayC/Implementation.hs b/src/HROOT/Core/TArrayC/Implementation.hs --- a/src/HROOT/Core/TArrayC/Implementation.hs +++ b/src/HROOT/Core/TArrayC/Implementation.hs @@ -1,17 +1,17 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TArrayC.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TArrayC.RawType import HROOT.Core.TArrayC.FFI import HROOT.Core.TArrayC.Interface import HROOT.Core.TArrayC.Cast - import HROOT.Core.TArray.RawType import HROOT.Core.TArray.Cast import HROOT.Core.TArray.Interface @@ -19,33 +19,9 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe +instance ITArrayC TArrayC +instance ITArray TArrayC -instance ITArrayC TArrayC where -instance ITArray TArrayC where instance IDeletable TArrayC where - delete = xform0 c_tarrayc_delete - -instance ITArrayC (Exist TArrayC) where - -instance ITArray (Exist TArrayC) where - -instance IDeletable (Exist TArrayC) where - delete (ETArrayC x) = delete x - - - - - - - -instance FPtr (Exist TArrayC) where - type Raw (Exist TArrayC) = RawTArrayC - get_fptr (ETArrayC obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETArrayC (cast_fptr_to_obj (fptr :: ForeignPtr RawTArrayC) :: TArrayC) + delete = xform0 c_tarrayc_delete diff --git a/src/HROOT/Core/TArrayC/Interface.hs b/src/HROOT/Core/TArrayC/Interface.hs --- a/src/HROOT/Core/TArrayC/Interface.hs +++ b/src/HROOT/Core/TArrayC/Interface.hs @@ -1,36 +1,25 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TArrayC.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TArrayC.RawType - import HROOT.Core.TArray.Interface ----- ============ ---- - - -class (ITArray a) => ITArrayC a where - -instance Existable TArrayC where - data Exist TArrayC = forall a. (FPtr a, ITArrayC a) => ETArrayC a +class ITArray a => ITArrayC a -upcastTArrayC :: (FPtr a, ITArrayC a) => a -> TArrayC -upcastTArrayC h = let fh = get_fptr h - fh2 :: ForeignPtr RawTArrayC = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTArrayC :: forall a . (FPtr a, ITArrayC a) => a -> TArrayC +upcastTArrayC h + = let fh = get_fptr h + fh2 :: Ptr RawTArrayC = castPtr fh + in cast_fptr_to_obj fh2 -downcastTArrayC :: (FPtr a, ITArrayC a) => TArrayC -> a -downcastTArrayC h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTArrayC :: forall a . (FPtr a, ITArrayC a) => TArrayC -> a +downcastTArrayC h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TArrayC/RawType.hs b/src/HROOT/Core/TArrayC/RawType.hs --- a/src/HROOT/Core/TArrayC/RawType.hs +++ b/src/HROOT/Core/TArrayC/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TArrayC.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTArrayC -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TArrayC = TArrayC (Ptr RawTArrayC) + deriving (Eq, Ord, Show) -data RawTArrayC -newtype TArrayC = TArrayC (ForeignPtr RawTArrayC) deriving (Eq, Ord, Show) instance FPtr TArrayC where - type Raw TArrayC = RawTArrayC - get_fptr (TArrayC fptr) = fptr - cast_fptr_to_obj = TArrayC + type Raw TArrayC = RawTArrayC + get_fptr (TArrayC ptr) = ptr + cast_fptr_to_obj = TArrayC diff --git a/src/HROOT/Core/TArrayD.hs b/src/HROOT/Core/TArrayD.hs --- a/src/HROOT/Core/TArrayD.hs +++ b/src/HROOT/Core/TArrayD.hs @@ -1,15 +1,5 @@ module HROOT.Core.TArrayD - ( - TArrayD(..) - , ITArrayD - , upcastTArrayD - , downcastTArrayD - - - ) where - + (TArrayD(..), ITArrayD, upcastTArrayD, downcastTArrayD) where import HROOT.Core.TArrayD.RawType import HROOT.Core.TArrayD.Interface import HROOT.Core.TArrayD.Implementation - - diff --git a/src/HROOT/Core/TArrayD/Cast.hs b/src/HROOT/Core/TArrayD/Cast.hs --- a/src/HROOT/Core/TArrayD/Cast.hs +++ b/src/HROOT/Core/TArrayD/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TArrayD.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TArrayD.RawType import HROOT.Core.TArrayD.Interface instance (ITArrayD a, FPtr a) => Castable a (Ptr RawTArrayD) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TArrayD (Ptr RawTArrayD) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TArrayD/FFI.hsc b/src/HROOT/Core/TArrayD/FFI.hsc --- a/src/HROOT/Core/TArrayD/FFI.hsc +++ b/src/HROOT/Core/TArrayD/FFI.hsc @@ -1,22 +1,8 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TArrayD.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TArrayD.RawType - -#include "HROOTCoreTArrayD.h" - -foreign import ccall "HROOTCoreTArrayD.h TArrayD_delete" c_tarrayd_delete - :: (Ptr RawTArrayD) -> IO () - +foreign import ccall safe "HROOTCoreTArrayD.h TArrayD_delete" + c_tarrayd_delete :: Ptr RawTArrayD -> IO () diff --git a/src/HROOT/Core/TArrayD/Implementation.hs b/src/HROOT/Core/TArrayD/Implementation.hs --- a/src/HROOT/Core/TArrayD/Implementation.hs +++ b/src/HROOT/Core/TArrayD/Implementation.hs @@ -1,17 +1,17 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TArrayD.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TArrayD.RawType import HROOT.Core.TArrayD.FFI import HROOT.Core.TArrayD.Interface import HROOT.Core.TArrayD.Cast - import HROOT.Core.TArray.RawType import HROOT.Core.TArray.Cast import HROOT.Core.TArray.Interface @@ -19,33 +19,9 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe +instance ITArrayD TArrayD +instance ITArray TArrayD -instance ITArrayD TArrayD where -instance ITArray TArrayD where instance IDeletable TArrayD where - delete = xform0 c_tarrayd_delete - -instance ITArrayD (Exist TArrayD) where - -instance ITArray (Exist TArrayD) where - -instance IDeletable (Exist TArrayD) where - delete (ETArrayD x) = delete x - - - - - - - -instance FPtr (Exist TArrayD) where - type Raw (Exist TArrayD) = RawTArrayD - get_fptr (ETArrayD obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETArrayD (cast_fptr_to_obj (fptr :: ForeignPtr RawTArrayD) :: TArrayD) + delete = xform0 c_tarrayd_delete diff --git a/src/HROOT/Core/TArrayD/Interface.hs b/src/HROOT/Core/TArrayD/Interface.hs --- a/src/HROOT/Core/TArrayD/Interface.hs +++ b/src/HROOT/Core/TArrayD/Interface.hs @@ -1,36 +1,25 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TArrayD.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TArrayD.RawType - import HROOT.Core.TArray.Interface ----- ============ ---- - - -class (ITArray a) => ITArrayD a where - -instance Existable TArrayD where - data Exist TArrayD = forall a. (FPtr a, ITArrayD a) => ETArrayD a +class ITArray a => ITArrayD a -upcastTArrayD :: (FPtr a, ITArrayD a) => a -> TArrayD -upcastTArrayD h = let fh = get_fptr h - fh2 :: ForeignPtr RawTArrayD = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTArrayD :: forall a . (FPtr a, ITArrayD a) => a -> TArrayD +upcastTArrayD h + = let fh = get_fptr h + fh2 :: Ptr RawTArrayD = castPtr fh + in cast_fptr_to_obj fh2 -downcastTArrayD :: (FPtr a, ITArrayD a) => TArrayD -> a -downcastTArrayD h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTArrayD :: forall a . (FPtr a, ITArrayD a) => TArrayD -> a +downcastTArrayD h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TArrayD/RawType.hs b/src/HROOT/Core/TArrayD/RawType.hs --- a/src/HROOT/Core/TArrayD/RawType.hs +++ b/src/HROOT/Core/TArrayD/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TArrayD.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTArrayD -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TArrayD = TArrayD (Ptr RawTArrayD) + deriving (Eq, Ord, Show) -data RawTArrayD -newtype TArrayD = TArrayD (ForeignPtr RawTArrayD) deriving (Eq, Ord, Show) instance FPtr TArrayD where - type Raw TArrayD = RawTArrayD - get_fptr (TArrayD fptr) = fptr - cast_fptr_to_obj = TArrayD + type Raw TArrayD = RawTArrayD + get_fptr (TArrayD ptr) = ptr + cast_fptr_to_obj = TArrayD diff --git a/src/HROOT/Core/TArrayF.hs b/src/HROOT/Core/TArrayF.hs --- a/src/HROOT/Core/TArrayF.hs +++ b/src/HROOT/Core/TArrayF.hs @@ -1,15 +1,5 @@ module HROOT.Core.TArrayF - ( - TArrayF(..) - , ITArrayF - , upcastTArrayF - , downcastTArrayF - - - ) where - + (TArrayF(..), ITArrayF, upcastTArrayF, downcastTArrayF) where import HROOT.Core.TArrayF.RawType import HROOT.Core.TArrayF.Interface import HROOT.Core.TArrayF.Implementation - - diff --git a/src/HROOT/Core/TArrayF/Cast.hs b/src/HROOT/Core/TArrayF/Cast.hs --- a/src/HROOT/Core/TArrayF/Cast.hs +++ b/src/HROOT/Core/TArrayF/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TArrayF.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TArrayF.RawType import HROOT.Core.TArrayF.Interface instance (ITArrayF a, FPtr a) => Castable a (Ptr RawTArrayF) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TArrayF (Ptr RawTArrayF) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TArrayF/FFI.hsc b/src/HROOT/Core/TArrayF/FFI.hsc --- a/src/HROOT/Core/TArrayF/FFI.hsc +++ b/src/HROOT/Core/TArrayF/FFI.hsc @@ -1,22 +1,8 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TArrayF.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TArrayF.RawType - -#include "HROOTCoreTArrayF.h" - -foreign import ccall "HROOTCoreTArrayF.h TArrayF_delete" c_tarrayf_delete - :: (Ptr RawTArrayF) -> IO () - +foreign import ccall safe "HROOTCoreTArrayF.h TArrayF_delete" + c_tarrayf_delete :: Ptr RawTArrayF -> IO () diff --git a/src/HROOT/Core/TArrayF/Implementation.hs b/src/HROOT/Core/TArrayF/Implementation.hs --- a/src/HROOT/Core/TArrayF/Implementation.hs +++ b/src/HROOT/Core/TArrayF/Implementation.hs @@ -1,17 +1,17 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TArrayF.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TArrayF.RawType import HROOT.Core.TArrayF.FFI import HROOT.Core.TArrayF.Interface import HROOT.Core.TArrayF.Cast - import HROOT.Core.TArray.RawType import HROOT.Core.TArray.Cast import HROOT.Core.TArray.Interface @@ -19,33 +19,9 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe +instance ITArrayF TArrayF +instance ITArray TArrayF -instance ITArrayF TArrayF where -instance ITArray TArrayF where instance IDeletable TArrayF where - delete = xform0 c_tarrayf_delete - -instance ITArrayF (Exist TArrayF) where - -instance ITArray (Exist TArrayF) where - -instance IDeletable (Exist TArrayF) where - delete (ETArrayF x) = delete x - - - - - - - -instance FPtr (Exist TArrayF) where - type Raw (Exist TArrayF) = RawTArrayF - get_fptr (ETArrayF obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETArrayF (cast_fptr_to_obj (fptr :: ForeignPtr RawTArrayF) :: TArrayF) + delete = xform0 c_tarrayf_delete diff --git a/src/HROOT/Core/TArrayF/Interface.hs b/src/HROOT/Core/TArrayF/Interface.hs --- a/src/HROOT/Core/TArrayF/Interface.hs +++ b/src/HROOT/Core/TArrayF/Interface.hs @@ -1,36 +1,25 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TArrayF.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TArrayF.RawType - import HROOT.Core.TArray.Interface ----- ============ ---- - - -class (ITArray a) => ITArrayF a where - -instance Existable TArrayF where - data Exist TArrayF = forall a. (FPtr a, ITArrayF a) => ETArrayF a +class ITArray a => ITArrayF a -upcastTArrayF :: (FPtr a, ITArrayF a) => a -> TArrayF -upcastTArrayF h = let fh = get_fptr h - fh2 :: ForeignPtr RawTArrayF = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTArrayF :: forall a . (FPtr a, ITArrayF a) => a -> TArrayF +upcastTArrayF h + = let fh = get_fptr h + fh2 :: Ptr RawTArrayF = castPtr fh + in cast_fptr_to_obj fh2 -downcastTArrayF :: (FPtr a, ITArrayF a) => TArrayF -> a -downcastTArrayF h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTArrayF :: forall a . (FPtr a, ITArrayF a) => TArrayF -> a +downcastTArrayF h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TArrayF/RawType.hs b/src/HROOT/Core/TArrayF/RawType.hs --- a/src/HROOT/Core/TArrayF/RawType.hs +++ b/src/HROOT/Core/TArrayF/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TArrayF.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTArrayF -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TArrayF = TArrayF (Ptr RawTArrayF) + deriving (Eq, Ord, Show) -data RawTArrayF -newtype TArrayF = TArrayF (ForeignPtr RawTArrayF) deriving (Eq, Ord, Show) instance FPtr TArrayF where - type Raw TArrayF = RawTArrayF - get_fptr (TArrayF fptr) = fptr - cast_fptr_to_obj = TArrayF + type Raw TArrayF = RawTArrayF + get_fptr (TArrayF ptr) = ptr + cast_fptr_to_obj = TArrayF diff --git a/src/HROOT/Core/TArrayI.hs b/src/HROOT/Core/TArrayI.hs --- a/src/HROOT/Core/TArrayI.hs +++ b/src/HROOT/Core/TArrayI.hs @@ -1,15 +1,5 @@ module HROOT.Core.TArrayI - ( - TArrayI(..) - , ITArrayI - , upcastTArrayI - , downcastTArrayI - - - ) where - + (TArrayI(..), ITArrayI, upcastTArrayI, downcastTArrayI) where import HROOT.Core.TArrayI.RawType import HROOT.Core.TArrayI.Interface import HROOT.Core.TArrayI.Implementation - - diff --git a/src/HROOT/Core/TArrayI/Cast.hs b/src/HROOT/Core/TArrayI/Cast.hs --- a/src/HROOT/Core/TArrayI/Cast.hs +++ b/src/HROOT/Core/TArrayI/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TArrayI.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TArrayI.RawType import HROOT.Core.TArrayI.Interface instance (ITArrayI a, FPtr a) => Castable a (Ptr RawTArrayI) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TArrayI (Ptr RawTArrayI) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TArrayI/FFI.hsc b/src/HROOT/Core/TArrayI/FFI.hsc --- a/src/HROOT/Core/TArrayI/FFI.hsc +++ b/src/HROOT/Core/TArrayI/FFI.hsc @@ -1,22 +1,8 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TArrayI.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TArrayI.RawType - -#include "HROOTCoreTArrayI.h" - -foreign import ccall "HROOTCoreTArrayI.h TArrayI_delete" c_tarrayi_delete - :: (Ptr RawTArrayI) -> IO () - +foreign import ccall safe "HROOTCoreTArrayI.h TArrayI_delete" + c_tarrayi_delete :: Ptr RawTArrayI -> IO () diff --git a/src/HROOT/Core/TArrayI/Implementation.hs b/src/HROOT/Core/TArrayI/Implementation.hs --- a/src/HROOT/Core/TArrayI/Implementation.hs +++ b/src/HROOT/Core/TArrayI/Implementation.hs @@ -1,17 +1,17 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TArrayI.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TArrayI.RawType import HROOT.Core.TArrayI.FFI import HROOT.Core.TArrayI.Interface import HROOT.Core.TArrayI.Cast - import HROOT.Core.TArray.RawType import HROOT.Core.TArray.Cast import HROOT.Core.TArray.Interface @@ -19,33 +19,9 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe +instance ITArrayI TArrayI +instance ITArray TArrayI -instance ITArrayI TArrayI where -instance ITArray TArrayI where instance IDeletable TArrayI where - delete = xform0 c_tarrayi_delete - -instance ITArrayI (Exist TArrayI) where - -instance ITArray (Exist TArrayI) where - -instance IDeletable (Exist TArrayI) where - delete (ETArrayI x) = delete x - - - - - - - -instance FPtr (Exist TArrayI) where - type Raw (Exist TArrayI) = RawTArrayI - get_fptr (ETArrayI obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETArrayI (cast_fptr_to_obj (fptr :: ForeignPtr RawTArrayI) :: TArrayI) + delete = xform0 c_tarrayi_delete diff --git a/src/HROOT/Core/TArrayI/Interface.hs b/src/HROOT/Core/TArrayI/Interface.hs --- a/src/HROOT/Core/TArrayI/Interface.hs +++ b/src/HROOT/Core/TArrayI/Interface.hs @@ -1,36 +1,25 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TArrayI.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TArrayI.RawType - import HROOT.Core.TArray.Interface ----- ============ ---- - - -class (ITArray a) => ITArrayI a where - -instance Existable TArrayI where - data Exist TArrayI = forall a. (FPtr a, ITArrayI a) => ETArrayI a +class ITArray a => ITArrayI a -upcastTArrayI :: (FPtr a, ITArrayI a) => a -> TArrayI -upcastTArrayI h = let fh = get_fptr h - fh2 :: ForeignPtr RawTArrayI = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTArrayI :: forall a . (FPtr a, ITArrayI a) => a -> TArrayI +upcastTArrayI h + = let fh = get_fptr h + fh2 :: Ptr RawTArrayI = castPtr fh + in cast_fptr_to_obj fh2 -downcastTArrayI :: (FPtr a, ITArrayI a) => TArrayI -> a -downcastTArrayI h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTArrayI :: forall a . (FPtr a, ITArrayI a) => TArrayI -> a +downcastTArrayI h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TArrayI/RawType.hs b/src/HROOT/Core/TArrayI/RawType.hs --- a/src/HROOT/Core/TArrayI/RawType.hs +++ b/src/HROOT/Core/TArrayI/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TArrayI.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTArrayI -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TArrayI = TArrayI (Ptr RawTArrayI) + deriving (Eq, Ord, Show) -data RawTArrayI -newtype TArrayI = TArrayI (ForeignPtr RawTArrayI) deriving (Eq, Ord, Show) instance FPtr TArrayI where - type Raw TArrayI = RawTArrayI - get_fptr (TArrayI fptr) = fptr - cast_fptr_to_obj = TArrayI + type Raw TArrayI = RawTArrayI + get_fptr (TArrayI ptr) = ptr + cast_fptr_to_obj = TArrayI diff --git a/src/HROOT/Core/TArrayL.hs b/src/HROOT/Core/TArrayL.hs --- a/src/HROOT/Core/TArrayL.hs +++ b/src/HROOT/Core/TArrayL.hs @@ -1,15 +1,5 @@ module HROOT.Core.TArrayL - ( - TArrayL(..) - , ITArrayL - , upcastTArrayL - , downcastTArrayL - - - ) where - + (TArrayL(..), ITArrayL, upcastTArrayL, downcastTArrayL) where import HROOT.Core.TArrayL.RawType import HROOT.Core.TArrayL.Interface import HROOT.Core.TArrayL.Implementation - - diff --git a/src/HROOT/Core/TArrayL/Cast.hs b/src/HROOT/Core/TArrayL/Cast.hs --- a/src/HROOT/Core/TArrayL/Cast.hs +++ b/src/HROOT/Core/TArrayL/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TArrayL.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TArrayL.RawType import HROOT.Core.TArrayL.Interface instance (ITArrayL a, FPtr a) => Castable a (Ptr RawTArrayL) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TArrayL (Ptr RawTArrayL) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TArrayL/FFI.hsc b/src/HROOT/Core/TArrayL/FFI.hsc --- a/src/HROOT/Core/TArrayL/FFI.hsc +++ b/src/HROOT/Core/TArrayL/FFI.hsc @@ -1,22 +1,8 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TArrayL.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TArrayL.RawType - -#include "HROOTCoreTArrayL.h" - -foreign import ccall "HROOTCoreTArrayL.h TArrayL_delete" c_tarrayl_delete - :: (Ptr RawTArrayL) -> IO () - +foreign import ccall safe "HROOTCoreTArrayL.h TArrayL_delete" + c_tarrayl_delete :: Ptr RawTArrayL -> IO () diff --git a/src/HROOT/Core/TArrayL/Implementation.hs b/src/HROOT/Core/TArrayL/Implementation.hs --- a/src/HROOT/Core/TArrayL/Implementation.hs +++ b/src/HROOT/Core/TArrayL/Implementation.hs @@ -1,17 +1,17 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TArrayL.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TArrayL.RawType import HROOT.Core.TArrayL.FFI import HROOT.Core.TArrayL.Interface import HROOT.Core.TArrayL.Cast - import HROOT.Core.TArray.RawType import HROOT.Core.TArray.Cast import HROOT.Core.TArray.Interface @@ -19,33 +19,9 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe +instance ITArrayL TArrayL +instance ITArray TArrayL -instance ITArrayL TArrayL where -instance ITArray TArrayL where instance IDeletable TArrayL where - delete = xform0 c_tarrayl_delete - -instance ITArrayL (Exist TArrayL) where - -instance ITArray (Exist TArrayL) where - -instance IDeletable (Exist TArrayL) where - delete (ETArrayL x) = delete x - - - - - - - -instance FPtr (Exist TArrayL) where - type Raw (Exist TArrayL) = RawTArrayL - get_fptr (ETArrayL obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETArrayL (cast_fptr_to_obj (fptr :: ForeignPtr RawTArrayL) :: TArrayL) + delete = xform0 c_tarrayl_delete diff --git a/src/HROOT/Core/TArrayL/Interface.hs b/src/HROOT/Core/TArrayL/Interface.hs --- a/src/HROOT/Core/TArrayL/Interface.hs +++ b/src/HROOT/Core/TArrayL/Interface.hs @@ -1,36 +1,25 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TArrayL.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TArrayL.RawType - import HROOT.Core.TArray.Interface ----- ============ ---- - - -class (ITArray a) => ITArrayL a where - -instance Existable TArrayL where - data Exist TArrayL = forall a. (FPtr a, ITArrayL a) => ETArrayL a +class ITArray a => ITArrayL a -upcastTArrayL :: (FPtr a, ITArrayL a) => a -> TArrayL -upcastTArrayL h = let fh = get_fptr h - fh2 :: ForeignPtr RawTArrayL = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTArrayL :: forall a . (FPtr a, ITArrayL a) => a -> TArrayL +upcastTArrayL h + = let fh = get_fptr h + fh2 :: Ptr RawTArrayL = castPtr fh + in cast_fptr_to_obj fh2 -downcastTArrayL :: (FPtr a, ITArrayL a) => TArrayL -> a -downcastTArrayL h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTArrayL :: forall a . (FPtr a, ITArrayL a) => TArrayL -> a +downcastTArrayL h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TArrayL/RawType.hs b/src/HROOT/Core/TArrayL/RawType.hs --- a/src/HROOT/Core/TArrayL/RawType.hs +++ b/src/HROOT/Core/TArrayL/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TArrayL.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTArrayL -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TArrayL = TArrayL (Ptr RawTArrayL) + deriving (Eq, Ord, Show) -data RawTArrayL -newtype TArrayL = TArrayL (ForeignPtr RawTArrayL) deriving (Eq, Ord, Show) instance FPtr TArrayL where - type Raw TArrayL = RawTArrayL - get_fptr (TArrayL fptr) = fptr - cast_fptr_to_obj = TArrayL + type Raw TArrayL = RawTArrayL + get_fptr (TArrayL ptr) = ptr + cast_fptr_to_obj = TArrayL diff --git a/src/HROOT/Core/TArrayL64.hs b/src/HROOT/Core/TArrayL64.hs --- a/src/HROOT/Core/TArrayL64.hs +++ b/src/HROOT/Core/TArrayL64.hs @@ -1,15 +1,6 @@ module HROOT.Core.TArrayL64 - ( - TArrayL64(..) - , ITArrayL64 - , upcastTArrayL64 - , downcastTArrayL64 - - - ) where - + (TArrayL64(..), ITArrayL64, upcastTArrayL64, downcastTArrayL64) + where import HROOT.Core.TArrayL64.RawType import HROOT.Core.TArrayL64.Interface import HROOT.Core.TArrayL64.Implementation - - diff --git a/src/HROOT/Core/TArrayL64/Cast.hs b/src/HROOT/Core/TArrayL64/Cast.hs --- a/src/HROOT/Core/TArrayL64/Cast.hs +++ b/src/HROOT/Core/TArrayL64/Cast.hs @@ -1,22 +1,18 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TArrayL64.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TArrayL64.RawType import HROOT.Core.TArrayL64.Interface -instance (ITArrayL64 a, FPtr a) => Castable a (Ptr RawTArrayL64) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ +instance (ITArrayL64 a, FPtr a) => Castable a (Ptr RawTArrayL64) + where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TArrayL64 (Ptr RawTArrayL64) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TArrayL64/FFI.hsc b/src/HROOT/Core/TArrayL64/FFI.hsc --- a/src/HROOT/Core/TArrayL64/FFI.hsc +++ b/src/HROOT/Core/TArrayL64/FFI.hsc @@ -1,22 +1,8 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TArrayL64.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TArrayL64.RawType - -#include "HROOTCoreTArrayL64.h" - -foreign import ccall "HROOTCoreTArrayL64.h TArrayL64_delete" c_tarrayl64_delete - :: (Ptr RawTArrayL64) -> IO () - +foreign import ccall safe "HROOTCoreTArrayL64.h TArrayL64_delete" + c_tarrayl64_delete :: Ptr RawTArrayL64 -> IO () diff --git a/src/HROOT/Core/TArrayL64/Implementation.hs b/src/HROOT/Core/TArrayL64/Implementation.hs --- a/src/HROOT/Core/TArrayL64/Implementation.hs +++ b/src/HROOT/Core/TArrayL64/Implementation.hs @@ -1,17 +1,17 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TArrayL64.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TArrayL64.RawType import HROOT.Core.TArrayL64.FFI import HROOT.Core.TArrayL64.Interface import HROOT.Core.TArrayL64.Cast - import HROOT.Core.TArray.RawType import HROOT.Core.TArray.Cast import HROOT.Core.TArray.Interface @@ -19,33 +19,9 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe +instance ITArrayL64 TArrayL64 +instance ITArray TArrayL64 -instance ITArrayL64 TArrayL64 where -instance ITArray TArrayL64 where instance IDeletable TArrayL64 where - delete = xform0 c_tarrayl64_delete - -instance ITArrayL64 (Exist TArrayL64) where - -instance ITArray (Exist TArrayL64) where - -instance IDeletable (Exist TArrayL64) where - delete (ETArrayL64 x) = delete x - - - - - - - -instance FPtr (Exist TArrayL64) where - type Raw (Exist TArrayL64) = RawTArrayL64 - get_fptr (ETArrayL64 obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETArrayL64 (cast_fptr_to_obj (fptr :: ForeignPtr RawTArrayL64) :: TArrayL64) + delete = xform0 c_tarrayl64_delete diff --git a/src/HROOT/Core/TArrayL64/Interface.hs b/src/HROOT/Core/TArrayL64/Interface.hs --- a/src/HROOT/Core/TArrayL64/Interface.hs +++ b/src/HROOT/Core/TArrayL64/Interface.hs @@ -1,36 +1,27 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TArrayL64.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TArrayL64.RawType - import HROOT.Core.TArray.Interface ----- ============ ---- - - -class (ITArray a) => ITArrayL64 a where - -instance Existable TArrayL64 where - data Exist TArrayL64 = forall a. (FPtr a, ITArrayL64 a) => ETArrayL64 a +class ITArray a => ITArrayL64 a -upcastTArrayL64 :: (FPtr a, ITArrayL64 a) => a -> TArrayL64 -upcastTArrayL64 h = let fh = get_fptr h - fh2 :: ForeignPtr RawTArrayL64 = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTArrayL64 :: + forall a . (FPtr a, ITArrayL64 a) => a -> TArrayL64 +upcastTArrayL64 h + = let fh = get_fptr h + fh2 :: Ptr RawTArrayL64 = castPtr fh + in cast_fptr_to_obj fh2 -downcastTArrayL64 :: (FPtr a, ITArrayL64 a) => TArrayL64 -> a -downcastTArrayL64 h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTArrayL64 :: + forall a . (FPtr a, ITArrayL64 a) => TArrayL64 -> a +downcastTArrayL64 h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TArrayL64/RawType.hs b/src/HROOT/Core/TArrayL64/RawType.hs --- a/src/HROOT/Core/TArrayL64/RawType.hs +++ b/src/HROOT/Core/TArrayL64/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TArrayL64.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTArrayL64 -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TArrayL64 = TArrayL64 (Ptr RawTArrayL64) + deriving (Eq, Ord, Show) -data RawTArrayL64 -newtype TArrayL64 = TArrayL64 (ForeignPtr RawTArrayL64) deriving (Eq, Ord, Show) instance FPtr TArrayL64 where - type Raw TArrayL64 = RawTArrayL64 - get_fptr (TArrayL64 fptr) = fptr - cast_fptr_to_obj = TArrayL64 + type Raw TArrayL64 = RawTArrayL64 + get_fptr (TArrayL64 ptr) = ptr + cast_fptr_to_obj = TArrayL64 diff --git a/src/HROOT/Core/TArrayS.hs b/src/HROOT/Core/TArrayS.hs --- a/src/HROOT/Core/TArrayS.hs +++ b/src/HROOT/Core/TArrayS.hs @@ -1,15 +1,5 @@ module HROOT.Core.TArrayS - ( - TArrayS(..) - , ITArrayS - , upcastTArrayS - , downcastTArrayS - - - ) where - + (TArrayS(..), ITArrayS, upcastTArrayS, downcastTArrayS) where import HROOT.Core.TArrayS.RawType import HROOT.Core.TArrayS.Interface import HROOT.Core.TArrayS.Implementation - - diff --git a/src/HROOT/Core/TArrayS/Cast.hs b/src/HROOT/Core/TArrayS/Cast.hs --- a/src/HROOT/Core/TArrayS/Cast.hs +++ b/src/HROOT/Core/TArrayS/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TArrayS.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TArrayS.RawType import HROOT.Core.TArrayS.Interface instance (ITArrayS a, FPtr a) => Castable a (Ptr RawTArrayS) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TArrayS (Ptr RawTArrayS) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TArrayS/FFI.hsc b/src/HROOT/Core/TArrayS/FFI.hsc --- a/src/HROOT/Core/TArrayS/FFI.hsc +++ b/src/HROOT/Core/TArrayS/FFI.hsc @@ -1,22 +1,8 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TArrayS.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TArrayS.RawType - -#include "HROOTCoreTArrayS.h" - -foreign import ccall "HROOTCoreTArrayS.h TArrayS_delete" c_tarrays_delete - :: (Ptr RawTArrayS) -> IO () - +foreign import ccall safe "HROOTCoreTArrayS.h TArrayS_delete" + c_tarrays_delete :: Ptr RawTArrayS -> IO () diff --git a/src/HROOT/Core/TArrayS/Implementation.hs b/src/HROOT/Core/TArrayS/Implementation.hs --- a/src/HROOT/Core/TArrayS/Implementation.hs +++ b/src/HROOT/Core/TArrayS/Implementation.hs @@ -1,17 +1,17 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TArrayS.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TArrayS.RawType import HROOT.Core.TArrayS.FFI import HROOT.Core.TArrayS.Interface import HROOT.Core.TArrayS.Cast - import HROOT.Core.TArray.RawType import HROOT.Core.TArray.Cast import HROOT.Core.TArray.Interface @@ -19,33 +19,9 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe +instance ITArrayS TArrayS +instance ITArray TArrayS -instance ITArrayS TArrayS where -instance ITArray TArrayS where instance IDeletable TArrayS where - delete = xform0 c_tarrays_delete - -instance ITArrayS (Exist TArrayS) where - -instance ITArray (Exist TArrayS) where - -instance IDeletable (Exist TArrayS) where - delete (ETArrayS x) = delete x - - - - - - - -instance FPtr (Exist TArrayS) where - type Raw (Exist TArrayS) = RawTArrayS - get_fptr (ETArrayS obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETArrayS (cast_fptr_to_obj (fptr :: ForeignPtr RawTArrayS) :: TArrayS) + delete = xform0 c_tarrays_delete diff --git a/src/HROOT/Core/TArrayS/Interface.hs b/src/HROOT/Core/TArrayS/Interface.hs --- a/src/HROOT/Core/TArrayS/Interface.hs +++ b/src/HROOT/Core/TArrayS/Interface.hs @@ -1,36 +1,25 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TArrayS.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TArrayS.RawType - import HROOT.Core.TArray.Interface ----- ============ ---- - - -class (ITArray a) => ITArrayS a where - -instance Existable TArrayS where - data Exist TArrayS = forall a. (FPtr a, ITArrayS a) => ETArrayS a +class ITArray a => ITArrayS a -upcastTArrayS :: (FPtr a, ITArrayS a) => a -> TArrayS -upcastTArrayS h = let fh = get_fptr h - fh2 :: ForeignPtr RawTArrayS = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTArrayS :: forall a . (FPtr a, ITArrayS a) => a -> TArrayS +upcastTArrayS h + = let fh = get_fptr h + fh2 :: Ptr RawTArrayS = castPtr fh + in cast_fptr_to_obj fh2 -downcastTArrayS :: (FPtr a, ITArrayS a) => TArrayS -> a -downcastTArrayS h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTArrayS :: forall a . (FPtr a, ITArrayS a) => TArrayS -> a +downcastTArrayS h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TArrayS/RawType.hs b/src/HROOT/Core/TArrayS/RawType.hs --- a/src/HROOT/Core/TArrayS/RawType.hs +++ b/src/HROOT/Core/TArrayS/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TArrayS.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTArrayS -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TArrayS = TArrayS (Ptr RawTArrayS) + deriving (Eq, Ord, Show) -data RawTArrayS -newtype TArrayS = TArrayS (ForeignPtr RawTArrayS) deriving (Eq, Ord, Show) instance FPtr TArrayS where - type Raw TArrayS = RawTArrayS - get_fptr (TArrayS fptr) = fptr - cast_fptr_to_obj = TArrayS + type Raw TArrayS = RawTArrayS + get_fptr (TArrayS ptr) = ptr + cast_fptr_to_obj = TArrayS diff --git a/src/HROOT/Core/TAtt3D.hs b/src/HROOT/Core/TAtt3D.hs --- a/src/HROOT/Core/TAtt3D.hs +++ b/src/HROOT/Core/TAtt3D.hs @@ -1,15 +1,5 @@ module HROOT.Core.TAtt3D - ( - TAtt3D(..) - , ITAtt3D - , upcastTAtt3D - , downcastTAtt3D - - - ) where - + (TAtt3D(..), ITAtt3D, upcastTAtt3D, downcastTAtt3D) where import HROOT.Core.TAtt3D.RawType import HROOT.Core.TAtt3D.Interface import HROOT.Core.TAtt3D.Implementation - - diff --git a/src/HROOT/Core/TAtt3D/Cast.hs b/src/HROOT/Core/TAtt3D/Cast.hs --- a/src/HROOT/Core/TAtt3D/Cast.hs +++ b/src/HROOT/Core/TAtt3D/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TAtt3D.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TAtt3D.RawType import HROOT.Core.TAtt3D.Interface instance (ITAtt3D a, FPtr a) => Castable a (Ptr RawTAtt3D) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TAtt3D (Ptr RawTAtt3D) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TAtt3D/FFI.hsc b/src/HROOT/Core/TAtt3D/FFI.hsc --- a/src/HROOT/Core/TAtt3D/FFI.hsc +++ b/src/HROOT/Core/TAtt3D/FFI.hsc @@ -1,22 +1,8 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TAtt3D.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TAtt3D.RawType - -#include "HROOTCoreTAtt3D.h" - -foreign import ccall "HROOTCoreTAtt3D.h TAtt3D_delete" c_tatt3d_delete - :: (Ptr RawTAtt3D) -> IO () - +foreign import ccall safe "HROOTCoreTAtt3D.h TAtt3D_delete" + c_tatt3d_delete :: Ptr RawTAtt3D -> IO () diff --git a/src/HROOT/Core/TAtt3D/Implementation.hs b/src/HROOT/Core/TAtt3D/Implementation.hs --- a/src/HROOT/Core/TAtt3D/Implementation.hs +++ b/src/HROOT/Core/TAtt3D/Implementation.hs @@ -1,45 +1,22 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TAtt3D.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TAtt3D.RawType import HROOT.Core.TAtt3D.FFI import HROOT.Core.TAtt3D.Interface import HROOT.Core.TAtt3D.Cast - import HROOT.Core.Deletable.RawType import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - +instance ITAtt3D TAtt3D -instance ITAtt3D TAtt3D where instance IDeletable TAtt3D where - delete = xform0 c_tatt3d_delete - -instance ITAtt3D (Exist TAtt3D) where - -instance IDeletable (Exist TAtt3D) where - delete (ETAtt3D x) = delete x - - - - - - - -instance FPtr (Exist TAtt3D) where - type Raw (Exist TAtt3D) = RawTAtt3D - get_fptr (ETAtt3D obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETAtt3D (cast_fptr_to_obj (fptr :: ForeignPtr RawTAtt3D) :: TAtt3D) + delete = xform0 c_tatt3d_delete diff --git a/src/HROOT/Core/TAtt3D/Interface.hs b/src/HROOT/Core/TAtt3D/Interface.hs --- a/src/HROOT/Core/TAtt3D/Interface.hs +++ b/src/HROOT/Core/TAtt3D/Interface.hs @@ -1,36 +1,25 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TAtt3D.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TAtt3D.RawType - import HROOT.Core.Deletable.Interface ----- ============ ---- - - -class (IDeletable a) => ITAtt3D a where - -instance Existable TAtt3D where - data Exist TAtt3D = forall a. (FPtr a, ITAtt3D a) => ETAtt3D a +class IDeletable a => ITAtt3D a -upcastTAtt3D :: (FPtr a, ITAtt3D a) => a -> TAtt3D -upcastTAtt3D h = let fh = get_fptr h - fh2 :: ForeignPtr RawTAtt3D = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTAtt3D :: forall a . (FPtr a, ITAtt3D a) => a -> TAtt3D +upcastTAtt3D h + = let fh = get_fptr h + fh2 :: Ptr RawTAtt3D = castPtr fh + in cast_fptr_to_obj fh2 -downcastTAtt3D :: (FPtr a, ITAtt3D a) => TAtt3D -> a -downcastTAtt3D h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTAtt3D :: forall a . (FPtr a, ITAtt3D a) => TAtt3D -> a +downcastTAtt3D h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TAtt3D/RawType.hs b/src/HROOT/Core/TAtt3D/RawType.hs --- a/src/HROOT/Core/TAtt3D/RawType.hs +++ b/src/HROOT/Core/TAtt3D/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TAtt3D.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTAtt3D -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TAtt3D = TAtt3D (Ptr RawTAtt3D) + deriving (Eq, Ord, Show) -data RawTAtt3D -newtype TAtt3D = TAtt3D (ForeignPtr RawTAtt3D) deriving (Eq, Ord, Show) instance FPtr TAtt3D where - type Raw TAtt3D = RawTAtt3D - get_fptr (TAtt3D fptr) = fptr - cast_fptr_to_obj = TAtt3D + type Raw TAtt3D = RawTAtt3D + get_fptr (TAtt3D ptr) = ptr + cast_fptr_to_obj = TAtt3D diff --git a/src/HROOT/Core/TAttAxis.hs b/src/HROOT/Core/TAttAxis.hs --- a/src/HROOT/Core/TAttAxis.hs +++ b/src/HROOT/Core/TAttAxis.hs @@ -1,15 +1,7 @@ module HROOT.Core.TAttAxis - ( - TAttAxis(..) - , ITAttAxis(..) - , upcastTAttAxis - , downcastTAttAxis - , newTAttAxis - - ) where - + (TAttAxis(..), ITAttAxis(..), upcastTAttAxis, downcastTAttAxis, + newTAttAxis) + where import HROOT.Core.TAttAxis.RawType import HROOT.Core.TAttAxis.Interface import HROOT.Core.TAttAxis.Implementation - - diff --git a/src/HROOT/Core/TAttAxis/Cast.hs b/src/HROOT/Core/TAttAxis/Cast.hs --- a/src/HROOT/Core/TAttAxis/Cast.hs +++ b/src/HROOT/Core/TAttAxis/Cast.hs @@ -1,22 +1,18 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TAttAxis.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TAttAxis.RawType import HROOT.Core.TAttAxis.Interface -instance (ITAttAxis a, FPtr a) => Castable a (Ptr RawTAttAxis) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ +instance (ITAttAxis a, FPtr a) => Castable a (Ptr RawTAttAxis) + where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TAttAxis (Ptr RawTAttAxis) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TAttAxis/FFI.hsc b/src/HROOT/Core/TAttAxis/FFI.hsc --- a/src/HROOT/Core/TAttAxis/FFI.hsc +++ b/src/HROOT/Core/TAttAxis/FFI.hsc @@ -1,88 +1,97 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TAttAxis.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TAttAxis.RawType - -#include "HROOTCoreTAttAxis.h" - -foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_delete" c_tattaxis_delete - :: (Ptr RawTAttAxis) -> IO () - -foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_newTAttAxis" c_tattaxis_newtattaxis - :: IO (Ptr RawTAttAxis) +foreign import ccall safe "HROOTCoreTAttAxis.h TAttAxis_delete" + c_tattaxis_delete :: Ptr RawTAttAxis -> IO () -foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_GetNdivisions" c_tattaxis_getndivisions - :: (Ptr RawTAttAxis) -> IO CInt +foreign import ccall safe + "HROOTCoreTAttAxis.h TAttAxis_newTAttAxis" c_tattaxis_newtattaxis + :: IO (Ptr RawTAttAxis) -foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_GetAxisColor" c_tattaxis_getaxiscolor - :: (Ptr RawTAttAxis) -> IO CInt +foreign import ccall safe + "HROOTCoreTAttAxis.h TAttAxis_GetNdivisions" + c_tattaxis_getndivisions :: Ptr RawTAttAxis -> IO CInt -foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_GetLabelColor" c_tattaxis_getlabelcolor - :: (Ptr RawTAttAxis) -> IO CInt +foreign import ccall safe + "HROOTCoreTAttAxis.h TAttAxis_GetAxisColor" c_tattaxis_getaxiscolor + :: Ptr RawTAttAxis -> IO CInt -foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_GetLabelFont" c_tattaxis_getlabelfont - :: (Ptr RawTAttAxis) -> IO CInt +foreign import ccall safe + "HROOTCoreTAttAxis.h TAttAxis_GetLabelColor" + c_tattaxis_getlabelcolor :: Ptr RawTAttAxis -> IO CInt -foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_GetLabelOffset" c_tattaxis_getlabeloffset - :: (Ptr RawTAttAxis) -> IO CDouble +foreign import ccall safe + "HROOTCoreTAttAxis.h TAttAxis_GetLabelFont" c_tattaxis_getlabelfont + :: Ptr RawTAttAxis -> IO CInt -foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_GetLabelSize" c_tattaxis_getlabelsize - :: (Ptr RawTAttAxis) -> IO CDouble +foreign import ccall safe + "HROOTCoreTAttAxis.h TAttAxis_GetLabelOffset" + c_tattaxis_getlabeloffset :: Ptr RawTAttAxis -> IO CDouble -foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_GetTitleOffset" c_tattaxis_gettitleoffset - :: (Ptr RawTAttAxis) -> IO CDouble +foreign import ccall safe + "HROOTCoreTAttAxis.h TAttAxis_GetLabelSize" c_tattaxis_getlabelsize + :: Ptr RawTAttAxis -> IO CDouble -foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_GetTitleSize" c_tattaxis_gettitlesize - :: (Ptr RawTAttAxis) -> IO CDouble +foreign import ccall safe + "HROOTCoreTAttAxis.h TAttAxis_GetTitleOffset" + c_tattaxis_gettitleoffset :: Ptr RawTAttAxis -> IO CDouble -foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_GetTickLength" c_tattaxis_getticklength - :: (Ptr RawTAttAxis) -> IO CDouble +foreign import ccall safe + "HROOTCoreTAttAxis.h TAttAxis_GetTitleSize" c_tattaxis_gettitlesize + :: Ptr RawTAttAxis -> IO CDouble -foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_GetTitleFont" c_tattaxis_gettitlefont - :: (Ptr RawTAttAxis) -> IO CInt +foreign import ccall safe + "HROOTCoreTAttAxis.h TAttAxis_GetTickLength" + c_tattaxis_getticklength :: Ptr RawTAttAxis -> IO CDouble -foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_SetNdivisions" c_tattaxis_setndivisions - :: (Ptr RawTAttAxis) -> CInt -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttAxis.h TAttAxis_GetTitleFont" c_tattaxis_gettitlefont + :: Ptr RawTAttAxis -> IO CInt -foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_SetAxisColor" c_tattaxis_setaxiscolor - :: (Ptr RawTAttAxis) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttAxis.h TAttAxis_SetNdivisions" + c_tattaxis_setndivisions :: + Ptr RawTAttAxis -> CInt -> CInt -> IO () -foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_SetLabelColor" c_tattaxis_setlabelcolor - :: (Ptr RawTAttAxis) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttAxis.h TAttAxis_SetAxisColor" c_tattaxis_setaxiscolor + :: Ptr RawTAttAxis -> CInt -> IO () -foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_SetLabelFont" c_tattaxis_setlabelfont - :: (Ptr RawTAttAxis) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttAxis.h TAttAxis_SetLabelColor" + c_tattaxis_setlabelcolor :: Ptr RawTAttAxis -> CInt -> IO () -foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_SetLabelOffset" c_tattaxis_setlabeloffset - :: (Ptr RawTAttAxis) -> CDouble -> IO () +foreign import ccall safe + "HROOTCoreTAttAxis.h TAttAxis_SetLabelFont" c_tattaxis_setlabelfont + :: Ptr RawTAttAxis -> CInt -> IO () -foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_SetLabelSize" c_tattaxis_setlabelsize - :: (Ptr RawTAttAxis) -> CDouble -> IO () +foreign import ccall safe + "HROOTCoreTAttAxis.h TAttAxis_SetLabelOffset" + c_tattaxis_setlabeloffset :: Ptr RawTAttAxis -> CDouble -> IO () -foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_SetTickLength" c_tattaxis_setticklength - :: (Ptr RawTAttAxis) -> CDouble -> IO () +foreign import ccall safe + "HROOTCoreTAttAxis.h TAttAxis_SetLabelSize" c_tattaxis_setlabelsize + :: Ptr RawTAttAxis -> CDouble -> IO () -foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_SetTitleOffset" c_tattaxis_settitleoffset - :: (Ptr RawTAttAxis) -> CDouble -> IO () +foreign import ccall safe + "HROOTCoreTAttAxis.h TAttAxis_SetTickLength" + c_tattaxis_setticklength :: Ptr RawTAttAxis -> CDouble -> IO () -foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_SetTitleSize" c_tattaxis_settitlesize - :: (Ptr RawTAttAxis) -> CDouble -> IO () +foreign import ccall safe + "HROOTCoreTAttAxis.h TAttAxis_SetTitleOffset" + c_tattaxis_settitleoffset :: Ptr RawTAttAxis -> CDouble -> IO () -foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_SetTitleColor" c_tattaxis_settitlecolor - :: (Ptr RawTAttAxis) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttAxis.h TAttAxis_SetTitleSize" c_tattaxis_settitlesize + :: Ptr RawTAttAxis -> CDouble -> IO () -foreign import ccall "HROOTCoreTAttAxis.h TAttAxis_SetTitleFont" c_tattaxis_settitlefont - :: (Ptr RawTAttAxis) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttAxis.h TAttAxis_SetTitleColor" + c_tattaxis_settitlecolor :: Ptr RawTAttAxis -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttAxis.h TAttAxis_SetTitleFont" c_tattaxis_settitlefont + :: Ptr RawTAttAxis -> CInt -> IO () diff --git a/src/HROOT/Core/TAttAxis/Implementation.hs b/src/HROOT/Core/TAttAxis/Implementation.hs --- a/src/HROOT/Core/TAttAxis/Implementation.hs +++ b/src/HROOT/Core/TAttAxis/Implementation.hs @@ -1,88 +1,46 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TAttAxis.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TAttAxis.RawType import HROOT.Core.TAttAxis.FFI import HROOT.Core.TAttAxis.Interface import HROOT.Core.TAttAxis.Cast - import HROOT.Core.Deletable.RawType import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - - instance ITAttAxis TAttAxis where - getNdivisions = xform0 c_tattaxis_getndivisions - getAxisColor = xform0 c_tattaxis_getaxiscolor - getLabelColor = xform0 c_tattaxis_getlabelcolor - getLabelFont = xform0 c_tattaxis_getlabelfont - getLabelOffset = xform0 c_tattaxis_getlabeloffset - getLabelSize = xform0 c_tattaxis_getlabelsize - getTitleOffset = xform0 c_tattaxis_gettitleoffset - getTitleSize = xform0 c_tattaxis_gettitlesize - getTickLength = xform0 c_tattaxis_getticklength - getTitleFont = xform0 c_tattaxis_gettitlefont - setNdivisions = xform2 c_tattaxis_setndivisions - setAxisColor = xform1 c_tattaxis_setaxiscolor - setLabelColor = xform1 c_tattaxis_setlabelcolor - setLabelFont = xform1 c_tattaxis_setlabelfont - setLabelOffset = xform1 c_tattaxis_setlabeloffset - setLabelSize = xform1 c_tattaxis_setlabelsize - setTickLength = xform1 c_tattaxis_setticklength - setTitleOffset = xform1 c_tattaxis_settitleoffset - setTitleSize = xform1 c_tattaxis_settitlesize - setTitleColor = xform1 c_tattaxis_settitlecolor - setTitleFont = xform1 c_tattaxis_settitlefont -instance IDeletable TAttAxis where - delete = xform0 c_tattaxis_delete - -instance ITAttAxis (Exist TAttAxis) where - getNdivisions (ETAttAxis x) = getNdivisions x - getAxisColor (ETAttAxis x) = getAxisColor x - getLabelColor (ETAttAxis x) = getLabelColor x - getLabelFont (ETAttAxis x) = getLabelFont x - getLabelOffset (ETAttAxis x) = getLabelOffset x - getLabelSize (ETAttAxis x) = getLabelSize x - getTitleOffset (ETAttAxis x) = getTitleOffset x - getTitleSize (ETAttAxis x) = getTitleSize x - getTickLength (ETAttAxis x) = getTickLength x - getTitleFont (ETAttAxis x) = getTitleFont x - setNdivisions (ETAttAxis x) = setNdivisions x - setAxisColor (ETAttAxis x) = setAxisColor x - setLabelColor (ETAttAxis x) = setLabelColor x - setLabelFont (ETAttAxis x) = setLabelFont x - setLabelOffset (ETAttAxis x) = setLabelOffset x - setLabelSize (ETAttAxis x) = setLabelSize x - setTickLength (ETAttAxis x) = setTickLength x - setTitleOffset (ETAttAxis x) = setTitleOffset x - setTitleSize (ETAttAxis x) = setTitleSize x - setTitleColor (ETAttAxis x) = setTitleColor x - setTitleFont (ETAttAxis x) = setTitleFont x -instance IDeletable (Exist TAttAxis) where - delete (ETAttAxis x) = delete x + getNdivisions = xform0 c_tattaxis_getndivisions + getAxisColor = xform0 c_tattaxis_getaxiscolor + getLabelColor = xform0 c_tattaxis_getlabelcolor + getLabelFont = xform0 c_tattaxis_getlabelfont + getLabelOffset = xform0 c_tattaxis_getlabeloffset + getLabelSize = xform0 c_tattaxis_getlabelsize + getTitleOffset = xform0 c_tattaxis_gettitleoffset + getTitleSize = xform0 c_tattaxis_gettitlesize + getTickLength = xform0 c_tattaxis_getticklength + getTitleFont = xform0 c_tattaxis_gettitlefont + setNdivisions = xform2 c_tattaxis_setndivisions + setAxisColor = xform1 c_tattaxis_setaxiscolor + setLabelColor = xform1 c_tattaxis_setlabelcolor + setLabelFont = xform1 c_tattaxis_setlabelfont + setLabelOffset = xform1 c_tattaxis_setlabeloffset + setLabelSize = xform1 c_tattaxis_setlabelsize + setTickLength = xform1 c_tattaxis_setticklength + setTitleOffset = xform1 c_tattaxis_settitleoffset + setTitleSize = xform1 c_tattaxis_settitlesize + setTitleColor = xform1 c_tattaxis_settitlecolor + setTitleFont = xform1 c_tattaxis_settitlefont +instance IDeletable TAttAxis where + delete = xform0 c_tattaxis_delete newTAttAxis :: IO TAttAxis newTAttAxis = xformnull c_tattaxis_newtattaxis - - - - - -instance FPtr (Exist TAttAxis) where - type Raw (Exist TAttAxis) = RawTAttAxis - get_fptr (ETAttAxis obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETAttAxis (cast_fptr_to_obj (fptr :: ForeignPtr RawTAttAxis) :: TAttAxis) diff --git a/src/HROOT/Core/TAttAxis/Interface.hs b/src/HROOT/Core/TAttAxis/Interface.hs --- a/src/HROOT/Core/TAttAxis/Interface.hs +++ b/src/HROOT/Core/TAttAxis/Interface.hs @@ -1,78 +1,67 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TAttAxis.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TAttAxis.RawType - import HROOT.Core.Deletable.Interface ----- ============ ---- - - -class (IDeletable a) => ITAttAxis a where - - getNdivisions :: a -> IO CInt - - getAxisColor :: a -> IO CInt - - getLabelColor :: a -> IO CInt - - getLabelFont :: a -> IO CInt - - getLabelOffset :: a -> IO CDouble - - getLabelSize :: a -> IO CDouble - - getTitleOffset :: a -> IO CDouble - - getTitleSize :: a -> IO CDouble - - getTickLength :: a -> IO CDouble - - getTitleFont :: a -> IO CInt - - setNdivisions :: a -> CInt -> CInt -> IO () - - setAxisColor :: a -> CInt -> IO () - - setLabelColor :: a -> CInt -> IO () - - setLabelFont :: a -> CInt -> IO () - - setLabelOffset :: a -> CDouble -> IO () - - setLabelSize :: a -> CDouble -> IO () - - setTickLength :: a -> CDouble -> IO () - - setTitleOffset :: a -> CDouble -> IO () - - setTitleSize :: a -> CDouble -> IO () - - setTitleColor :: a -> CInt -> IO () - - setTitleFont :: a -> CInt -> IO () - -instance Existable TAttAxis where - data Exist TAttAxis = forall a. (FPtr a, ITAttAxis a) => ETAttAxis a +class IDeletable a => ITAttAxis a where + getNdivisions :: a -> IO CInt + + getAxisColor :: a -> IO CInt + + getLabelColor :: a -> IO CInt + + getLabelFont :: a -> IO CInt + + getLabelOffset :: a -> IO CDouble + + getLabelSize :: a -> IO CDouble + + getTitleOffset :: a -> IO CDouble + + getTitleSize :: a -> IO CDouble + + getTickLength :: a -> IO CDouble + + getTitleFont :: a -> IO CInt + + setNdivisions :: a -> CInt -> CInt -> IO () + + setAxisColor :: a -> CInt -> IO () + + setLabelColor :: a -> CInt -> IO () + + setLabelFont :: a -> CInt -> IO () + + setLabelOffset :: a -> CDouble -> IO () + + setLabelSize :: a -> CDouble -> IO () + + setTickLength :: a -> CDouble -> IO () + + setTitleOffset :: a -> CDouble -> IO () + + setTitleSize :: a -> CDouble -> IO () + + setTitleColor :: a -> CInt -> IO () + + setTitleFont :: a -> CInt -> IO () -upcastTAttAxis :: (FPtr a, ITAttAxis a) => a -> TAttAxis -upcastTAttAxis h = let fh = get_fptr h - fh2 :: ForeignPtr RawTAttAxis = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTAttAxis :: forall a . (FPtr a, ITAttAxis a) => a -> TAttAxis +upcastTAttAxis h + = let fh = get_fptr h + fh2 :: Ptr RawTAttAxis = castPtr fh + in cast_fptr_to_obj fh2 -downcastTAttAxis :: (FPtr a, ITAttAxis a) => TAttAxis -> a -downcastTAttAxis h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTAttAxis :: + forall a . (FPtr a, ITAttAxis a) => TAttAxis -> a +downcastTAttAxis h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TAttAxis/RawType.hs b/src/HROOT/Core/TAttAxis/RawType.hs --- a/src/HROOT/Core/TAttAxis/RawType.hs +++ b/src/HROOT/Core/TAttAxis/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TAttAxis.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTAttAxis -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TAttAxis = TAttAxis (Ptr RawTAttAxis) + deriving (Eq, Ord, Show) -data RawTAttAxis -newtype TAttAxis = TAttAxis (ForeignPtr RawTAttAxis) deriving (Eq, Ord, Show) instance FPtr TAttAxis where - type Raw TAttAxis = RawTAttAxis - get_fptr (TAttAxis fptr) = fptr - cast_fptr_to_obj = TAttAxis + type Raw TAttAxis = RawTAttAxis + get_fptr (TAttAxis ptr) = ptr + cast_fptr_to_obj = TAttAxis diff --git a/src/HROOT/Core/TAttBBox.hs b/src/HROOT/Core/TAttBBox.hs --- a/src/HROOT/Core/TAttBBox.hs +++ b/src/HROOT/Core/TAttBBox.hs @@ -1,15 +1,5 @@ module HROOT.Core.TAttBBox - ( - TAttBBox(..) - , ITAttBBox - , upcastTAttBBox - , downcastTAttBBox - - - ) where - + (TAttBBox(..), ITAttBBox, upcastTAttBBox, downcastTAttBBox) where import HROOT.Core.TAttBBox.RawType import HROOT.Core.TAttBBox.Interface import HROOT.Core.TAttBBox.Implementation - - diff --git a/src/HROOT/Core/TAttBBox/Cast.hs b/src/HROOT/Core/TAttBBox/Cast.hs --- a/src/HROOT/Core/TAttBBox/Cast.hs +++ b/src/HROOT/Core/TAttBBox/Cast.hs @@ -1,22 +1,18 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TAttBBox.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TAttBBox.RawType import HROOT.Core.TAttBBox.Interface -instance (ITAttBBox a, FPtr a) => Castable a (Ptr RawTAttBBox) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ +instance (ITAttBBox a, FPtr a) => Castable a (Ptr RawTAttBBox) + where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TAttBBox (Ptr RawTAttBBox) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TAttBBox/FFI.hsc b/src/HROOT/Core/TAttBBox/FFI.hsc --- a/src/HROOT/Core/TAttBBox/FFI.hsc +++ b/src/HROOT/Core/TAttBBox/FFI.hsc @@ -1,22 +1,8 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TAttBBox.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TAttBBox.RawType - -#include "HROOTCoreTAttBBox.h" - -foreign import ccall "HROOTCoreTAttBBox.h TAttBBox_delete" c_tattbbox_delete - :: (Ptr RawTAttBBox) -> IO () - +foreign import ccall safe "HROOTCoreTAttBBox.h TAttBBox_delete" + c_tattbbox_delete :: Ptr RawTAttBBox -> IO () diff --git a/src/HROOT/Core/TAttBBox/Implementation.hs b/src/HROOT/Core/TAttBBox/Implementation.hs --- a/src/HROOT/Core/TAttBBox/Implementation.hs +++ b/src/HROOT/Core/TAttBBox/Implementation.hs @@ -1,45 +1,22 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TAttBBox.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TAttBBox.RawType import HROOT.Core.TAttBBox.FFI import HROOT.Core.TAttBBox.Interface import HROOT.Core.TAttBBox.Cast - import HROOT.Core.Deletable.RawType import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - +instance ITAttBBox TAttBBox -instance ITAttBBox TAttBBox where instance IDeletable TAttBBox where - delete = xform0 c_tattbbox_delete - -instance ITAttBBox (Exist TAttBBox) where - -instance IDeletable (Exist TAttBBox) where - delete (ETAttBBox x) = delete x - - - - - - - -instance FPtr (Exist TAttBBox) where - type Raw (Exist TAttBBox) = RawTAttBBox - get_fptr (ETAttBBox obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETAttBBox (cast_fptr_to_obj (fptr :: ForeignPtr RawTAttBBox) :: TAttBBox) + delete = xform0 c_tattbbox_delete diff --git a/src/HROOT/Core/TAttBBox/Interface.hs b/src/HROOT/Core/TAttBBox/Interface.hs --- a/src/HROOT/Core/TAttBBox/Interface.hs +++ b/src/HROOT/Core/TAttBBox/Interface.hs @@ -1,36 +1,26 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TAttBBox.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TAttBBox.RawType - import HROOT.Core.Deletable.Interface ----- ============ ---- - - -class (IDeletable a) => ITAttBBox a where - -instance Existable TAttBBox where - data Exist TAttBBox = forall a. (FPtr a, ITAttBBox a) => ETAttBBox a +class IDeletable a => ITAttBBox a -upcastTAttBBox :: (FPtr a, ITAttBBox a) => a -> TAttBBox -upcastTAttBBox h = let fh = get_fptr h - fh2 :: ForeignPtr RawTAttBBox = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTAttBBox :: forall a . (FPtr a, ITAttBBox a) => a -> TAttBBox +upcastTAttBBox h + = let fh = get_fptr h + fh2 :: Ptr RawTAttBBox = castPtr fh + in cast_fptr_to_obj fh2 -downcastTAttBBox :: (FPtr a, ITAttBBox a) => TAttBBox -> a -downcastTAttBBox h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTAttBBox :: + forall a . (FPtr a, ITAttBBox a) => TAttBBox -> a +downcastTAttBBox h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TAttBBox/RawType.hs b/src/HROOT/Core/TAttBBox/RawType.hs --- a/src/HROOT/Core/TAttBBox/RawType.hs +++ b/src/HROOT/Core/TAttBBox/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TAttBBox.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTAttBBox -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TAttBBox = TAttBBox (Ptr RawTAttBBox) + deriving (Eq, Ord, Show) -data RawTAttBBox -newtype TAttBBox = TAttBBox (ForeignPtr RawTAttBBox) deriving (Eq, Ord, Show) instance FPtr TAttBBox where - type Raw TAttBBox = RawTAttBBox - get_fptr (TAttBBox fptr) = fptr - cast_fptr_to_obj = TAttBBox + type Raw TAttBBox = RawTAttBBox + get_fptr (TAttBBox ptr) = ptr + cast_fptr_to_obj = TAttBBox diff --git a/src/HROOT/Core/TAttCanvas.hs b/src/HROOT/Core/TAttCanvas.hs --- a/src/HROOT/Core/TAttCanvas.hs +++ b/src/HROOT/Core/TAttCanvas.hs @@ -1,15 +1,7 @@ module HROOT.Core.TAttCanvas - ( - TAttCanvas(..) - , ITAttCanvas - , upcastTAttCanvas - , downcastTAttCanvas - , newTAttCanvas - - ) where - + (TAttCanvas(..), ITAttCanvas, upcastTAttCanvas, downcastTAttCanvas, + newTAttCanvas) + where import HROOT.Core.TAttCanvas.RawType import HROOT.Core.TAttCanvas.Interface import HROOT.Core.TAttCanvas.Implementation - - diff --git a/src/HROOT/Core/TAttCanvas/Cast.hs b/src/HROOT/Core/TAttCanvas/Cast.hs --- a/src/HROOT/Core/TAttCanvas/Cast.hs +++ b/src/HROOT/Core/TAttCanvas/Cast.hs @@ -1,22 +1,18 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TAttCanvas.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TAttCanvas.RawType import HROOT.Core.TAttCanvas.Interface -instance (ITAttCanvas a, FPtr a) => Castable a (Ptr RawTAttCanvas) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ +instance (ITAttCanvas a, FPtr a) => Castable a (Ptr RawTAttCanvas) + where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TAttCanvas (Ptr RawTAttCanvas) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TAttCanvas/FFI.hsc b/src/HROOT/Core/TAttCanvas/FFI.hsc --- a/src/HROOT/Core/TAttCanvas/FFI.hsc +++ b/src/HROOT/Core/TAttCanvas/FFI.hsc @@ -1,25 +1,12 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TAttCanvas.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TAttCanvas.RawType - -#include "HROOTCoreTAttCanvas.h" - -foreign import ccall "HROOTCoreTAttCanvas.h TAttCanvas_delete" c_tattcanvas_delete - :: (Ptr RawTAttCanvas) -> IO () - -foreign import ccall "HROOTCoreTAttCanvas.h TAttCanvas_newTAttCanvas" c_tattcanvas_newtattcanvas - :: IO (Ptr RawTAttCanvas) +foreign import ccall safe "HROOTCoreTAttCanvas.h TAttCanvas_delete" + c_tattcanvas_delete :: Ptr RawTAttCanvas -> IO () +foreign import ccall safe + "HROOTCoreTAttCanvas.h TAttCanvas_newTAttCanvas" + c_tattcanvas_newtattcanvas :: IO (Ptr RawTAttCanvas) diff --git a/src/HROOT/Core/TAttCanvas/Implementation.hs b/src/HROOT/Core/TAttCanvas/Implementation.hs --- a/src/HROOT/Core/TAttCanvas/Implementation.hs +++ b/src/HROOT/Core/TAttCanvas/Implementation.hs @@ -1,47 +1,25 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TAttCanvas.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TAttCanvas.RawType import HROOT.Core.TAttCanvas.FFI import HROOT.Core.TAttCanvas.Interface import HROOT.Core.TAttCanvas.Cast - import HROOT.Core.Deletable.RawType import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - +instance ITAttCanvas TAttCanvas -instance ITAttCanvas TAttCanvas where instance IDeletable TAttCanvas where - delete = xform0 c_tattcanvas_delete - -instance ITAttCanvas (Exist TAttCanvas) where - -instance IDeletable (Exist TAttCanvas) where - delete (ETAttCanvas x) = delete x - + delete = xform0 c_tattcanvas_delete newTAttCanvas :: IO TAttCanvas newTAttCanvas = xformnull c_tattcanvas_newtattcanvas - - - - - -instance FPtr (Exist TAttCanvas) where - type Raw (Exist TAttCanvas) = RawTAttCanvas - get_fptr (ETAttCanvas obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETAttCanvas (cast_fptr_to_obj (fptr :: ForeignPtr RawTAttCanvas) :: TAttCanvas) diff --git a/src/HROOT/Core/TAttCanvas/Interface.hs b/src/HROOT/Core/TAttCanvas/Interface.hs --- a/src/HROOT/Core/TAttCanvas/Interface.hs +++ b/src/HROOT/Core/TAttCanvas/Interface.hs @@ -1,36 +1,27 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TAttCanvas.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TAttCanvas.RawType - import HROOT.Core.Deletable.Interface ----- ============ ---- - - -class (IDeletable a) => ITAttCanvas a where - -instance Existable TAttCanvas where - data Exist TAttCanvas = forall a. (FPtr a, ITAttCanvas a) => ETAttCanvas a +class IDeletable a => ITAttCanvas a -upcastTAttCanvas :: (FPtr a, ITAttCanvas a) => a -> TAttCanvas -upcastTAttCanvas h = let fh = get_fptr h - fh2 :: ForeignPtr RawTAttCanvas = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTAttCanvas :: + forall a . (FPtr a, ITAttCanvas a) => a -> TAttCanvas +upcastTAttCanvas h + = let fh = get_fptr h + fh2 :: Ptr RawTAttCanvas = castPtr fh + in cast_fptr_to_obj fh2 -downcastTAttCanvas :: (FPtr a, ITAttCanvas a) => TAttCanvas -> a -downcastTAttCanvas h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTAttCanvas :: + forall a . (FPtr a, ITAttCanvas a) => TAttCanvas -> a +downcastTAttCanvas h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TAttCanvas/RawType.hs b/src/HROOT/Core/TAttCanvas/RawType.hs --- a/src/HROOT/Core/TAttCanvas/RawType.hs +++ b/src/HROOT/Core/TAttCanvas/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TAttCanvas.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTAttCanvas -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TAttCanvas = TAttCanvas (Ptr RawTAttCanvas) + deriving (Eq, Ord, Show) -data RawTAttCanvas -newtype TAttCanvas = TAttCanvas (ForeignPtr RawTAttCanvas) deriving (Eq, Ord, Show) instance FPtr TAttCanvas where - type Raw TAttCanvas = RawTAttCanvas - get_fptr (TAttCanvas fptr) = fptr - cast_fptr_to_obj = TAttCanvas + type Raw TAttCanvas = RawTAttCanvas + get_fptr (TAttCanvas ptr) = ptr + cast_fptr_to_obj = TAttCanvas diff --git a/src/HROOT/Core/TAttFill.hs b/src/HROOT/Core/TAttFill.hs --- a/src/HROOT/Core/TAttFill.hs +++ b/src/HROOT/Core/TAttFill.hs @@ -1,15 +1,7 @@ module HROOT.Core.TAttFill - ( - TAttFill(..) - , ITAttFill(..) - , upcastTAttFill - , downcastTAttFill - , newTAttFill - - ) where - + (TAttFill(..), ITAttFill(..), upcastTAttFill, downcastTAttFill, + newTAttFill) + where import HROOT.Core.TAttFill.RawType import HROOT.Core.TAttFill.Interface import HROOT.Core.TAttFill.Implementation - - diff --git a/src/HROOT/Core/TAttFill/Cast.hs b/src/HROOT/Core/TAttFill/Cast.hs --- a/src/HROOT/Core/TAttFill/Cast.hs +++ b/src/HROOT/Core/TAttFill/Cast.hs @@ -1,22 +1,18 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TAttFill.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TAttFill.RawType import HROOT.Core.TAttFill.Interface -instance (ITAttFill a, FPtr a) => Castable a (Ptr RawTAttFill) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ +instance (ITAttFill a, FPtr a) => Castable a (Ptr RawTAttFill) + where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TAttFill (Ptr RawTAttFill) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TAttFill/FFI.hsc b/src/HROOT/Core/TAttFill/FFI.hsc --- a/src/HROOT/Core/TAttFill/FFI.hsc +++ b/src/HROOT/Core/TAttFill/FFI.hsc @@ -1,31 +1,20 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TAttFill.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TAttFill.RawType - -#include "HROOTCoreTAttFill.h" - -foreign import ccall "HROOTCoreTAttFill.h TAttFill_delete" c_tattfill_delete - :: (Ptr RawTAttFill) -> IO () - -foreign import ccall "HROOTCoreTAttFill.h TAttFill_newTAttFill" c_tattfill_newtattfill - :: CInt -> CInt -> IO (Ptr RawTAttFill) +foreign import ccall safe "HROOTCoreTAttFill.h TAttFill_delete" + c_tattfill_delete :: Ptr RawTAttFill -> IO () -foreign import ccall "HROOTCoreTAttFill.h TAttFill_SetFillColor" c_tattfill_setfillcolor - :: (Ptr RawTAttFill) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttFill.h TAttFill_newTAttFill" c_tattfill_newtattfill + :: CInt -> CInt -> IO (Ptr RawTAttFill) -foreign import ccall "HROOTCoreTAttFill.h TAttFill_SetFillStyle" c_tattfill_setfillstyle - :: (Ptr RawTAttFill) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttFill.h TAttFill_SetFillColor" c_tattfill_setfillcolor + :: Ptr RawTAttFill -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttFill.h TAttFill_SetFillStyle" c_tattfill_setfillstyle + :: Ptr RawTAttFill -> CInt -> IO () diff --git a/src/HROOT/Core/TAttFill/Implementation.hs b/src/HROOT/Core/TAttFill/Implementation.hs --- a/src/HROOT/Core/TAttFill/Implementation.hs +++ b/src/HROOT/Core/TAttFill/Implementation.hs @@ -1,50 +1,27 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TAttFill.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TAttFill.RawType import HROOT.Core.TAttFill.FFI import HROOT.Core.TAttFill.Interface import HROOT.Core.TAttFill.Cast - import HROOT.Core.Deletable.RawType import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - - instance ITAttFill TAttFill where - setFillColor = xform1 c_tattfill_setfillcolor - setFillStyle = xform1 c_tattfill_setfillstyle -instance IDeletable TAttFill where - delete = xform0 c_tattfill_delete - -instance ITAttFill (Exist TAttFill) where - setFillColor (ETAttFill x) = setFillColor x - setFillStyle (ETAttFill x) = setFillStyle x -instance IDeletable (Exist TAttFill) where - delete (ETAttFill x) = delete x + setFillColor = xform1 c_tattfill_setfillcolor + setFillStyle = xform1 c_tattfill_setfillstyle +instance IDeletable TAttFill where + delete = xform0 c_tattfill_delete newTAttFill :: CInt -> CInt -> IO TAttFill newTAttFill = xform1 c_tattfill_newtattfill - - - - - -instance FPtr (Exist TAttFill) where - type Raw (Exist TAttFill) = RawTAttFill - get_fptr (ETAttFill obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETAttFill (cast_fptr_to_obj (fptr :: ForeignPtr RawTAttFill) :: TAttFill) diff --git a/src/HROOT/Core/TAttFill/Interface.hs b/src/HROOT/Core/TAttFill/Interface.hs --- a/src/HROOT/Core/TAttFill/Interface.hs +++ b/src/HROOT/Core/TAttFill/Interface.hs @@ -1,40 +1,29 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TAttFill.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TAttFill.RawType - import HROOT.Core.Deletable.Interface ----- ============ ---- - - -class (IDeletable a) => ITAttFill a where - - setFillColor :: a -> CInt -> IO () - - setFillStyle :: a -> CInt -> IO () - -instance Existable TAttFill where - data Exist TAttFill = forall a. (FPtr a, ITAttFill a) => ETAttFill a +class IDeletable a => ITAttFill a where + setFillColor :: a -> CInt -> IO () + + setFillStyle :: a -> CInt -> IO () -upcastTAttFill :: (FPtr a, ITAttFill a) => a -> TAttFill -upcastTAttFill h = let fh = get_fptr h - fh2 :: ForeignPtr RawTAttFill = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTAttFill :: forall a . (FPtr a, ITAttFill a) => a -> TAttFill +upcastTAttFill h + = let fh = get_fptr h + fh2 :: Ptr RawTAttFill = castPtr fh + in cast_fptr_to_obj fh2 -downcastTAttFill :: (FPtr a, ITAttFill a) => TAttFill -> a -downcastTAttFill h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTAttFill :: + forall a . (FPtr a, ITAttFill a) => TAttFill -> a +downcastTAttFill h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TAttFill/RawType.hs b/src/HROOT/Core/TAttFill/RawType.hs --- a/src/HROOT/Core/TAttFill/RawType.hs +++ b/src/HROOT/Core/TAttFill/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TAttFill.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTAttFill -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TAttFill = TAttFill (Ptr RawTAttFill) + deriving (Eq, Ord, Show) -data RawTAttFill -newtype TAttFill = TAttFill (ForeignPtr RawTAttFill) deriving (Eq, Ord, Show) instance FPtr TAttFill where - type Raw TAttFill = RawTAttFill - get_fptr (TAttFill fptr) = fptr - cast_fptr_to_obj = TAttFill + type Raw TAttFill = RawTAttFill + get_fptr (TAttFill ptr) = ptr + cast_fptr_to_obj = TAttFill diff --git a/src/HROOT/Core/TAttLine.hs b/src/HROOT/Core/TAttLine.hs --- a/src/HROOT/Core/TAttLine.hs +++ b/src/HROOT/Core/TAttLine.hs @@ -1,16 +1,7 @@ module HROOT.Core.TAttLine - ( - TAttLine(..) - , ITAttLine(..) - , upcastTAttLine - , downcastTAttLine - , newTAttLine - , tAttLineDistancetoLine - - ) where - + (TAttLine(..), ITAttLine(..), upcastTAttLine, downcastTAttLine, + newTAttLine, tAttLineDistancetoLine) + where import HROOT.Core.TAttLine.RawType import HROOT.Core.TAttLine.Interface import HROOT.Core.TAttLine.Implementation - - diff --git a/src/HROOT/Core/TAttLine/Cast.hs b/src/HROOT/Core/TAttLine/Cast.hs --- a/src/HROOT/Core/TAttLine/Cast.hs +++ b/src/HROOT/Core/TAttLine/Cast.hs @@ -1,22 +1,18 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TAttLine.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TAttLine.RawType import HROOT.Core.TAttLine.Interface -instance (ITAttLine a, FPtr a) => Castable a (Ptr RawTAttLine) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ +instance (ITAttLine a, FPtr a) => Castable a (Ptr RawTAttLine) + where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TAttLine (Ptr RawTAttLine) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TAttLine/FFI.hsc b/src/HROOT/Core/TAttLine/FFI.hsc --- a/src/HROOT/Core/TAttLine/FFI.hsc +++ b/src/HROOT/Core/TAttLine/FFI.hsc @@ -1,52 +1,50 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TAttLine.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TAttLine.RawType - -#include "HROOTCoreTAttLine.h" - -foreign import ccall "HROOTCoreTAttLine.h TAttLine_delete" c_tattline_delete - :: (Ptr RawTAttLine) -> IO () - -foreign import ccall "HROOTCoreTAttLine.h TAttLine_newTAttLine" c_tattline_newtattline - :: CInt -> CInt -> CInt -> IO (Ptr RawTAttLine) +foreign import ccall safe "HROOTCoreTAttLine.h TAttLine_delete" + c_tattline_delete :: Ptr RawTAttLine -> IO () -foreign import ccall "HROOTCoreTAttLine.h TAttLine_tAttLineDistancetoLine" c_tattline_tattlinedistancetoline - :: (Ptr RawTAttLine) -> CInt -> CInt -> CDouble -> CDouble -> CDouble -> CDouble -> IO CInt +foreign import ccall safe + "HROOTCoreTAttLine.h TAttLine_newTAttLine" c_tattline_newtattline + :: CInt -> CInt -> CInt -> IO (Ptr RawTAttLine) -foreign import ccall "HROOTCoreTAttLine.h TAttLine_GetLineColor" c_tattline_getlinecolor - :: (Ptr RawTAttLine) -> IO CInt +foreign import ccall safe + "HROOTCoreTAttLine.h TAttLine_tAttLineDistancetoLine" + c_tattline_tattlinedistancetoline :: + Ptr RawTAttLine -> + CInt -> CInt -> CDouble -> CDouble -> CDouble -> CDouble -> IO CInt -foreign import ccall "HROOTCoreTAttLine.h TAttLine_GetLineStyle" c_tattline_getlinestyle - :: (Ptr RawTAttLine) -> IO CInt +foreign import ccall safe + "HROOTCoreTAttLine.h TAttLine_GetLineColor" c_tattline_getlinecolor + :: Ptr RawTAttLine -> IO CInt -foreign import ccall "HROOTCoreTAttLine.h TAttLine_GetLineWidth" c_tattline_getlinewidth - :: (Ptr RawTAttLine) -> IO CInt +foreign import ccall safe + "HROOTCoreTAttLine.h TAttLine_GetLineStyle" c_tattline_getlinestyle + :: Ptr RawTAttLine -> IO CInt -foreign import ccall "HROOTCoreTAttLine.h TAttLine_ResetAttLine" c_tattline_resetattline - :: (Ptr RawTAttLine) -> CString -> IO () +foreign import ccall safe + "HROOTCoreTAttLine.h TAttLine_GetLineWidth" c_tattline_getlinewidth + :: Ptr RawTAttLine -> IO CInt -foreign import ccall "HROOTCoreTAttLine.h TAttLine_SetLineAttributes" c_tattline_setlineattributes - :: (Ptr RawTAttLine) -> IO () +foreign import ccall safe + "HROOTCoreTAttLine.h TAttLine_ResetAttLine" c_tattline_resetattline + :: Ptr RawTAttLine -> CString -> IO () -foreign import ccall "HROOTCoreTAttLine.h TAttLine_SetLineColor" c_tattline_setlinecolor - :: (Ptr RawTAttLine) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttLine.h TAttLine_SetLineAttributes" + c_tattline_setlineattributes :: Ptr RawTAttLine -> IO () -foreign import ccall "HROOTCoreTAttLine.h TAttLine_SetLineStyle" c_tattline_setlinestyle - :: (Ptr RawTAttLine) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttLine.h TAttLine_SetLineColor" c_tattline_setlinecolor + :: Ptr RawTAttLine -> CInt -> IO () -foreign import ccall "HROOTCoreTAttLine.h TAttLine_SetLineWidth" c_tattline_setlinewidth - :: (Ptr RawTAttLine) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttLine.h TAttLine_SetLineStyle" c_tattline_setlinestyle + :: Ptr RawTAttLine -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttLine.h TAttLine_SetLineWidth" c_tattline_setlinewidth + :: Ptr RawTAttLine -> CInt -> IO () diff --git a/src/HROOT/Core/TAttLine/Implementation.hs b/src/HROOT/Core/TAttLine/Implementation.hs --- a/src/HROOT/Core/TAttLine/Implementation.hs +++ b/src/HROOT/Core/TAttLine/Implementation.hs @@ -1,63 +1,38 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TAttLine.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TAttLine.RawType import HROOT.Core.TAttLine.FFI import HROOT.Core.TAttLine.Interface import HROOT.Core.TAttLine.Cast - import HROOT.Core.Deletable.RawType import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - - instance ITAttLine TAttLine where - getLineColor = xform0 c_tattline_getlinecolor - getLineStyle = xform0 c_tattline_getlinestyle - getLineWidth = xform0 c_tattline_getlinewidth - resetAttLine = xform1 c_tattline_resetattline - setLineAttributes = xform0 c_tattline_setlineattributes - setLineColor = xform1 c_tattline_setlinecolor - setLineStyle = xform1 c_tattline_setlinestyle - setLineWidth = xform1 c_tattline_setlinewidth -instance IDeletable TAttLine where - delete = xform0 c_tattline_delete - -instance ITAttLine (Exist TAttLine) where - getLineColor (ETAttLine x) = getLineColor x - getLineStyle (ETAttLine x) = getLineStyle x - getLineWidth (ETAttLine x) = getLineWidth x - resetAttLine (ETAttLine x) = resetAttLine x - setLineAttributes (ETAttLine x) = setLineAttributes x - setLineColor (ETAttLine x) = setLineColor x - setLineStyle (ETAttLine x) = setLineStyle x - setLineWidth (ETAttLine x) = setLineWidth x -instance IDeletable (Exist TAttLine) where - delete (ETAttLine x) = delete x + getLineColor = xform0 c_tattline_getlinecolor + getLineStyle = xform0 c_tattline_getlinestyle + getLineWidth = xform0 c_tattline_getlinewidth + resetAttLine = xform1 c_tattline_resetattline + setLineAttributes = xform0 c_tattline_setlineattributes + setLineColor = xform1 c_tattline_setlinecolor + setLineStyle = xform1 c_tattline_setlinestyle + setLineWidth = xform1 c_tattline_setlinewidth +instance IDeletable TAttLine where + delete = xform0 c_tattline_delete newTAttLine :: CInt -> CInt -> CInt -> IO TAttLine newTAttLine = xform2 c_tattline_newtattline -tAttLineDistancetoLine :: TAttLine -> CInt -> CInt -> CDouble -> CDouble -> CDouble -> CDouble -> IO CInt +tAttLineDistancetoLine :: + TAttLine -> + CInt -> CInt -> CDouble -> CDouble -> CDouble -> CDouble -> IO CInt tAttLineDistancetoLine = xform6 c_tattline_tattlinedistancetoline - - - -instance FPtr (Exist TAttLine) where - type Raw (Exist TAttLine) = RawTAttLine - get_fptr (ETAttLine obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETAttLine (cast_fptr_to_obj (fptr :: ForeignPtr RawTAttLine) :: TAttLine) diff --git a/src/HROOT/Core/TAttLine/Interface.hs b/src/HROOT/Core/TAttLine/Interface.hs --- a/src/HROOT/Core/TAttLine/Interface.hs +++ b/src/HROOT/Core/TAttLine/Interface.hs @@ -1,52 +1,41 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TAttLine.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TAttLine.RawType - import HROOT.Core.Deletable.Interface ----- ============ ---- - - -class (IDeletable a) => ITAttLine a where - - getLineColor :: a -> IO CInt - - getLineStyle :: a -> IO CInt - - getLineWidth :: a -> IO CInt - - resetAttLine :: a -> CString -> IO () - - setLineAttributes :: a -> IO () - - setLineColor :: a -> CInt -> IO () - - setLineStyle :: a -> CInt -> IO () - - setLineWidth :: a -> CInt -> IO () - -instance Existable TAttLine where - data Exist TAttLine = forall a. (FPtr a, ITAttLine a) => ETAttLine a +class IDeletable a => ITAttLine a where + getLineColor :: a -> IO CInt + + getLineStyle :: a -> IO CInt + + getLineWidth :: a -> IO CInt + + resetAttLine :: Castable c0 CString => a -> c0 -> IO () + + setLineAttributes :: a -> IO () + + setLineColor :: a -> CInt -> IO () + + setLineStyle :: a -> CInt -> IO () + + setLineWidth :: a -> CInt -> IO () -upcastTAttLine :: (FPtr a, ITAttLine a) => a -> TAttLine -upcastTAttLine h = let fh = get_fptr h - fh2 :: ForeignPtr RawTAttLine = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTAttLine :: forall a . (FPtr a, ITAttLine a) => a -> TAttLine +upcastTAttLine h + = let fh = get_fptr h + fh2 :: Ptr RawTAttLine = castPtr fh + in cast_fptr_to_obj fh2 -downcastTAttLine :: (FPtr a, ITAttLine a) => TAttLine -> a -downcastTAttLine h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTAttLine :: + forall a . (FPtr a, ITAttLine a) => TAttLine -> a +downcastTAttLine h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TAttLine/RawType.hs b/src/HROOT/Core/TAttLine/RawType.hs --- a/src/HROOT/Core/TAttLine/RawType.hs +++ b/src/HROOT/Core/TAttLine/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TAttLine.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTAttLine -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TAttLine = TAttLine (Ptr RawTAttLine) + deriving (Eq, Ord, Show) -data RawTAttLine -newtype TAttLine = TAttLine (ForeignPtr RawTAttLine) deriving (Eq, Ord, Show) instance FPtr TAttLine where - type Raw TAttLine = RawTAttLine - get_fptr (TAttLine fptr) = fptr - cast_fptr_to_obj = TAttLine + type Raw TAttLine = RawTAttLine + get_fptr (TAttLine ptr) = ptr + cast_fptr_to_obj = TAttLine diff --git a/src/HROOT/Core/TAttMarker.hs b/src/HROOT/Core/TAttMarker.hs --- a/src/HROOT/Core/TAttMarker.hs +++ b/src/HROOT/Core/TAttMarker.hs @@ -1,15 +1,7 @@ module HROOT.Core.TAttMarker - ( - TAttMarker(..) - , ITAttMarker(..) - , upcastTAttMarker - , downcastTAttMarker - , newTAttMarker - - ) where - + (TAttMarker(..), ITAttMarker(..), upcastTAttMarker, + downcastTAttMarker, newTAttMarker) + where import HROOT.Core.TAttMarker.RawType import HROOT.Core.TAttMarker.Interface import HROOT.Core.TAttMarker.Implementation - - diff --git a/src/HROOT/Core/TAttMarker/Cast.hs b/src/HROOT/Core/TAttMarker/Cast.hs --- a/src/HROOT/Core/TAttMarker/Cast.hs +++ b/src/HROOT/Core/TAttMarker/Cast.hs @@ -1,22 +1,18 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TAttMarker.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TAttMarker.RawType import HROOT.Core.TAttMarker.Interface -instance (ITAttMarker a, FPtr a) => Castable a (Ptr RawTAttMarker) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ +instance (ITAttMarker a, FPtr a) => Castable a (Ptr RawTAttMarker) + where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TAttMarker (Ptr RawTAttMarker) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TAttMarker/FFI.hsc b/src/HROOT/Core/TAttMarker/FFI.hsc --- a/src/HROOT/Core/TAttMarker/FFI.hsc +++ b/src/HROOT/Core/TAttMarker/FFI.hsc @@ -1,49 +1,46 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TAttMarker.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TAttMarker.RawType - -#include "HROOTCoreTAttMarker.h" - -foreign import ccall "HROOTCoreTAttMarker.h TAttMarker_delete" c_tattmarker_delete - :: (Ptr RawTAttMarker) -> IO () - -foreign import ccall "HROOTCoreTAttMarker.h TAttMarker_newTAttMarker" c_tattmarker_newtattmarker - :: CInt -> CInt -> CInt -> IO (Ptr RawTAttMarker) +foreign import ccall safe "HROOTCoreTAttMarker.h TAttMarker_delete" + c_tattmarker_delete :: Ptr RawTAttMarker -> IO () -foreign import ccall "HROOTCoreTAttMarker.h TAttMarker_GetMarkerColor" c_tattmarker_getmarkercolor - :: (Ptr RawTAttMarker) -> IO CInt +foreign import ccall safe + "HROOTCoreTAttMarker.h TAttMarker_newTAttMarker" + c_tattmarker_newtattmarker :: + CInt -> CInt -> CInt -> IO (Ptr RawTAttMarker) -foreign import ccall "HROOTCoreTAttMarker.h TAttMarker_GetMarkerStyle" c_tattmarker_getmarkerstyle - :: (Ptr RawTAttMarker) -> IO CInt +foreign import ccall safe + "HROOTCoreTAttMarker.h TAttMarker_GetMarkerColor" + c_tattmarker_getmarkercolor :: Ptr RawTAttMarker -> IO CInt -foreign import ccall "HROOTCoreTAttMarker.h TAttMarker_GetMarkerSize" c_tattmarker_getmarkersize - :: (Ptr RawTAttMarker) -> IO CDouble +foreign import ccall safe + "HROOTCoreTAttMarker.h TAttMarker_GetMarkerStyle" + c_tattmarker_getmarkerstyle :: Ptr RawTAttMarker -> IO CInt -foreign import ccall "HROOTCoreTAttMarker.h TAttMarker_ResetAttMarker" c_tattmarker_resetattmarker - :: (Ptr RawTAttMarker) -> CString -> IO () +foreign import ccall safe + "HROOTCoreTAttMarker.h TAttMarker_GetMarkerSize" + c_tattmarker_getmarkersize :: Ptr RawTAttMarker -> IO CDouble -foreign import ccall "HROOTCoreTAttMarker.h TAttMarker_SetMarkerAttributes" c_tattmarker_setmarkerattributes - :: (Ptr RawTAttMarker) -> IO () +foreign import ccall safe + "HROOTCoreTAttMarker.h TAttMarker_ResetAttMarker" + c_tattmarker_resetattmarker :: + Ptr RawTAttMarker -> CString -> IO () -foreign import ccall "HROOTCoreTAttMarker.h TAttMarker_SetMarkerColor" c_tattmarker_setmarkercolor - :: (Ptr RawTAttMarker) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttMarker.h TAttMarker_SetMarkerAttributes" + c_tattmarker_setmarkerattributes :: Ptr RawTAttMarker -> IO () -foreign import ccall "HROOTCoreTAttMarker.h TAttMarker_SetMarkerStyle" c_tattmarker_setmarkerstyle - :: (Ptr RawTAttMarker) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttMarker.h TAttMarker_SetMarkerColor" + c_tattmarker_setmarkercolor :: Ptr RawTAttMarker -> CInt -> IO () -foreign import ccall "HROOTCoreTAttMarker.h TAttMarker_SetMarkerSize" c_tattmarker_setmarkersize - :: (Ptr RawTAttMarker) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttMarker.h TAttMarker_SetMarkerStyle" + c_tattmarker_setmarkerstyle :: Ptr RawTAttMarker -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttMarker.h TAttMarker_SetMarkerSize" + c_tattmarker_setmarkersize :: Ptr RawTAttMarker -> CInt -> IO () diff --git a/src/HROOT/Core/TAttMarker/Implementation.hs b/src/HROOT/Core/TAttMarker/Implementation.hs --- a/src/HROOT/Core/TAttMarker/Implementation.hs +++ b/src/HROOT/Core/TAttMarker/Implementation.hs @@ -1,62 +1,33 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TAttMarker.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TAttMarker.RawType import HROOT.Core.TAttMarker.FFI import HROOT.Core.TAttMarker.Interface import HROOT.Core.TAttMarker.Cast - import HROOT.Core.Deletable.RawType import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - - instance ITAttMarker TAttMarker where - getMarkerColor = xform0 c_tattmarker_getmarkercolor - getMarkerStyle = xform0 c_tattmarker_getmarkerstyle - getMarkerSize = xform0 c_tattmarker_getmarkersize - resetAttMarker = xform1 c_tattmarker_resetattmarker - setMarkerAttributes = xform0 c_tattmarker_setmarkerattributes - setMarkerColor = xform1 c_tattmarker_setmarkercolor - setMarkerStyle = xform1 c_tattmarker_setmarkerstyle - setMarkerSize = xform1 c_tattmarker_setmarkersize -instance IDeletable TAttMarker where - delete = xform0 c_tattmarker_delete - -instance ITAttMarker (Exist TAttMarker) where - getMarkerColor (ETAttMarker x) = getMarkerColor x - getMarkerStyle (ETAttMarker x) = getMarkerStyle x - getMarkerSize (ETAttMarker x) = getMarkerSize x - resetAttMarker (ETAttMarker x) = resetAttMarker x - setMarkerAttributes (ETAttMarker x) = setMarkerAttributes x - setMarkerColor (ETAttMarker x) = setMarkerColor x - setMarkerStyle (ETAttMarker x) = setMarkerStyle x - setMarkerSize (ETAttMarker x) = setMarkerSize x -instance IDeletable (Exist TAttMarker) where - delete (ETAttMarker x) = delete x + getMarkerColor = xform0 c_tattmarker_getmarkercolor + getMarkerStyle = xform0 c_tattmarker_getmarkerstyle + getMarkerSize = xform0 c_tattmarker_getmarkersize + resetAttMarker = xform1 c_tattmarker_resetattmarker + setMarkerAttributes = xform0 c_tattmarker_setmarkerattributes + setMarkerColor = xform1 c_tattmarker_setmarkercolor + setMarkerStyle = xform1 c_tattmarker_setmarkerstyle + setMarkerSize = xform1 c_tattmarker_setmarkersize +instance IDeletable TAttMarker where + delete = xform0 c_tattmarker_delete newTAttMarker :: CInt -> CInt -> CInt -> IO TAttMarker newTAttMarker = xform2 c_tattmarker_newtattmarker - - - - - -instance FPtr (Exist TAttMarker) where - type Raw (Exist TAttMarker) = RawTAttMarker - get_fptr (ETAttMarker obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETAttMarker (cast_fptr_to_obj (fptr :: ForeignPtr RawTAttMarker) :: TAttMarker) diff --git a/src/HROOT/Core/TAttMarker/Interface.hs b/src/HROOT/Core/TAttMarker/Interface.hs --- a/src/HROOT/Core/TAttMarker/Interface.hs +++ b/src/HROOT/Core/TAttMarker/Interface.hs @@ -1,52 +1,42 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TAttMarker.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TAttMarker.RawType - import HROOT.Core.Deletable.Interface ----- ============ ---- - - -class (IDeletable a) => ITAttMarker a where - - getMarkerColor :: a -> IO CInt - - getMarkerStyle :: a -> IO CInt - - getMarkerSize :: a -> IO CDouble - - resetAttMarker :: a -> CString -> IO () - - setMarkerAttributes :: a -> IO () - - setMarkerColor :: a -> CInt -> IO () - - setMarkerStyle :: a -> CInt -> IO () - - setMarkerSize :: a -> CInt -> IO () - -instance Existable TAttMarker where - data Exist TAttMarker = forall a. (FPtr a, ITAttMarker a) => ETAttMarker a +class IDeletable a => ITAttMarker a where + getMarkerColor :: a -> IO CInt + + getMarkerStyle :: a -> IO CInt + + getMarkerSize :: a -> IO CDouble + + resetAttMarker :: Castable c0 CString => a -> c0 -> IO () + + setMarkerAttributes :: a -> IO () + + setMarkerColor :: a -> CInt -> IO () + + setMarkerStyle :: a -> CInt -> IO () + + setMarkerSize :: a -> CInt -> IO () -upcastTAttMarker :: (FPtr a, ITAttMarker a) => a -> TAttMarker -upcastTAttMarker h = let fh = get_fptr h - fh2 :: ForeignPtr RawTAttMarker = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTAttMarker :: + forall a . (FPtr a, ITAttMarker a) => a -> TAttMarker +upcastTAttMarker h + = let fh = get_fptr h + fh2 :: Ptr RawTAttMarker = castPtr fh + in cast_fptr_to_obj fh2 -downcastTAttMarker :: (FPtr a, ITAttMarker a) => TAttMarker -> a -downcastTAttMarker h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTAttMarker :: + forall a . (FPtr a, ITAttMarker a) => TAttMarker -> a +downcastTAttMarker h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TAttMarker/RawType.hs b/src/HROOT/Core/TAttMarker/RawType.hs --- a/src/HROOT/Core/TAttMarker/RawType.hs +++ b/src/HROOT/Core/TAttMarker/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TAttMarker.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTAttMarker -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TAttMarker = TAttMarker (Ptr RawTAttMarker) + deriving (Eq, Ord, Show) -data RawTAttMarker -newtype TAttMarker = TAttMarker (ForeignPtr RawTAttMarker) deriving (Eq, Ord, Show) instance FPtr TAttMarker where - type Raw TAttMarker = RawTAttMarker - get_fptr (TAttMarker fptr) = fptr - cast_fptr_to_obj = TAttMarker + type Raw TAttMarker = RawTAttMarker + get_fptr (TAttMarker ptr) = ptr + cast_fptr_to_obj = TAttMarker diff --git a/src/HROOT/Core/TAttPad.hs b/src/HROOT/Core/TAttPad.hs --- a/src/HROOT/Core/TAttPad.hs +++ b/src/HROOT/Core/TAttPad.hs @@ -1,39 +1,17 @@ module HROOT.Core.TAttPad - ( - TAttPad(..) - , ITAttPad(..) - , upcastTAttPad - , downcastTAttPad - , newTAttPad - , tAttPadGetBottomMargin - , tAttPadGetLeftMargin - , tAttPadGetRightMargin - , tAttPadGetTopMargin - , tAttPadGetAfile - , tAttPadGetXfile - , tAttPadGetYfile - , tAttPadGetAstat - , tAttPadGetXstat - , tAttPadGetYstat - , tAttPadGetFrameFillColor - , tAttPadGetFrameLineColor - , tAttPadGetFrameFillStyle - , tAttPadGetFrameLineStyle - , tAttPadGetFrameLineWidth - , tAttPadGetFrameBorderSize - , tAttPadGetFrameBorderMode - , tAttPadSetFrameFillColor - , tAttPadSetFrameLineColor - , tAttPadSetFrameFillStyle - , tAttPadSetFrameLineStyle - , tAttPadSetFrameLineWidth - , tAttPadSetFrameBorderSize - , tAttPadSetFrameBorderMode - - ) where - + (TAttPad(..), ITAttPad(..), upcastTAttPad, downcastTAttPad, + newTAttPad, tAttPadGetBottomMargin, tAttPadGetLeftMargin, + tAttPadGetRightMargin, tAttPadGetTopMargin, tAttPadGetAfile, + tAttPadGetXfile, tAttPadGetYfile, tAttPadGetAstat, tAttPadGetXstat, + tAttPadGetYstat, tAttPadGetFrameFillColor, + tAttPadGetFrameLineColor, tAttPadGetFrameFillStyle, + tAttPadGetFrameLineStyle, tAttPadGetFrameLineWidth, + tAttPadGetFrameBorderSize, tAttPadGetFrameBorderMode, + tAttPadSetFrameFillColor, tAttPadSetFrameLineColor, + tAttPadSetFrameFillStyle, tAttPadSetFrameLineStyle, + tAttPadSetFrameLineWidth, tAttPadSetFrameBorderSize, + tAttPadSetFrameBorderMode) + where import HROOT.Core.TAttPad.RawType import HROOT.Core.TAttPad.Interface import HROOT.Core.TAttPad.Implementation - - diff --git a/src/HROOT/Core/TAttPad/Cast.hs b/src/HROOT/Core/TAttPad/Cast.hs --- a/src/HROOT/Core/TAttPad/Cast.hs +++ b/src/HROOT/Core/TAttPad/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TAttPad.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TAttPad.RawType import HROOT.Core.TAttPad.Interface instance (ITAttPad a, FPtr a) => Castable a (Ptr RawTAttPad) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TAttPad (Ptr RawTAttPad) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TAttPad/FFI.hsc b/src/HROOT/Core/TAttPad/FFI.hsc --- a/src/HROOT/Core/TAttPad/FFI.hsc +++ b/src/HROOT/Core/TAttPad/FFI.hsc @@ -1,133 +1,154 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TAttPad.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TAttPad.RawType - -#include "HROOTCoreTAttPad.h" - -foreign import ccall "HROOTCoreTAttPad.h TAttPad_delete" c_tattpad_delete - :: (Ptr RawTAttPad) -> IO () - -foreign import ccall "HROOTCoreTAttPad.h TAttPad_newTAttPad" c_tattpad_newtattpad - :: IO (Ptr RawTAttPad) +foreign import ccall safe "HROOTCoreTAttPad.h TAttPad_delete" + c_tattpad_delete :: Ptr RawTAttPad -> IO () -foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetBottomMargin" c_tattpad_tattpadgetbottommargin - :: (Ptr RawTAttPad) -> IO CDouble +foreign import ccall safe "HROOTCoreTAttPad.h TAttPad_newTAttPad" + c_tattpad_newtattpad :: IO (Ptr RawTAttPad) -foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetLeftMargin" c_tattpad_tattpadgetleftmargin - :: (Ptr RawTAttPad) -> IO CDouble +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_tAttPadGetBottomMargin" + c_tattpad_tattpadgetbottommargin :: Ptr RawTAttPad -> IO CDouble -foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetRightMargin" c_tattpad_tattpadgetrightmargin - :: (Ptr RawTAttPad) -> IO CDouble +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_tAttPadGetLeftMargin" + c_tattpad_tattpadgetleftmargin :: Ptr RawTAttPad -> IO CDouble -foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetTopMargin" c_tattpad_tattpadgettopmargin - :: (Ptr RawTAttPad) -> IO CDouble +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_tAttPadGetRightMargin" + c_tattpad_tattpadgetrightmargin :: Ptr RawTAttPad -> IO CDouble -foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetAfile" c_tattpad_tattpadgetafile - :: (Ptr RawTAttPad) -> IO CDouble +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_tAttPadGetTopMargin" + c_tattpad_tattpadgettopmargin :: Ptr RawTAttPad -> IO CDouble -foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetXfile" c_tattpad_tattpadgetxfile - :: (Ptr RawTAttPad) -> IO CDouble +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_tAttPadGetAfile" + c_tattpad_tattpadgetafile :: Ptr RawTAttPad -> IO CDouble -foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetYfile" c_tattpad_tattpadgetyfile - :: (Ptr RawTAttPad) -> IO CDouble +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_tAttPadGetXfile" + c_tattpad_tattpadgetxfile :: Ptr RawTAttPad -> IO CDouble -foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetAstat" c_tattpad_tattpadgetastat - :: (Ptr RawTAttPad) -> IO CDouble +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_tAttPadGetYfile" + c_tattpad_tattpadgetyfile :: Ptr RawTAttPad -> IO CDouble -foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetXstat" c_tattpad_tattpadgetxstat - :: (Ptr RawTAttPad) -> IO CDouble +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_tAttPadGetAstat" + c_tattpad_tattpadgetastat :: Ptr RawTAttPad -> IO CDouble -foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetYstat" c_tattpad_tattpadgetystat - :: (Ptr RawTAttPad) -> IO CDouble +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_tAttPadGetXstat" + c_tattpad_tattpadgetxstat :: Ptr RawTAttPad -> IO CDouble -foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetFrameFillColor" c_tattpad_tattpadgetframefillcolor - :: (Ptr RawTAttPad) -> IO CInt +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_tAttPadGetYstat" + c_tattpad_tattpadgetystat :: Ptr RawTAttPad -> IO CDouble -foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetFrameLineColor" c_tattpad_tattpadgetframelinecolor - :: (Ptr RawTAttPad) -> IO CInt +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_tAttPadGetFrameFillColor" + c_tattpad_tattpadgetframefillcolor :: Ptr RawTAttPad -> IO CInt -foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetFrameFillStyle" c_tattpad_tattpadgetframefillstyle - :: (Ptr RawTAttPad) -> IO CInt +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_tAttPadGetFrameLineColor" + c_tattpad_tattpadgetframelinecolor :: Ptr RawTAttPad -> IO CInt -foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetFrameLineStyle" c_tattpad_tattpadgetframelinestyle - :: (Ptr RawTAttPad) -> IO CInt +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_tAttPadGetFrameFillStyle" + c_tattpad_tattpadgetframefillstyle :: Ptr RawTAttPad -> IO CInt -foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetFrameLineWidth" c_tattpad_tattpadgetframelinewidth - :: (Ptr RawTAttPad) -> IO CInt +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_tAttPadGetFrameLineStyle" + c_tattpad_tattpadgetframelinestyle :: Ptr RawTAttPad -> IO CInt -foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetFrameBorderSize" c_tattpad_tattpadgetframebordersize - :: (Ptr RawTAttPad) -> IO CInt +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_tAttPadGetFrameLineWidth" + c_tattpad_tattpadgetframelinewidth :: Ptr RawTAttPad -> IO CInt -foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadGetFrameBorderMode" c_tattpad_tattpadgetframebordermode - :: (Ptr RawTAttPad) -> IO CInt +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_tAttPadGetFrameBorderSize" + c_tattpad_tattpadgetframebordersize :: Ptr RawTAttPad -> IO CInt -foreign import ccall "HROOTCoreTAttPad.h TAttPad_ResetAttPad" c_tattpad_resetattpad - :: (Ptr RawTAttPad) -> CString -> IO () +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_tAttPadGetFrameBorderMode" + c_tattpad_tattpadgetframebordermode :: Ptr RawTAttPad -> IO CInt -foreign import ccall "HROOTCoreTAttPad.h TAttPad_SetBottomMargin" c_tattpad_setbottommargin - :: (Ptr RawTAttPad) -> CDouble -> IO () +foreign import ccall safe "HROOTCoreTAttPad.h TAttPad_ResetAttPad" + c_tattpad_resetattpad :: Ptr RawTAttPad -> CString -> IO () -foreign import ccall "HROOTCoreTAttPad.h TAttPad_SetLeftMargin" c_tattpad_setleftmargin - :: (Ptr RawTAttPad) -> CDouble -> IO () +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_SetBottomMargin" + c_tattpad_setbottommargin :: Ptr RawTAttPad -> CDouble -> IO () -foreign import ccall "HROOTCoreTAttPad.h TAttPad_SetRightMargin" c_tattpad_setrightmargin - :: (Ptr RawTAttPad) -> CDouble -> IO () +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_SetLeftMargin" c_tattpad_setleftmargin + :: Ptr RawTAttPad -> CDouble -> IO () -foreign import ccall "HROOTCoreTAttPad.h TAttPad_SetTopMargin" c_tattpad_settopmargin - :: (Ptr RawTAttPad) -> CDouble -> IO () +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_SetRightMargin" + c_tattpad_setrightmargin :: Ptr RawTAttPad -> CDouble -> IO () -foreign import ccall "HROOTCoreTAttPad.h TAttPad_SetMargin" c_tattpad_setmargin - :: (Ptr RawTAttPad) -> CDouble -> CDouble -> CDouble -> CDouble -> IO () +foreign import ccall safe "HROOTCoreTAttPad.h TAttPad_SetTopMargin" + c_tattpad_settopmargin :: Ptr RawTAttPad -> CDouble -> IO () -foreign import ccall "HROOTCoreTAttPad.h TAttPad_SetAfile" c_tattpad_setafile - :: (Ptr RawTAttPad) -> CDouble -> IO () +foreign import ccall safe "HROOTCoreTAttPad.h TAttPad_SetMargin" + c_tattpad_setmargin :: + Ptr RawTAttPad -> CDouble -> CDouble -> CDouble -> CDouble -> IO () -foreign import ccall "HROOTCoreTAttPad.h TAttPad_SetXfile" c_tattpad_setxfile - :: (Ptr RawTAttPad) -> CDouble -> IO () +foreign import ccall safe "HROOTCoreTAttPad.h TAttPad_SetAfile" + c_tattpad_setafile :: Ptr RawTAttPad -> CDouble -> IO () -foreign import ccall "HROOTCoreTAttPad.h TAttPad_SetYfile" c_tattpad_setyfile - :: (Ptr RawTAttPad) -> CDouble -> IO () +foreign import ccall safe "HROOTCoreTAttPad.h TAttPad_SetXfile" + c_tattpad_setxfile :: Ptr RawTAttPad -> CDouble -> IO () -foreign import ccall "HROOTCoreTAttPad.h TAttPad_SetAstat" c_tattpad_setastat - :: (Ptr RawTAttPad) -> CDouble -> IO () +foreign import ccall safe "HROOTCoreTAttPad.h TAttPad_SetYfile" + c_tattpad_setyfile :: Ptr RawTAttPad -> CDouble -> IO () -foreign import ccall "HROOTCoreTAttPad.h TAttPad_SetXstat" c_tattpad_setxstat - :: (Ptr RawTAttPad) -> CDouble -> IO () +foreign import ccall safe "HROOTCoreTAttPad.h TAttPad_SetAstat" + c_tattpad_setastat :: Ptr RawTAttPad -> CDouble -> IO () -foreign import ccall "HROOTCoreTAttPad.h TAttPad_SetYstat" c_tattpad_setystat - :: (Ptr RawTAttPad) -> CDouble -> IO () +foreign import ccall safe "HROOTCoreTAttPad.h TAttPad_SetXstat" + c_tattpad_setxstat :: Ptr RawTAttPad -> CDouble -> IO () -foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadSetFrameFillColor" c_tattpad_tattpadsetframefillcolor - :: (Ptr RawTAttPad) -> CInt -> IO () +foreign import ccall safe "HROOTCoreTAttPad.h TAttPad_SetYstat" + c_tattpad_setystat :: Ptr RawTAttPad -> CDouble -> IO () -foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadSetFrameLineColor" c_tattpad_tattpadsetframelinecolor - :: (Ptr RawTAttPad) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_tAttPadSetFrameFillColor" + c_tattpad_tattpadsetframefillcolor :: + Ptr RawTAttPad -> CInt -> IO () -foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadSetFrameFillStyle" c_tattpad_tattpadsetframefillstyle - :: (Ptr RawTAttPad) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_tAttPadSetFrameLineColor" + c_tattpad_tattpadsetframelinecolor :: + Ptr RawTAttPad -> CInt -> IO () -foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadSetFrameLineStyle" c_tattpad_tattpadsetframelinestyle - :: (Ptr RawTAttPad) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_tAttPadSetFrameFillStyle" + c_tattpad_tattpadsetframefillstyle :: + Ptr RawTAttPad -> CInt -> IO () -foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadSetFrameLineWidth" c_tattpad_tattpadsetframelinewidth - :: (Ptr RawTAttPad) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_tAttPadSetFrameLineStyle" + c_tattpad_tattpadsetframelinestyle :: + Ptr RawTAttPad -> CInt -> IO () -foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadSetFrameBorderSize" c_tattpad_tattpadsetframebordersize - :: (Ptr RawTAttPad) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_tAttPadSetFrameLineWidth" + c_tattpad_tattpadsetframelinewidth :: + Ptr RawTAttPad -> CInt -> IO () -foreign import ccall "HROOTCoreTAttPad.h TAttPad_tAttPadSetFrameBorderMode" c_tattpad_tattpadsetframebordermode - :: (Ptr RawTAttPad) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_tAttPadSetFrameBorderSize" + c_tattpad_tattpadsetframebordersize :: + Ptr RawTAttPad -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttPad.h TAttPad_tAttPadSetFrameBorderMode" + c_tattpad_tattpadsetframebordermode :: + Ptr RawTAttPad -> CInt -> IO () diff --git a/src/HROOT/Core/TAttPad/Implementation.hs b/src/HROOT/Core/TAttPad/Implementation.hs --- a/src/HROOT/Core/TAttPad/Implementation.hs +++ b/src/HROOT/Core/TAttPad/Implementation.hs @@ -1,61 +1,37 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TAttPad.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TAttPad.RawType import HROOT.Core.TAttPad.FFI import HROOT.Core.TAttPad.Interface import HROOT.Core.TAttPad.Cast - import HROOT.Core.Deletable.RawType import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - - instance ITAttPad TAttPad where - resetAttPad = xform1 c_tattpad_resetattpad - setBottomMargin = xform1 c_tattpad_setbottommargin - setLeftMargin = xform1 c_tattpad_setleftmargin - setRightMargin = xform1 c_tattpad_setrightmargin - setTopMargin = xform1 c_tattpad_settopmargin - setMargin = xform4 c_tattpad_setmargin - setAfile = xform1 c_tattpad_setafile - setXfile = xform1 c_tattpad_setxfile - setYfile = xform1 c_tattpad_setyfile - setAstat = xform1 c_tattpad_setastat - setXstat = xform1 c_tattpad_setxstat - setYstat = xform1 c_tattpad_setystat -instance IDeletable TAttPad where - delete = xform0 c_tattpad_delete - -instance ITAttPad (Exist TAttPad) where - resetAttPad (ETAttPad x) = resetAttPad x - setBottomMargin (ETAttPad x) = setBottomMargin x - setLeftMargin (ETAttPad x) = setLeftMargin x - setRightMargin (ETAttPad x) = setRightMargin x - setTopMargin (ETAttPad x) = setTopMargin x - setMargin (ETAttPad x) = setMargin x - setAfile (ETAttPad x) = setAfile x - setXfile (ETAttPad x) = setXfile x - setYfile (ETAttPad x) = setYfile x - setAstat (ETAttPad x) = setAstat x - setXstat (ETAttPad x) = setXstat x - setYstat (ETAttPad x) = setYstat x -instance IDeletable (Exist TAttPad) where - delete (ETAttPad x) = delete x + resetAttPad = xform1 c_tattpad_resetattpad + setBottomMargin = xform1 c_tattpad_setbottommargin + setLeftMargin = xform1 c_tattpad_setleftmargin + setRightMargin = xform1 c_tattpad_setrightmargin + setTopMargin = xform1 c_tattpad_settopmargin + setMargin = xform4 c_tattpad_setmargin + setAfile = xform1 c_tattpad_setafile + setXfile = xform1 c_tattpad_setxfile + setYfile = xform1 c_tattpad_setyfile + setAstat = xform1 c_tattpad_setastat + setXstat = xform1 c_tattpad_setxstat + setYstat = xform1 c_tattpad_setystat +instance IDeletable TAttPad where + delete = xform0 c_tattpad_delete newTAttPad :: IO TAttPad newTAttPad = xformnull c_tattpad_newtattpad @@ -91,50 +67,57 @@ tAttPadGetYstat = xform0 c_tattpad_tattpadgetystat tAttPadGetFrameFillColor :: TAttPad -> IO CInt -tAttPadGetFrameFillColor = xform0 c_tattpad_tattpadgetframefillcolor +tAttPadGetFrameFillColor + = xform0 c_tattpad_tattpadgetframefillcolor tAttPadGetFrameLineColor :: TAttPad -> IO CInt -tAttPadGetFrameLineColor = xform0 c_tattpad_tattpadgetframelinecolor +tAttPadGetFrameLineColor + = xform0 c_tattpad_tattpadgetframelinecolor tAttPadGetFrameFillStyle :: TAttPad -> IO CInt -tAttPadGetFrameFillStyle = xform0 c_tattpad_tattpadgetframefillstyle +tAttPadGetFrameFillStyle + = xform0 c_tattpad_tattpadgetframefillstyle tAttPadGetFrameLineStyle :: TAttPad -> IO CInt -tAttPadGetFrameLineStyle = xform0 c_tattpad_tattpadgetframelinestyle +tAttPadGetFrameLineStyle + = xform0 c_tattpad_tattpadgetframelinestyle tAttPadGetFrameLineWidth :: TAttPad -> IO CInt -tAttPadGetFrameLineWidth = xform0 c_tattpad_tattpadgetframelinewidth +tAttPadGetFrameLineWidth + = xform0 c_tattpad_tattpadgetframelinewidth tAttPadGetFrameBorderSize :: TAttPad -> IO CInt -tAttPadGetFrameBorderSize = xform0 c_tattpad_tattpadgetframebordersize +tAttPadGetFrameBorderSize + = xform0 c_tattpad_tattpadgetframebordersize tAttPadGetFrameBorderMode :: TAttPad -> IO CInt -tAttPadGetFrameBorderMode = xform0 c_tattpad_tattpadgetframebordermode +tAttPadGetFrameBorderMode + = xform0 c_tattpad_tattpadgetframebordermode tAttPadSetFrameFillColor :: TAttPad -> CInt -> IO () -tAttPadSetFrameFillColor = xform1 c_tattpad_tattpadsetframefillcolor +tAttPadSetFrameFillColor + = xform1 c_tattpad_tattpadsetframefillcolor tAttPadSetFrameLineColor :: TAttPad -> CInt -> IO () -tAttPadSetFrameLineColor = xform1 c_tattpad_tattpadsetframelinecolor +tAttPadSetFrameLineColor + = xform1 c_tattpad_tattpadsetframelinecolor tAttPadSetFrameFillStyle :: TAttPad -> CInt -> IO () -tAttPadSetFrameFillStyle = xform1 c_tattpad_tattpadsetframefillstyle +tAttPadSetFrameFillStyle + = xform1 c_tattpad_tattpadsetframefillstyle tAttPadSetFrameLineStyle :: TAttPad -> CInt -> IO () -tAttPadSetFrameLineStyle = xform1 c_tattpad_tattpadsetframelinestyle +tAttPadSetFrameLineStyle + = xform1 c_tattpad_tattpadsetframelinestyle tAttPadSetFrameLineWidth :: TAttPad -> CInt -> IO () -tAttPadSetFrameLineWidth = xform1 c_tattpad_tattpadsetframelinewidth +tAttPadSetFrameLineWidth + = xform1 c_tattpad_tattpadsetframelinewidth tAttPadSetFrameBorderSize :: TAttPad -> CInt -> IO () -tAttPadSetFrameBorderSize = xform1 c_tattpad_tattpadsetframebordersize +tAttPadSetFrameBorderSize + = xform1 c_tattpad_tattpadsetframebordersize tAttPadSetFrameBorderMode :: TAttPad -> CInt -> IO () -tAttPadSetFrameBorderMode = xform1 c_tattpad_tattpadsetframebordermode - - - -instance FPtr (Exist TAttPad) where - type Raw (Exist TAttPad) = RawTAttPad - get_fptr (ETAttPad obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETAttPad (cast_fptr_to_obj (fptr :: ForeignPtr RawTAttPad) :: TAttPad) +tAttPadSetFrameBorderMode + = xform1 c_tattpad_tattpadsetframebordermode diff --git a/src/HROOT/Core/TAttPad/Interface.hs b/src/HROOT/Core/TAttPad/Interface.hs --- a/src/HROOT/Core/TAttPad/Interface.hs +++ b/src/HROOT/Core/TAttPad/Interface.hs @@ -1,60 +1,48 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TAttPad.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TAttPad.RawType - import HROOT.Core.Deletable.Interface ----- ============ ---- - - -class (IDeletable a) => ITAttPad a where - - resetAttPad :: a -> CString -> IO () - - setBottomMargin :: a -> CDouble -> IO () - - setLeftMargin :: a -> CDouble -> IO () - - setRightMargin :: a -> CDouble -> IO () - - setTopMargin :: a -> CDouble -> IO () - - setMargin :: a -> CDouble -> CDouble -> CDouble -> CDouble -> IO () - - setAfile :: a -> CDouble -> IO () - - setXfile :: a -> CDouble -> IO () - - setYfile :: a -> CDouble -> IO () - - setAstat :: a -> CDouble -> IO () - - setXstat :: a -> CDouble -> IO () - - setYstat :: a -> CDouble -> IO () - -instance Existable TAttPad where - data Exist TAttPad = forall a. (FPtr a, ITAttPad a) => ETAttPad a +class IDeletable a => ITAttPad a where + resetAttPad :: Castable c0 CString => a -> c0 -> IO () + + setBottomMargin :: a -> CDouble -> IO () + + setLeftMargin :: a -> CDouble -> IO () + + setRightMargin :: a -> CDouble -> IO () + + setTopMargin :: a -> CDouble -> IO () + + setMargin :: a -> CDouble -> CDouble -> CDouble -> CDouble -> IO () + + setAfile :: a -> CDouble -> IO () + + setXfile :: a -> CDouble -> IO () + + setYfile :: a -> CDouble -> IO () + + setAstat :: a -> CDouble -> IO () + + setXstat :: a -> CDouble -> IO () + + setYstat :: a -> CDouble -> IO () -upcastTAttPad :: (FPtr a, ITAttPad a) => a -> TAttPad -upcastTAttPad h = let fh = get_fptr h - fh2 :: ForeignPtr RawTAttPad = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTAttPad :: forall a . (FPtr a, ITAttPad a) => a -> TAttPad +upcastTAttPad h + = let fh = get_fptr h + fh2 :: Ptr RawTAttPad = castPtr fh + in cast_fptr_to_obj fh2 -downcastTAttPad :: (FPtr a, ITAttPad a) => TAttPad -> a -downcastTAttPad h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTAttPad :: forall a . (FPtr a, ITAttPad a) => TAttPad -> a +downcastTAttPad h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TAttPad/RawType.hs b/src/HROOT/Core/TAttPad/RawType.hs --- a/src/HROOT/Core/TAttPad/RawType.hs +++ b/src/HROOT/Core/TAttPad/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TAttPad.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTAttPad -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TAttPad = TAttPad (Ptr RawTAttPad) + deriving (Eq, Ord, Show) -data RawTAttPad -newtype TAttPad = TAttPad (ForeignPtr RawTAttPad) deriving (Eq, Ord, Show) instance FPtr TAttPad where - type Raw TAttPad = RawTAttPad - get_fptr (TAttPad fptr) = fptr - cast_fptr_to_obj = TAttPad + type Raw TAttPad = RawTAttPad + get_fptr (TAttPad ptr) = ptr + cast_fptr_to_obj = TAttPad diff --git a/src/HROOT/Core/TAttText.hs b/src/HROOT/Core/TAttText.hs --- a/src/HROOT/Core/TAttText.hs +++ b/src/HROOT/Core/TAttText.hs @@ -1,15 +1,7 @@ module HROOT.Core.TAttText - ( - TAttText(..) - , ITAttText(..) - , upcastTAttText - , downcastTAttText - , newTAttText - - ) where - + (TAttText(..), ITAttText(..), upcastTAttText, downcastTAttText, + newTAttText) + where import HROOT.Core.TAttText.RawType import HROOT.Core.TAttText.Interface import HROOT.Core.TAttText.Implementation - - diff --git a/src/HROOT/Core/TAttText/Cast.hs b/src/HROOT/Core/TAttText/Cast.hs --- a/src/HROOT/Core/TAttText/Cast.hs +++ b/src/HROOT/Core/TAttText/Cast.hs @@ -1,22 +1,18 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TAttText.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TAttText.RawType import HROOT.Core.TAttText.Interface -instance (ITAttText a, FPtr a) => Castable a (Ptr RawTAttText) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ +instance (ITAttText a, FPtr a) => Castable a (Ptr RawTAttText) + where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TAttText (Ptr RawTAttText) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TAttText/FFI.hsc b/src/HROOT/Core/TAttText/FFI.hsc --- a/src/HROOT/Core/TAttText/FFI.hsc +++ b/src/HROOT/Core/TAttText/FFI.hsc @@ -1,64 +1,65 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TAttText.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TAttText.RawType - -#include "HROOTCoreTAttText.h" - -foreign import ccall "HROOTCoreTAttText.h TAttText_delete" c_tatttext_delete - :: (Ptr RawTAttText) -> IO () - -foreign import ccall "HROOTCoreTAttText.h TAttText_newTAttText" c_tatttext_newtatttext - :: CInt -> CDouble -> CInt -> CInt -> CDouble -> IO (Ptr RawTAttText) +foreign import ccall safe "HROOTCoreTAttText.h TAttText_delete" + c_tatttext_delete :: Ptr RawTAttText -> IO () -foreign import ccall "HROOTCoreTAttText.h TAttText_GetTextAlign" c_tatttext_gettextalign - :: (Ptr RawTAttText) -> IO CInt +foreign import ccall safe + "HROOTCoreTAttText.h TAttText_newTAttText" c_tatttext_newtatttext + :: + CInt -> CDouble -> CInt -> CInt -> CDouble -> IO (Ptr RawTAttText) -foreign import ccall "HROOTCoreTAttText.h TAttText_GetTextAngle" c_tatttext_gettextangle - :: (Ptr RawTAttText) -> IO CDouble +foreign import ccall safe + "HROOTCoreTAttText.h TAttText_GetTextAlign" c_tatttext_gettextalign + :: Ptr RawTAttText -> IO CInt -foreign import ccall "HROOTCoreTAttText.h TAttText_GetTextColor" c_tatttext_gettextcolor - :: (Ptr RawTAttText) -> IO CInt +foreign import ccall safe + "HROOTCoreTAttText.h TAttText_GetTextAngle" c_tatttext_gettextangle + :: Ptr RawTAttText -> IO CDouble -foreign import ccall "HROOTCoreTAttText.h TAttText_GetTextFont" c_tatttext_gettextfont - :: (Ptr RawTAttText) -> IO CInt +foreign import ccall safe + "HROOTCoreTAttText.h TAttText_GetTextColor" c_tatttext_gettextcolor + :: Ptr RawTAttText -> IO CInt -foreign import ccall "HROOTCoreTAttText.h TAttText_GetTextSize" c_tatttext_gettextsize - :: (Ptr RawTAttText) -> IO CDouble +foreign import ccall safe + "HROOTCoreTAttText.h TAttText_GetTextFont" c_tatttext_gettextfont + :: Ptr RawTAttText -> IO CInt -foreign import ccall "HROOTCoreTAttText.h TAttText_ResetAttText" c_tatttext_resetatttext - :: (Ptr RawTAttText) -> CString -> IO () +foreign import ccall safe + "HROOTCoreTAttText.h TAttText_GetTextSize" c_tatttext_gettextsize + :: Ptr RawTAttText -> IO CDouble -foreign import ccall "HROOTCoreTAttText.h TAttText_SetTextAttributes" c_tatttext_settextattributes - :: (Ptr RawTAttText) -> IO () +foreign import ccall safe + "HROOTCoreTAttText.h TAttText_ResetAttText" c_tatttext_resetatttext + :: Ptr RawTAttText -> CString -> IO () -foreign import ccall "HROOTCoreTAttText.h TAttText_SetTextAlign" c_tatttext_settextalign - :: (Ptr RawTAttText) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttText.h TAttText_SetTextAttributes" + c_tatttext_settextattributes :: Ptr RawTAttText -> IO () -foreign import ccall "HROOTCoreTAttText.h TAttText_SetTextAngle" c_tatttext_settextangle - :: (Ptr RawTAttText) -> CDouble -> IO () +foreign import ccall safe + "HROOTCoreTAttText.h TAttText_SetTextAlign" c_tatttext_settextalign + :: Ptr RawTAttText -> CInt -> IO () -foreign import ccall "HROOTCoreTAttText.h TAttText_SetTextColor" c_tatttext_settextcolor - :: (Ptr RawTAttText) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttText.h TAttText_SetTextAngle" c_tatttext_settextangle + :: Ptr RawTAttText -> CDouble -> IO () -foreign import ccall "HROOTCoreTAttText.h TAttText_SetTextFont" c_tatttext_settextfont - :: (Ptr RawTAttText) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttText.h TAttText_SetTextColor" c_tatttext_settextcolor + :: Ptr RawTAttText -> CInt -> IO () -foreign import ccall "HROOTCoreTAttText.h TAttText_SetTextSize" c_tatttext_settextsize - :: (Ptr RawTAttText) -> CDouble -> IO () +foreign import ccall safe + "HROOTCoreTAttText.h TAttText_SetTextFont" c_tatttext_settextfont + :: Ptr RawTAttText -> CInt -> IO () -foreign import ccall "HROOTCoreTAttText.h TAttText_SetTextSizePixels" c_tatttext_settextsizepixels - :: (Ptr RawTAttText) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTAttText.h TAttText_SetTextSize" c_tatttext_settextsize + :: Ptr RawTAttText -> CDouble -> IO () +foreign import ccall safe + "HROOTCoreTAttText.h TAttText_SetTextSizePixels" + c_tatttext_settextsizepixels :: Ptr RawTAttText -> CInt -> IO () diff --git a/src/HROOT/Core/TAttText/Implementation.hs b/src/HROOT/Core/TAttText/Implementation.hs --- a/src/HROOT/Core/TAttText/Implementation.hs +++ b/src/HROOT/Core/TAttText/Implementation.hs @@ -1,72 +1,39 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TAttText.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TAttText.RawType import HROOT.Core.TAttText.FFI import HROOT.Core.TAttText.Interface import HROOT.Core.TAttText.Cast - import HROOT.Core.Deletable.RawType import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - - instance ITAttText TAttText where - getTextAlign = xform0 c_tatttext_gettextalign - getTextAngle = xform0 c_tatttext_gettextangle - getTextColor = xform0 c_tatttext_gettextcolor - getTextFont = xform0 c_tatttext_gettextfont - getTextSize = xform0 c_tatttext_gettextsize - resetAttText = xform1 c_tatttext_resetatttext - setTextAttributes = xform0 c_tatttext_settextattributes - setTextAlign = xform1 c_tatttext_settextalign - setTextAngle = xform1 c_tatttext_settextangle - setTextColor = xform1 c_tatttext_settextcolor - setTextFont = xform1 c_tatttext_settextfont - setTextSize = xform1 c_tatttext_settextsize - setTextSizePixels = xform1 c_tatttext_settextsizepixels -instance IDeletable TAttText where - delete = xform0 c_tatttext_delete - -instance ITAttText (Exist TAttText) where - getTextAlign (ETAttText x) = getTextAlign x - getTextAngle (ETAttText x) = getTextAngle x - getTextColor (ETAttText x) = getTextColor x - getTextFont (ETAttText x) = getTextFont x - getTextSize (ETAttText x) = getTextSize x - resetAttText (ETAttText x) = resetAttText x - setTextAttributes (ETAttText x) = setTextAttributes x - setTextAlign (ETAttText x) = setTextAlign x - setTextAngle (ETAttText x) = setTextAngle x - setTextColor (ETAttText x) = setTextColor x - setTextFont (ETAttText x) = setTextFont x - setTextSize (ETAttText x) = setTextSize x - setTextSizePixels (ETAttText x) = setTextSizePixels x -instance IDeletable (Exist TAttText) where - delete (ETAttText x) = delete x + getTextAlign = xform0 c_tatttext_gettextalign + getTextAngle = xform0 c_tatttext_gettextangle + getTextColor = xform0 c_tatttext_gettextcolor + getTextFont = xform0 c_tatttext_gettextfont + getTextSize = xform0 c_tatttext_gettextsize + resetAttText = xform1 c_tatttext_resetatttext + setTextAttributes = xform0 c_tatttext_settextattributes + setTextAlign = xform1 c_tatttext_settextalign + setTextAngle = xform1 c_tatttext_settextangle + setTextColor = xform1 c_tatttext_settextcolor + setTextFont = xform1 c_tatttext_settextfont + setTextSize = xform1 c_tatttext_settextsize + setTextSizePixels = xform1 c_tatttext_settextsizepixels +instance IDeletable TAttText where + delete = xform0 c_tatttext_delete -newTAttText :: CInt -> CDouble -> CInt -> CInt -> CDouble -> IO TAttText +newTAttText :: + CInt -> CDouble -> CInt -> CInt -> CDouble -> IO TAttText newTAttText = xform4 c_tatttext_newtatttext - - - - - -instance FPtr (Exist TAttText) where - type Raw (Exist TAttText) = RawTAttText - get_fptr (ETAttText obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETAttText (cast_fptr_to_obj (fptr :: ForeignPtr RawTAttText) :: TAttText) diff --git a/src/HROOT/Core/TAttText/Interface.hs b/src/HROOT/Core/TAttText/Interface.hs --- a/src/HROOT/Core/TAttText/Interface.hs +++ b/src/HROOT/Core/TAttText/Interface.hs @@ -1,62 +1,51 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TAttText.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TAttText.RawType - import HROOT.Core.Deletable.Interface ----- ============ ---- - - -class (IDeletable a) => ITAttText a where - - getTextAlign :: a -> IO CInt - - getTextAngle :: a -> IO CDouble - - getTextColor :: a -> IO CInt - - getTextFont :: a -> IO CInt - - getTextSize :: a -> IO CDouble - - resetAttText :: a -> CString -> IO () - - setTextAttributes :: a -> IO () - - setTextAlign :: a -> CInt -> IO () - - setTextAngle :: a -> CDouble -> IO () - - setTextColor :: a -> CInt -> IO () - - setTextFont :: a -> CInt -> IO () - - setTextSize :: a -> CDouble -> IO () - - setTextSizePixels :: a -> CInt -> IO () - -instance Existable TAttText where - data Exist TAttText = forall a. (FPtr a, ITAttText a) => ETAttText a +class IDeletable a => ITAttText a where + getTextAlign :: a -> IO CInt + + getTextAngle :: a -> IO CDouble + + getTextColor :: a -> IO CInt + + getTextFont :: a -> IO CInt + + getTextSize :: a -> IO CDouble + + resetAttText :: Castable c0 CString => a -> c0 -> IO () + + setTextAttributes :: a -> IO () + + setTextAlign :: a -> CInt -> IO () + + setTextAngle :: a -> CDouble -> IO () + + setTextColor :: a -> CInt -> IO () + + setTextFont :: a -> CInt -> IO () + + setTextSize :: a -> CDouble -> IO () + + setTextSizePixels :: a -> CInt -> IO () -upcastTAttText :: (FPtr a, ITAttText a) => a -> TAttText -upcastTAttText h = let fh = get_fptr h - fh2 :: ForeignPtr RawTAttText = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTAttText :: forall a . (FPtr a, ITAttText a) => a -> TAttText +upcastTAttText h + = let fh = get_fptr h + fh2 :: Ptr RawTAttText = castPtr fh + in cast_fptr_to_obj fh2 -downcastTAttText :: (FPtr a, ITAttText a) => TAttText -> a -downcastTAttText h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTAttText :: + forall a . (FPtr a, ITAttText a) => TAttText -> a +downcastTAttText h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TAttText/RawType.hs b/src/HROOT/Core/TAttText/RawType.hs --- a/src/HROOT/Core/TAttText/RawType.hs +++ b/src/HROOT/Core/TAttText/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TAttText.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTAttText -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TAttText = TAttText (Ptr RawTAttText) + deriving (Eq, Ord, Show) -data RawTAttText -newtype TAttText = TAttText (ForeignPtr RawTAttText) deriving (Eq, Ord, Show) instance FPtr TAttText where - type Raw TAttText = RawTAttText - get_fptr (TAttText fptr) = fptr - cast_fptr_to_obj = TAttText + type Raw TAttText = RawTAttText + get_fptr (TAttText ptr) = ptr + cast_fptr_to_obj = TAttText diff --git a/src/HROOT/Core/TClass.hs b/src/HROOT/Core/TClass.hs --- a/src/HROOT/Core/TClass.hs +++ b/src/HROOT/Core/TClass.hs @@ -1,15 +1,5 @@ module HROOT.Core.TClass - ( - TClass(..) - , ITClass - , upcastTClass - , downcastTClass - - - ) where - + (TClass(..), ITClass, upcastTClass, downcastTClass) where import HROOT.Core.TClass.RawType import HROOT.Core.TClass.Interface import HROOT.Core.TClass.Implementation - - diff --git a/src/HROOT/Core/TClass/Cast.hs b/src/HROOT/Core/TClass/Cast.hs --- a/src/HROOT/Core/TClass/Cast.hs +++ b/src/HROOT/Core/TClass/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TClass.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TClass.RawType import HROOT.Core.TClass.Interface instance (ITClass a, FPtr a) => Castable a (Ptr RawTClass) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TClass (Ptr RawTClass) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TClass/FFI.hsc b/src/HROOT/Core/TClass/FFI.hsc --- a/src/HROOT/Core/TClass/FFI.hsc +++ b/src/HROOT/Core/TClass/FFI.hsc @@ -1,55 +1,45 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TClass.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TClass.RawType import HROOT.Core.TObject.RawType -#include "HROOTCoreTClass.h" - -foreign import ccall "HROOTCoreTClass.h TClass_SetName" c_tclass_setname - :: (Ptr RawTClass) -> CString -> IO () - -foreign import ccall "HROOTCoreTClass.h TClass_SetNameTitle" c_tclass_setnametitle - :: (Ptr RawTClass) -> CString -> CString -> IO () +foreign import ccall safe "HROOTCoreTClass.h TClass_SetName" + c_tclass_setname :: Ptr RawTClass -> CString -> IO () -foreign import ccall "HROOTCoreTClass.h TClass_SetTitle" c_tclass_settitle - :: (Ptr RawTClass) -> CString -> IO () +foreign import ccall safe "HROOTCoreTClass.h TClass_SetNameTitle" + c_tclass_setnametitle :: + Ptr RawTClass -> CString -> CString -> IO () -foreign import ccall "HROOTCoreTClass.h TClass_Draw" c_tclass_draw - :: (Ptr RawTClass) -> CString -> IO () +foreign import ccall safe "HROOTCoreTClass.h TClass_SetTitle" + c_tclass_settitle :: Ptr RawTClass -> CString -> IO () -foreign import ccall "HROOTCoreTClass.h TClass_FindObject" c_tclass_findobject - :: (Ptr RawTClass) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTCoreTClass.h TClass_Draw" + c_tclass_draw :: Ptr RawTClass -> CString -> IO () -foreign import ccall "HROOTCoreTClass.h TClass_GetName" c_tclass_getname - :: (Ptr RawTClass) -> IO CString +foreign import ccall safe "HROOTCoreTClass.h TClass_FindObject" + c_tclass_findobject :: + Ptr RawTClass -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTCoreTClass.h TClass_IsA" c_tclass_isa - :: (Ptr RawTClass) -> IO (Ptr RawTClass) +foreign import ccall safe "HROOTCoreTClass.h TClass_GetName" + c_tclass_getname :: Ptr RawTClass -> IO CString -foreign import ccall "HROOTCoreTClass.h TClass_Paint" c_tclass_paint - :: (Ptr RawTClass) -> CString -> IO () +foreign import ccall safe "HROOTCoreTClass.h TClass_IsA" + c_tclass_isa :: Ptr RawTClass -> IO (Ptr RawTClass) -foreign import ccall "HROOTCoreTClass.h TClass_printObj" c_tclass_printobj - :: (Ptr RawTClass) -> CString -> IO () +foreign import ccall safe "HROOTCoreTClass.h TClass_Paint" + c_tclass_paint :: Ptr RawTClass -> CString -> IO () -foreign import ccall "HROOTCoreTClass.h TClass_SaveAs" c_tclass_saveas - :: (Ptr RawTClass) -> CString -> CString -> IO () +foreign import ccall safe "HROOTCoreTClass.h TClass_printObj" + c_tclass_printobj :: Ptr RawTClass -> CString -> IO () -foreign import ccall "HROOTCoreTClass.h TClass_Write" c_tclass_write - :: (Ptr RawTClass) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTCoreTClass.h TClass_SaveAs" + c_tclass_saveas :: Ptr RawTClass -> CString -> CString -> IO () -foreign import ccall "HROOTCoreTClass.h TClass_delete" c_tclass_delete - :: (Ptr RawTClass) -> IO () +foreign import ccall safe "HROOTCoreTClass.h TClass_Write" + c_tclass_write :: + Ptr RawTClass -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTCoreTClass.h TClass_delete" + c_tclass_delete :: Ptr RawTClass -> IO () diff --git a/src/HROOT/Core/TClass/Implementation.hs b/src/HROOT/Core/TClass/Implementation.hs --- a/src/HROOT/Core/TClass/Implementation.hs +++ b/src/HROOT/Core/TClass/Implementation.hs @@ -1,17 +1,17 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TClass.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TClass.RawType import HROOT.Core.TClass.FFI import HROOT.Core.TClass.Interface import HROOT.Core.TClass.Cast - import HROOT.Core.TDictionary.RawType import HROOT.Core.TDictionary.Cast import HROOT.Core.TDictionary.Interface @@ -25,59 +25,24 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe +instance ITClass TClass +instance ITDictionary TClass -instance ITClass TClass where -instance ITDictionary TClass where instance ITNamed TClass where - setName = xform1 c_tclass_setname - setNameTitle = xform2 c_tclass_setnametitle - setTitle = xform1 c_tclass_settitle -instance ITObject TClass where - draw = xform1 c_tclass_draw - findObject = xform1 c_tclass_findobject - getName = xform0 c_tclass_getname - isA = xform0 c_tclass_isa - paint = xform1 c_tclass_paint - printObj = xform1 c_tclass_printobj - saveAs = xform2 c_tclass_saveas - write = xform3 c_tclass_write -instance IDeletable TClass where - delete = xform0 c_tclass_delete - -instance ITClass (Exist TClass) where - -instance ITDictionary (Exist TClass) where - -instance ITNamed (Exist TClass) where - setName (ETClass x) = setName x - setNameTitle (ETClass x) = setNameTitle x - setTitle (ETClass x) = setTitle x -instance ITObject (Exist TClass) where - draw (ETClass x) = draw x - findObject (ETClass x) = findObject x - getName (ETClass x) = getName x - isA (ETClass x) = isA x - paint (ETClass x) = paint x - printObj (ETClass x) = printObj x - saveAs (ETClass x) = saveAs x - write (ETClass x) = write x -instance IDeletable (Exist TClass) where - delete (ETClass x) = delete x - - - - - + setName = xform1 c_tclass_setname + setNameTitle = xform2 c_tclass_setnametitle + setTitle = xform1 c_tclass_settitle +instance ITObject TClass where + draw = xform1 c_tclass_draw + findObject = xform1 c_tclass_findobject + getName = xform0 c_tclass_getname + isA = xform0 c_tclass_isa + paint = xform1 c_tclass_paint + printObj = xform1 c_tclass_printobj + saveAs = xform2 c_tclass_saveas + write = xform3 c_tclass_write -instance FPtr (Exist TClass) where - type Raw (Exist TClass) = RawTClass - get_fptr (ETClass obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETClass (cast_fptr_to_obj (fptr :: ForeignPtr RawTClass) :: TClass) +instance IDeletable TClass where + delete = xform0 c_tclass_delete diff --git a/src/HROOT/Core/TClass/Interface.hs b/src/HROOT/Core/TClass/Interface.hs --- a/src/HROOT/Core/TClass/Interface.hs +++ b/src/HROOT/Core/TClass/Interface.hs @@ -1,36 +1,25 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TClass.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TClass.RawType - import HROOT.Core.TDictionary.Interface ----- ============ ---- - - -class (ITDictionary a) => ITClass a where - -instance Existable TClass where - data Exist TClass = forall a. (FPtr a, ITClass a) => ETClass a +class ITDictionary a => ITClass a -upcastTClass :: (FPtr a, ITClass a) => a -> TClass -upcastTClass h = let fh = get_fptr h - fh2 :: ForeignPtr RawTClass = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTClass :: forall a . (FPtr a, ITClass a) => a -> TClass +upcastTClass h + = let fh = get_fptr h + fh2 :: Ptr RawTClass = castPtr fh + in cast_fptr_to_obj fh2 -downcastTClass :: (FPtr a, ITClass a) => TClass -> a -downcastTClass h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTClass :: forall a . (FPtr a, ITClass a) => TClass -> a +downcastTClass h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TClass/Interface.hs-boot b/src/HROOT/Core/TClass/Interface.hs-boot new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TClass/Interface.hs-boot @@ -0,0 +1,3 @@ +module HROOT.Core.TClass.Interface where + +class ITClass a diff --git a/src/HROOT/Core/TClass/RawType.hs b/src/HROOT/Core/TClass/RawType.hs --- a/src/HROOT/Core/TClass/RawType.hs +++ b/src/HROOT/Core/TClass/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TClass.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTClass -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TClass = TClass (Ptr RawTClass) + deriving (Eq, Ord, Show) -data RawTClass -newtype TClass = TClass (ForeignPtr RawTClass) deriving (Eq, Ord, Show) instance FPtr TClass where - type Raw TClass = RawTClass - get_fptr (TClass fptr) = fptr - cast_fptr_to_obj = TClass + type Raw TClass = RawTClass + get_fptr (TClass ptr) = ptr + cast_fptr_to_obj = TClass diff --git a/src/HROOT/Core/TCollection.hs b/src/HROOT/Core/TCollection.hs --- a/src/HROOT/Core/TCollection.hs +++ b/src/HROOT/Core/TCollection.hs @@ -1,15 +1,7 @@ module HROOT.Core.TCollection - ( - TCollection(..) - , ITCollection - , upcastTCollection - , downcastTCollection - - - ) where - + (TCollection(..), ITCollection, upcastTCollection, + downcastTCollection) + where import HROOT.Core.TCollection.RawType import HROOT.Core.TCollection.Interface import HROOT.Core.TCollection.Implementation - - diff --git a/src/HROOT/Core/TCollection/Cast.hs b/src/HROOT/Core/TCollection/Cast.hs --- a/src/HROOT/Core/TCollection/Cast.hs +++ b/src/HROOT/Core/TCollection/Cast.hs @@ -1,22 +1,18 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TCollection.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TCollection.RawType import HROOT.Core.TCollection.Interface -instance (ITCollection a, FPtr a) => Castable a (Ptr RawTCollection) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ +instance (ITCollection a, FPtr a) => Castable a + (Ptr RawTCollection) where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TCollection (Ptr RawTCollection) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TCollection/FFI.hsc b/src/HROOT/Core/TCollection/FFI.hsc --- a/src/HROOT/Core/TCollection/FFI.hsc +++ b/src/HROOT/Core/TCollection/FFI.hsc @@ -1,47 +1,42 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TCollection.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TCollection.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTCoreTCollection.h" - -foreign import ccall "HROOTCoreTCollection.h TCollection_Draw" c_tcollection_draw - :: (Ptr RawTCollection) -> CString -> IO () - -foreign import ccall "HROOTCoreTCollection.h TCollection_FindObject" c_tcollection_findobject - :: (Ptr RawTCollection) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTCoreTCollection.h TCollection_Draw" + c_tcollection_draw :: Ptr RawTCollection -> CString -> IO () -foreign import ccall "HROOTCoreTCollection.h TCollection_GetName" c_tcollection_getname - :: (Ptr RawTCollection) -> IO CString +foreign import ccall safe + "HROOTCoreTCollection.h TCollection_FindObject" + c_tcollection_findobject :: + Ptr RawTCollection -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTCoreTCollection.h TCollection_IsA" c_tcollection_isa - :: (Ptr RawTCollection) -> IO (Ptr RawTClass) +foreign import ccall safe + "HROOTCoreTCollection.h TCollection_GetName" c_tcollection_getname + :: Ptr RawTCollection -> IO CString -foreign import ccall "HROOTCoreTCollection.h TCollection_Paint" c_tcollection_paint - :: (Ptr RawTCollection) -> CString -> IO () +foreign import ccall safe "HROOTCoreTCollection.h TCollection_IsA" + c_tcollection_isa :: Ptr RawTCollection -> IO (Ptr RawTClass) -foreign import ccall "HROOTCoreTCollection.h TCollection_printObj" c_tcollection_printobj - :: (Ptr RawTCollection) -> CString -> IO () +foreign import ccall safe + "HROOTCoreTCollection.h TCollection_Paint" c_tcollection_paint :: + Ptr RawTCollection -> CString -> IO () -foreign import ccall "HROOTCoreTCollection.h TCollection_SaveAs" c_tcollection_saveas - :: (Ptr RawTCollection) -> CString -> CString -> IO () +foreign import ccall safe + "HROOTCoreTCollection.h TCollection_printObj" + c_tcollection_printobj :: Ptr RawTCollection -> CString -> IO () -foreign import ccall "HROOTCoreTCollection.h TCollection_Write" c_tcollection_write - :: (Ptr RawTCollection) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe + "HROOTCoreTCollection.h TCollection_SaveAs" c_tcollection_saveas :: + Ptr RawTCollection -> CString -> CString -> IO () -foreign import ccall "HROOTCoreTCollection.h TCollection_delete" c_tcollection_delete - :: (Ptr RawTCollection) -> IO () +foreign import ccall safe + "HROOTCoreTCollection.h TCollection_Write" c_tcollection_write :: + Ptr RawTCollection -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe + "HROOTCoreTCollection.h TCollection_delete" c_tcollection_delete :: + Ptr RawTCollection -> IO () diff --git a/src/HROOT/Core/TCollection/Implementation.hs b/src/HROOT/Core/TCollection/Implementation.hs --- a/src/HROOT/Core/TCollection/Implementation.hs +++ b/src/HROOT/Core/TCollection/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TCollection.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TCollection.RawType import HROOT.Core.TCollection.FFI import HROOT.Core.TCollection.Interface @@ -21,48 +22,17 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - +instance ITCollection TCollection -instance ITCollection TCollection where instance ITObject TCollection where - draw = xform1 c_tcollection_draw - findObject = xform1 c_tcollection_findobject - getName = xform0 c_tcollection_getname - isA = xform0 c_tcollection_isa - paint = xform1 c_tcollection_paint - printObj = xform1 c_tcollection_printobj - saveAs = xform2 c_tcollection_saveas - write = xform3 c_tcollection_write -instance IDeletable TCollection where - delete = xform0 c_tcollection_delete - -instance ITCollection (Exist TCollection) where - -instance ITObject (Exist TCollection) where - draw (ETCollection x) = draw x - findObject (ETCollection x) = findObject x - getName (ETCollection x) = getName x - isA (ETCollection x) = isA x - paint (ETCollection x) = paint x - printObj (ETCollection x) = printObj x - saveAs (ETCollection x) = saveAs x - write (ETCollection x) = write x -instance IDeletable (Exist TCollection) where - delete (ETCollection x) = delete x - - - - - - + draw = xform1 c_tcollection_draw + findObject = xform1 c_tcollection_findobject + getName = xform0 c_tcollection_getname + isA = xform0 c_tcollection_isa + paint = xform1 c_tcollection_paint + printObj = xform1 c_tcollection_printobj + saveAs = xform2 c_tcollection_saveas + write = xform3 c_tcollection_write -instance FPtr (Exist TCollection) where - type Raw (Exist TCollection) = RawTCollection - get_fptr (ETCollection obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETCollection (cast_fptr_to_obj (fptr :: ForeignPtr RawTCollection) :: TCollection) +instance IDeletable TCollection where + delete = xform0 c_tcollection_delete diff --git a/src/HROOT/Core/TCollection/Interface.hs b/src/HROOT/Core/TCollection/Interface.hs --- a/src/HROOT/Core/TCollection/Interface.hs +++ b/src/HROOT/Core/TCollection/Interface.hs @@ -1,36 +1,27 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TCollection.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TCollection.RawType - import HROOT.Core.TObject.Interface ----- ============ ---- - - -class (ITObject a) => ITCollection a where - -instance Existable TCollection where - data Exist TCollection = forall a. (FPtr a, ITCollection a) => ETCollection a +class ITObject a => ITCollection a -upcastTCollection :: (FPtr a, ITCollection a) => a -> TCollection -upcastTCollection h = let fh = get_fptr h - fh2 :: ForeignPtr RawTCollection = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTCollection :: + forall a . (FPtr a, ITCollection a) => a -> TCollection +upcastTCollection h + = let fh = get_fptr h + fh2 :: Ptr RawTCollection = castPtr fh + in cast_fptr_to_obj fh2 -downcastTCollection :: (FPtr a, ITCollection a) => TCollection -> a -downcastTCollection h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTCollection :: + forall a . (FPtr a, ITCollection a) => TCollection -> a +downcastTCollection h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TCollection/RawType.hs b/src/HROOT/Core/TCollection/RawType.hs --- a/src/HROOT/Core/TCollection/RawType.hs +++ b/src/HROOT/Core/TCollection/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TCollection.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTCollection -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TCollection = TCollection (Ptr RawTCollection) + deriving (Eq, Ord, Show) -data RawTCollection -newtype TCollection = TCollection (ForeignPtr RawTCollection) deriving (Eq, Ord, Show) instance FPtr TCollection where - type Raw TCollection = RawTCollection - get_fptr (TCollection fptr) = fptr - cast_fptr_to_obj = TCollection + type Raw TCollection = RawTCollection + get_fptr (TCollection ptr) = ptr + cast_fptr_to_obj = TCollection diff --git a/src/HROOT/Core/TDictionary.hs b/src/HROOT/Core/TDictionary.hs --- a/src/HROOT/Core/TDictionary.hs +++ b/src/HROOT/Core/TDictionary.hs @@ -1,10 +1,4 @@ -module HROOT.Core.TDictionary - ( - ITDictionary - ) where - +module HROOT.Core.TDictionary (ITDictionary) where import HROOT.Core.TDictionary.RawType import HROOT.Core.TDictionary.Interface import HROOT.Core.TDictionary.Implementation - - diff --git a/src/HROOT/Core/TDictionary/Cast.hs b/src/HROOT/Core/TDictionary/Cast.hs --- a/src/HROOT/Core/TDictionary/Cast.hs +++ b/src/HROOT/Core/TDictionary/Cast.hs @@ -1,18 +1,9 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TDictionary.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TDictionary.RawType import HROOT.Core.TDictionary.Interface - - - - diff --git a/src/HROOT/Core/TDictionary/FFI.hsc b/src/HROOT/Core/TDictionary/FFI.hsc --- a/src/HROOT/Core/TDictionary/FFI.hsc +++ b/src/HROOT/Core/TDictionary/FFI.hsc @@ -1,44 +1,7 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TDictionary.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TDictionary.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType - -#include "HROOTCoreTDictionary.h" - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/src/HROOT/Core/TDictionary/Implementation.hs b/src/HROOT/Core/TDictionary/Implementation.hs --- a/src/HROOT/Core/TDictionary/Implementation.hs +++ b/src/HROOT/Core/TDictionary/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TDictionary.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TDictionary.RawType import HROOT.Core.TDictionary.FFI import HROOT.Core.TDictionary.Interface @@ -23,26 +24,3 @@ import HROOT.Core.Deletable.RawType import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface - -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - - - - - - - - - - - - - - - - diff --git a/src/HROOT/Core/TDictionary/Interface.hs b/src/HROOT/Core/TDictionary/Interface.hs --- a/src/HROOT/Core/TDictionary/Interface.hs +++ b/src/HROOT/Core/TDictionary/Interface.hs @@ -1,29 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TDictionary.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TDictionary.RawType - import HROOT.Core.TNamed.Interface ----- ============ ---- - - -class (ITNamed a) => ITDictionary a where - - - - - - +class ITNamed a => ITDictionary a diff --git a/src/HROOT/Core/TDictionary/RawType.hs b/src/HROOT/Core/TDictionary/RawType.hs --- a/src/HROOT/Core/TDictionary/RawType.hs +++ b/src/HROOT/Core/TDictionary/RawType.hs @@ -1,11 +1,6 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TDictionary.RawType where - - -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast - - +import Foreign.Ptr +import FFICXX.Runtime.Cast diff --git a/src/HROOT/Core/TDirectory.hs b/src/HROOT/Core/TDirectory.hs --- a/src/HROOT/Core/TDirectory.hs +++ b/src/HROOT/Core/TDirectory.hs @@ -1,16 +1,8 @@ module HROOT.Core.TDirectory - ( - TDirectory(..) - , ITDirectory(..) - , upcastTDirectory - , downcastTDirectory - - , tDirectoryAddDirectory - , tDirectoryAddDirectoryStatus - ) where - + (TDirectory(..), ITDirectory(..), upcastTDirectory, + downcastTDirectory, tDirectoryAddDirectory, + tDirectoryAddDirectoryStatus) + where import HROOT.Core.TDirectory.RawType import HROOT.Core.TDirectory.Interface import HROOT.Core.TDirectory.Implementation - - diff --git a/src/HROOT/Core/TDirectory/Cast.hs b/src/HROOT/Core/TDirectory/Cast.hs --- a/src/HROOT/Core/TDirectory/Cast.hs +++ b/src/HROOT/Core/TDirectory/Cast.hs @@ -1,22 +1,18 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TDirectory.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TDirectory.RawType import HROOT.Core.TDirectory.Interface -instance (ITDirectory a, FPtr a) => Castable a (Ptr RawTDirectory) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ +instance (ITDirectory a, FPtr a) => Castable a (Ptr RawTDirectory) + where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TDirectory (Ptr RawTDirectory) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TDirectory/FFI.hsc b/src/HROOT/Core/TDirectory/FFI.hsc --- a/src/HROOT/Core/TDirectory/FFI.hsc +++ b/src/HROOT/Core/TDirectory/FFI.hsc @@ -1,81 +1,86 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TDirectory.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TDirectory.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType import HROOT.Core.TKey.RawType -#include "HROOTCoreTDirectory.h" - -foreign import ccall "HROOTCoreTDirectory.h TDirectory_SetName" c_tdirectory_setname - :: (Ptr RawTDirectory) -> CString -> IO () - -foreign import ccall "HROOTCoreTDirectory.h TDirectory_SetNameTitle" c_tdirectory_setnametitle - :: (Ptr RawTDirectory) -> CString -> CString -> IO () +foreign import ccall safe + "HROOTCoreTDirectory.h TDirectory_SetName" c_tdirectory_setname :: + Ptr RawTDirectory -> CString -> IO () -foreign import ccall "HROOTCoreTDirectory.h TDirectory_SetTitle" c_tdirectory_settitle - :: (Ptr RawTDirectory) -> CString -> IO () +foreign import ccall safe + "HROOTCoreTDirectory.h TDirectory_SetNameTitle" + c_tdirectory_setnametitle :: + Ptr RawTDirectory -> CString -> CString -> IO () -foreign import ccall "HROOTCoreTDirectory.h TDirectory_Draw" c_tdirectory_draw - :: (Ptr RawTDirectory) -> CString -> IO () +foreign import ccall safe + "HROOTCoreTDirectory.h TDirectory_SetTitle" c_tdirectory_settitle + :: Ptr RawTDirectory -> CString -> IO () -foreign import ccall "HROOTCoreTDirectory.h TDirectory_FindObject" c_tdirectory_findobject - :: (Ptr RawTDirectory) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTCoreTDirectory.h TDirectory_Draw" + c_tdirectory_draw :: Ptr RawTDirectory -> CString -> IO () -foreign import ccall "HROOTCoreTDirectory.h TDirectory_GetName" c_tdirectory_getname - :: (Ptr RawTDirectory) -> IO CString +foreign import ccall safe + "HROOTCoreTDirectory.h TDirectory_FindObject" + c_tdirectory_findobject :: + Ptr RawTDirectory -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTCoreTDirectory.h TDirectory_IsA" c_tdirectory_isa - :: (Ptr RawTDirectory) -> IO (Ptr RawTClass) +foreign import ccall safe + "HROOTCoreTDirectory.h TDirectory_GetName" c_tdirectory_getname :: + Ptr RawTDirectory -> IO CString -foreign import ccall "HROOTCoreTDirectory.h TDirectory_Paint" c_tdirectory_paint - :: (Ptr RawTDirectory) -> CString -> IO () +foreign import ccall safe "HROOTCoreTDirectory.h TDirectory_IsA" + c_tdirectory_isa :: Ptr RawTDirectory -> IO (Ptr RawTClass) -foreign import ccall "HROOTCoreTDirectory.h TDirectory_printObj" c_tdirectory_printobj - :: (Ptr RawTDirectory) -> CString -> IO () +foreign import ccall safe "HROOTCoreTDirectory.h TDirectory_Paint" + c_tdirectory_paint :: Ptr RawTDirectory -> CString -> IO () -foreign import ccall "HROOTCoreTDirectory.h TDirectory_SaveAs" c_tdirectory_saveas - :: (Ptr RawTDirectory) -> CString -> CString -> IO () +foreign import ccall safe + "HROOTCoreTDirectory.h TDirectory_printObj" c_tdirectory_printobj + :: Ptr RawTDirectory -> CString -> IO () -foreign import ccall "HROOTCoreTDirectory.h TDirectory_Write" c_tdirectory_write - :: (Ptr RawTDirectory) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTCoreTDirectory.h TDirectory_SaveAs" + c_tdirectory_saveas :: + Ptr RawTDirectory -> CString -> CString -> IO () -foreign import ccall "HROOTCoreTDirectory.h TDirectory_delete" c_tdirectory_delete - :: (Ptr RawTDirectory) -> IO () +foreign import ccall safe "HROOTCoreTDirectory.h TDirectory_Write" + c_tdirectory_write :: + Ptr RawTDirectory -> CString -> CInt -> CInt -> IO CInt -foreign import ccall "HROOTCoreTDirectory.h TDirectory_tDirectoryAddDirectory" c_tdirectory_tdirectoryadddirectory - :: CInt -> IO () +foreign import ccall safe "HROOTCoreTDirectory.h TDirectory_delete" + c_tdirectory_delete :: Ptr RawTDirectory -> IO () -foreign import ccall "HROOTCoreTDirectory.h TDirectory_tDirectoryAddDirectoryStatus" c_tdirectory_tdirectoryadddirectorystatus - :: IO CInt +foreign import ccall safe + "HROOTCoreTDirectory.h TDirectory_tDirectoryAddDirectory" + c_tdirectory_tdirectoryadddirectory :: CInt -> IO () -foreign import ccall "HROOTCoreTDirectory.h TDirectory_Append" c_tdirectory_append - :: (Ptr RawTDirectory) -> (Ptr RawTObject) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTDirectory.h TDirectory_tDirectoryAddDirectoryStatus" + c_tdirectory_tdirectoryadddirectorystatus :: IO CInt -foreign import ccall "HROOTCoreTDirectory.h TDirectory_addD" c_tdirectory_addd - :: (Ptr RawTDirectory) -> (Ptr RawTObject) -> CInt -> IO () +foreign import ccall safe "HROOTCoreTDirectory.h TDirectory_Append" + c_tdirectory_append :: + Ptr RawTDirectory -> Ptr RawTObject -> CInt -> IO () -foreign import ccall "HROOTCoreTDirectory.h TDirectory_AppendKey" c_tdirectory_appendkey - :: (Ptr RawTDirectory) -> (Ptr RawTKey) -> IO CInt +foreign import ccall safe "HROOTCoreTDirectory.h TDirectory_addD" + c_tdirectory_addd :: + Ptr RawTDirectory -> Ptr RawTObject -> CInt -> IO () -foreign import ccall "HROOTCoreTDirectory.h TDirectory_Close" c_tdirectory_close - :: (Ptr RawTDirectory) -> CString -> IO () +foreign import ccall safe + "HROOTCoreTDirectory.h TDirectory_AppendKey" c_tdirectory_appendkey + :: Ptr RawTDirectory -> Ptr RawTKey -> IO CInt -foreign import ccall "HROOTCoreTDirectory.h TDirectory_Get" c_tdirectory_get - :: (Ptr RawTDirectory) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTCoreTDirectory.h TDirectory_Close" + c_tdirectory_close :: Ptr RawTDirectory -> CString -> IO () -foreign import ccall "HROOTCoreTDirectory.h TDirectory_cd_TDirectory" c_tdirectory_cd_tdirectory - :: (Ptr RawTDirectory) -> CString -> IO CInt +foreign import ccall safe "HROOTCoreTDirectory.h TDirectory_Get" + c_tdirectory_get :: + Ptr RawTDirectory -> CString -> IO (Ptr RawTObject) +foreign import ccall safe + "HROOTCoreTDirectory.h TDirectory_cd_TDirectory" + c_tdirectory_cd_tdirectory :: + Ptr RawTDirectory -> CString -> IO CInt diff --git a/src/HROOT/Core/TDirectory/Implementation.hs b/src/HROOT/Core/TDirectory/Implementation.hs --- a/src/HROOT/Core/TDirectory/Implementation.hs +++ b/src/HROOT/Core/TDirectory/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TDirectory.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TDirectory.RawType import HROOT.Core.TDirectory.FFI import HROOT.Core.TDirectory.Interface @@ -27,71 +28,35 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - - instance ITDirectory TDirectory where - append = xform2 c_tdirectory_append - addD = xform2 c_tdirectory_addd - appendKey = xform1 c_tdirectory_appendkey - close = xform1 c_tdirectory_close - get = xform1 c_tdirectory_get - cd_TDirectory = xform1 c_tdirectory_cd_tdirectory -instance ITNamed TDirectory where - setName = xform1 c_tdirectory_setname - setNameTitle = xform2 c_tdirectory_setnametitle - setTitle = xform1 c_tdirectory_settitle -instance ITObject TDirectory where - draw = xform1 c_tdirectory_draw - findObject = xform1 c_tdirectory_findobject - getName = xform0 c_tdirectory_getname - isA = xform0 c_tdirectory_isa - paint = xform1 c_tdirectory_paint - printObj = xform1 c_tdirectory_printobj - saveAs = xform2 c_tdirectory_saveas - write = xform3 c_tdirectory_write -instance IDeletable TDirectory where - delete = xform0 c_tdirectory_delete - -instance ITDirectory (Exist TDirectory) where - append (ETDirectory x) = append x - addD (ETDirectory x) = addD x - appendKey (ETDirectory x) = appendKey x - close (ETDirectory x) = close x - get (ETDirectory x) = get x - cd_TDirectory (ETDirectory x) = cd_TDirectory x -instance ITNamed (Exist TDirectory) where - setName (ETDirectory x) = setName x - setNameTitle (ETDirectory x) = setNameTitle x - setTitle (ETDirectory x) = setTitle x -instance ITObject (Exist TDirectory) where - draw (ETDirectory x) = draw x - findObject (ETDirectory x) = findObject x - getName (ETDirectory x) = getName x - isA (ETDirectory x) = isA x - paint (ETDirectory x) = paint x - printObj (ETDirectory x) = printObj x - saveAs (ETDirectory x) = saveAs x - write (ETDirectory x) = write x -instance IDeletable (Exist TDirectory) where - delete (ETDirectory x) = delete x - + append = xform2 c_tdirectory_append + addD = xform2 c_tdirectory_addd + appendKey = xform1 c_tdirectory_appendkey + close = xform1 c_tdirectory_close + get = xform1 c_tdirectory_get + cd_TDirectory = xform1 c_tdirectory_cd_tdirectory +instance ITNamed TDirectory where + setName = xform1 c_tdirectory_setname + setNameTitle = xform2 c_tdirectory_setnametitle + setTitle = xform1 c_tdirectory_settitle +instance ITObject TDirectory where + draw = xform1 c_tdirectory_draw + findObject = xform1 c_tdirectory_findobject + getName = xform0 c_tdirectory_getname + isA = xform0 c_tdirectory_isa + paint = xform1 c_tdirectory_paint + printObj = xform1 c_tdirectory_printobj + saveAs = xform2 c_tdirectory_saveas + write = xform3 c_tdirectory_write +instance IDeletable TDirectory where + delete = xform0 c_tdirectory_delete tDirectoryAddDirectory :: CInt -> IO () tDirectoryAddDirectory = xform0 c_tdirectory_tdirectoryadddirectory tDirectoryAddDirectoryStatus :: IO CInt -tDirectoryAddDirectoryStatus = xformnull c_tdirectory_tdirectoryadddirectorystatus - -instance FPtr (Exist TDirectory) where - type Raw (Exist TDirectory) = RawTDirectory - get_fptr (ETDirectory obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETDirectory (cast_fptr_to_obj (fptr :: ForeignPtr RawTDirectory) :: TDirectory) +tDirectoryAddDirectoryStatus + = xformnull c_tdirectory_tdirectoryadddirectorystatus diff --git a/src/HROOT/Core/TDirectory/Interface.hs b/src/HROOT/Core/TDirectory/Interface.hs --- a/src/HROOT/Core/TDirectory/Interface.hs +++ b/src/HROOT/Core/TDirectory/Interface.hs @@ -1,49 +1,41 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TDirectory.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TDirectory.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TNamed.Interface ----- ============ ---- import {-# SOURCE #-} HROOT.Core.TObject.Interface import {-# SOURCE #-} HROOT.Core.TKey.Interface - -class (ITNamed a) => ITDirectory a where - - append :: (ITObject c0, FPtr c0) => a -> c0 -> CInt -> IO () - - addD :: (ITObject c0, FPtr c0) => a -> c0 -> CInt -> IO () - - appendKey :: (ITKey c0, FPtr c0) => a -> c0 -> IO CInt - - close :: a -> CString -> IO () - - get :: a -> CString -> IO TObject - - cd_TDirectory :: a -> CString -> IO CInt - -instance Existable TDirectory where - data Exist TDirectory = forall a. (FPtr a, ITDirectory a) => ETDirectory a +class ITNamed a => ITDirectory a where + append :: (ITObject c0, FPtr c0) => a -> c0 -> CInt -> IO () + + addD :: (ITObject c0, FPtr c0) => a -> c0 -> CInt -> IO () + + appendKey :: (ITKey c0, FPtr c0) => a -> c0 -> IO CInt + + close :: Castable c0 CString => a -> c0 -> IO () + + get :: Castable c0 CString => a -> c0 -> IO TObject + + cd_TDirectory :: Castable c0 CString => a -> c0 -> IO CInt -upcastTDirectory :: (FPtr a, ITDirectory a) => a -> TDirectory -upcastTDirectory h = let fh = get_fptr h - fh2 :: ForeignPtr RawTDirectory = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTDirectory :: + forall a . (FPtr a, ITDirectory a) => a -> TDirectory +upcastTDirectory h + = let fh = get_fptr h + fh2 :: Ptr RawTDirectory = castPtr fh + in cast_fptr_to_obj fh2 -downcastTDirectory :: (FPtr a, ITDirectory a) => TDirectory -> a -downcastTDirectory h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTDirectory :: + forall a . (FPtr a, ITDirectory a) => TDirectory -> a +downcastTDirectory h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TDirectory/Interface.hs-boot b/src/HROOT/Core/TDirectory/Interface.hs-boot new file mode 100644 --- /dev/null +++ b/src/HROOT/Core/TDirectory/Interface.hs-boot @@ -0,0 +1,3 @@ +module HROOT.Core.TDirectory.Interface where + +class ITDirectory a diff --git a/src/HROOT/Core/TDirectory/RawType.hs b/src/HROOT/Core/TDirectory/RawType.hs --- a/src/HROOT/Core/TDirectory/RawType.hs +++ b/src/HROOT/Core/TDirectory/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TDirectory.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTDirectory -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TDirectory = TDirectory (Ptr RawTDirectory) + deriving (Eq, Ord, Show) -data RawTDirectory -newtype TDirectory = TDirectory (ForeignPtr RawTDirectory) deriving (Eq, Ord, Show) instance FPtr TDirectory where - type Raw TDirectory = RawTDirectory - get_fptr (TDirectory fptr) = fptr - cast_fptr_to_obj = TDirectory + type Raw TDirectory = RawTDirectory + get_fptr (TDirectory ptr) = ptr + cast_fptr_to_obj = TDirectory diff --git a/src/HROOT/Core/TGlobal.hs b/src/HROOT/Core/TGlobal.hs --- a/src/HROOT/Core/TGlobal.hs +++ b/src/HROOT/Core/TGlobal.hs @@ -1,15 +1,5 @@ module HROOT.Core.TGlobal - ( - TGlobal(..) - , ITGlobal - , upcastTGlobal - , downcastTGlobal - - - ) where - + (TGlobal(..), ITGlobal, upcastTGlobal, downcastTGlobal) where import HROOT.Core.TGlobal.RawType import HROOT.Core.TGlobal.Interface import HROOT.Core.TGlobal.Implementation - - diff --git a/src/HROOT/Core/TGlobal/Cast.hs b/src/HROOT/Core/TGlobal/Cast.hs --- a/src/HROOT/Core/TGlobal/Cast.hs +++ b/src/HROOT/Core/TGlobal/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TGlobal.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TGlobal.RawType import HROOT.Core.TGlobal.Interface instance (ITGlobal a, FPtr a) => Castable a (Ptr RawTGlobal) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TGlobal (Ptr RawTGlobal) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TGlobal/FFI.hsc b/src/HROOT/Core/TGlobal/FFI.hsc --- a/src/HROOT/Core/TGlobal/FFI.hsc +++ b/src/HROOT/Core/TGlobal/FFI.hsc @@ -1,56 +1,46 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TGlobal.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TGlobal.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTCoreTGlobal.h" - -foreign import ccall "HROOTCoreTGlobal.h TGlobal_SetName" c_tglobal_setname - :: (Ptr RawTGlobal) -> CString -> IO () - -foreign import ccall "HROOTCoreTGlobal.h TGlobal_SetNameTitle" c_tglobal_setnametitle - :: (Ptr RawTGlobal) -> CString -> CString -> IO () +foreign import ccall safe "HROOTCoreTGlobal.h TGlobal_SetName" + c_tglobal_setname :: Ptr RawTGlobal -> CString -> IO () -foreign import ccall "HROOTCoreTGlobal.h TGlobal_SetTitle" c_tglobal_settitle - :: (Ptr RawTGlobal) -> CString -> IO () +foreign import ccall safe "HROOTCoreTGlobal.h TGlobal_SetNameTitle" + c_tglobal_setnametitle :: + Ptr RawTGlobal -> CString -> CString -> IO () -foreign import ccall "HROOTCoreTGlobal.h TGlobal_Draw" c_tglobal_draw - :: (Ptr RawTGlobal) -> CString -> IO () +foreign import ccall safe "HROOTCoreTGlobal.h TGlobal_SetTitle" + c_tglobal_settitle :: Ptr RawTGlobal -> CString -> IO () -foreign import ccall "HROOTCoreTGlobal.h TGlobal_FindObject" c_tglobal_findobject - :: (Ptr RawTGlobal) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTCoreTGlobal.h TGlobal_Draw" + c_tglobal_draw :: Ptr RawTGlobal -> CString -> IO () -foreign import ccall "HROOTCoreTGlobal.h TGlobal_GetName" c_tglobal_getname - :: (Ptr RawTGlobal) -> IO CString +foreign import ccall safe "HROOTCoreTGlobal.h TGlobal_FindObject" + c_tglobal_findobject :: + Ptr RawTGlobal -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTCoreTGlobal.h TGlobal_IsA" c_tglobal_isa - :: (Ptr RawTGlobal) -> IO (Ptr RawTClass) +foreign import ccall safe "HROOTCoreTGlobal.h TGlobal_GetName" + c_tglobal_getname :: Ptr RawTGlobal -> IO CString -foreign import ccall "HROOTCoreTGlobal.h TGlobal_Paint" c_tglobal_paint - :: (Ptr RawTGlobal) -> CString -> IO () +foreign import ccall safe "HROOTCoreTGlobal.h TGlobal_IsA" + c_tglobal_isa :: Ptr RawTGlobal -> IO (Ptr RawTClass) -foreign import ccall "HROOTCoreTGlobal.h TGlobal_printObj" c_tglobal_printobj - :: (Ptr RawTGlobal) -> CString -> IO () +foreign import ccall safe "HROOTCoreTGlobal.h TGlobal_Paint" + c_tglobal_paint :: Ptr RawTGlobal -> CString -> IO () -foreign import ccall "HROOTCoreTGlobal.h TGlobal_SaveAs" c_tglobal_saveas - :: (Ptr RawTGlobal) -> CString -> CString -> IO () +foreign import ccall safe "HROOTCoreTGlobal.h TGlobal_printObj" + c_tglobal_printobj :: Ptr RawTGlobal -> CString -> IO () -foreign import ccall "HROOTCoreTGlobal.h TGlobal_Write" c_tglobal_write - :: (Ptr RawTGlobal) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTCoreTGlobal.h TGlobal_SaveAs" + c_tglobal_saveas :: Ptr RawTGlobal -> CString -> CString -> IO () -foreign import ccall "HROOTCoreTGlobal.h TGlobal_delete" c_tglobal_delete - :: (Ptr RawTGlobal) -> IO () +foreign import ccall safe "HROOTCoreTGlobal.h TGlobal_Write" + c_tglobal_write :: + Ptr RawTGlobal -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTCoreTGlobal.h TGlobal_delete" + c_tglobal_delete :: Ptr RawTGlobal -> IO () diff --git a/src/HROOT/Core/TGlobal/Implementation.hs b/src/HROOT/Core/TGlobal/Implementation.hs --- a/src/HROOT/Core/TGlobal/Implementation.hs +++ b/src/HROOT/Core/TGlobal/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TGlobal.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TGlobal.RawType import HROOT.Core.TGlobal.FFI import HROOT.Core.TGlobal.Interface @@ -27,59 +28,24 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe +instance ITGlobal TGlobal +instance ITDictionary TGlobal -instance ITGlobal TGlobal where -instance ITDictionary TGlobal where instance ITNamed TGlobal where - setName = xform1 c_tglobal_setname - setNameTitle = xform2 c_tglobal_setnametitle - setTitle = xform1 c_tglobal_settitle -instance ITObject TGlobal where - draw = xform1 c_tglobal_draw - findObject = xform1 c_tglobal_findobject - getName = xform0 c_tglobal_getname - isA = xform0 c_tglobal_isa - paint = xform1 c_tglobal_paint - printObj = xform1 c_tglobal_printobj - saveAs = xform2 c_tglobal_saveas - write = xform3 c_tglobal_write -instance IDeletable TGlobal where - delete = xform0 c_tglobal_delete - -instance ITGlobal (Exist TGlobal) where - -instance ITDictionary (Exist TGlobal) where - -instance ITNamed (Exist TGlobal) where - setName (ETGlobal x) = setName x - setNameTitle (ETGlobal x) = setNameTitle x - setTitle (ETGlobal x) = setTitle x -instance ITObject (Exist TGlobal) where - draw (ETGlobal x) = draw x - findObject (ETGlobal x) = findObject x - getName (ETGlobal x) = getName x - isA (ETGlobal x) = isA x - paint (ETGlobal x) = paint x - printObj (ETGlobal x) = printObj x - saveAs (ETGlobal x) = saveAs x - write (ETGlobal x) = write x -instance IDeletable (Exist TGlobal) where - delete (ETGlobal x) = delete x - - - - - + setName = xform1 c_tglobal_setname + setNameTitle = xform2 c_tglobal_setnametitle + setTitle = xform1 c_tglobal_settitle +instance ITObject TGlobal where + draw = xform1 c_tglobal_draw + findObject = xform1 c_tglobal_findobject + getName = xform0 c_tglobal_getname + isA = xform0 c_tglobal_isa + paint = xform1 c_tglobal_paint + printObj = xform1 c_tglobal_printobj + saveAs = xform2 c_tglobal_saveas + write = xform3 c_tglobal_write -instance FPtr (Exist TGlobal) where - type Raw (Exist TGlobal) = RawTGlobal - get_fptr (ETGlobal obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETGlobal (cast_fptr_to_obj (fptr :: ForeignPtr RawTGlobal) :: TGlobal) +instance IDeletable TGlobal where + delete = xform0 c_tglobal_delete diff --git a/src/HROOT/Core/TGlobal/Interface.hs b/src/HROOT/Core/TGlobal/Interface.hs --- a/src/HROOT/Core/TGlobal/Interface.hs +++ b/src/HROOT/Core/TGlobal/Interface.hs @@ -1,36 +1,25 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TGlobal.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TGlobal.RawType - import HROOT.Core.TDictionary.Interface ----- ============ ---- - - -class (ITDictionary a) => ITGlobal a where - -instance Existable TGlobal where - data Exist TGlobal = forall a. (FPtr a, ITGlobal a) => ETGlobal a +class ITDictionary a => ITGlobal a -upcastTGlobal :: (FPtr a, ITGlobal a) => a -> TGlobal -upcastTGlobal h = let fh = get_fptr h - fh2 :: ForeignPtr RawTGlobal = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTGlobal :: forall a . (FPtr a, ITGlobal a) => a -> TGlobal +upcastTGlobal h + = let fh = get_fptr h + fh2 :: Ptr RawTGlobal = castPtr fh + in cast_fptr_to_obj fh2 -downcastTGlobal :: (FPtr a, ITGlobal a) => TGlobal -> a -downcastTGlobal h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTGlobal :: forall a . (FPtr a, ITGlobal a) => TGlobal -> a +downcastTGlobal h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TGlobal/RawType.hs b/src/HROOT/Core/TGlobal/RawType.hs --- a/src/HROOT/Core/TGlobal/RawType.hs +++ b/src/HROOT/Core/TGlobal/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TGlobal.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTGlobal -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TGlobal = TGlobal (Ptr RawTGlobal) + deriving (Eq, Ord, Show) -data RawTGlobal -newtype TGlobal = TGlobal (ForeignPtr RawTGlobal) deriving (Eq, Ord, Show) instance FPtr TGlobal where - type Raw TGlobal = RawTGlobal - get_fptr (TGlobal fptr) = fptr - cast_fptr_to_obj = TGlobal + type Raw TGlobal = RawTGlobal + get_fptr (TGlobal ptr) = ptr + cast_fptr_to_obj = TGlobal diff --git a/src/HROOT/Core/TKey.hs b/src/HROOT/Core/TKey.hs --- a/src/HROOT/Core/TKey.hs +++ b/src/HROOT/Core/TKey.hs @@ -1,15 +1,5 @@ module HROOT.Core.TKey - ( - TKey(..) - , ITKey - , upcastTKey - , downcastTKey - - - ) where - + (TKey(..), ITKey, upcastTKey, downcastTKey, newTKey) where import HROOT.Core.TKey.RawType import HROOT.Core.TKey.Interface import HROOT.Core.TKey.Implementation - - diff --git a/src/HROOT/Core/TKey/Cast.hs b/src/HROOT/Core/TKey/Cast.hs --- a/src/HROOT/Core/TKey/Cast.hs +++ b/src/HROOT/Core/TKey/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TKey.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TKey.RawType import HROOT.Core.TKey.Interface instance (ITKey a, FPtr a) => Castable a (Ptr RawTKey) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TKey (Ptr RawTKey) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TKey/FFI.hsc b/src/HROOT/Core/TKey/FFI.hsc --- a/src/HROOT/Core/TKey/FFI.hsc +++ b/src/HROOT/Core/TKey/FFI.hsc @@ -1,56 +1,50 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TKey.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TKey.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType - -#include "HROOTCoreTKey.h" +import HROOT.Core.TDirectory.RawType -foreign import ccall "HROOTCoreTKey.h TKey_SetName" c_tkey_setname - :: (Ptr RawTKey) -> CString -> IO () +foreign import ccall safe "HROOTCoreTKey.h TKey_SetName" + c_tkey_setname :: Ptr RawTKey -> CString -> IO () -foreign import ccall "HROOTCoreTKey.h TKey_SetNameTitle" c_tkey_setnametitle - :: (Ptr RawTKey) -> CString -> CString -> IO () +foreign import ccall safe "HROOTCoreTKey.h TKey_SetNameTitle" + c_tkey_setnametitle :: Ptr RawTKey -> CString -> CString -> IO () -foreign import ccall "HROOTCoreTKey.h TKey_SetTitle" c_tkey_settitle - :: (Ptr RawTKey) -> CString -> IO () +foreign import ccall safe "HROOTCoreTKey.h TKey_SetTitle" + c_tkey_settitle :: Ptr RawTKey -> CString -> IO () -foreign import ccall "HROOTCoreTKey.h TKey_Draw" c_tkey_draw - :: (Ptr RawTKey) -> CString -> IO () +foreign import ccall safe "HROOTCoreTKey.h TKey_Draw" c_tkey_draw + :: Ptr RawTKey -> CString -> IO () -foreign import ccall "HROOTCoreTKey.h TKey_FindObject" c_tkey_findobject - :: (Ptr RawTKey) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTCoreTKey.h TKey_FindObject" + c_tkey_findobject :: Ptr RawTKey -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTCoreTKey.h TKey_GetName" c_tkey_getname - :: (Ptr RawTKey) -> IO CString +foreign import ccall safe "HROOTCoreTKey.h TKey_GetName" + c_tkey_getname :: Ptr RawTKey -> IO CString -foreign import ccall "HROOTCoreTKey.h TKey_IsA" c_tkey_isa - :: (Ptr RawTKey) -> IO (Ptr RawTClass) +foreign import ccall safe "HROOTCoreTKey.h TKey_IsA" c_tkey_isa :: + Ptr RawTKey -> IO (Ptr RawTClass) -foreign import ccall "HROOTCoreTKey.h TKey_Paint" c_tkey_paint - :: (Ptr RawTKey) -> CString -> IO () +foreign import ccall safe "HROOTCoreTKey.h TKey_Paint" c_tkey_paint + :: Ptr RawTKey -> CString -> IO () -foreign import ccall "HROOTCoreTKey.h TKey_printObj" c_tkey_printobj - :: (Ptr RawTKey) -> CString -> IO () +foreign import ccall safe "HROOTCoreTKey.h TKey_printObj" + c_tkey_printobj :: Ptr RawTKey -> CString -> IO () -foreign import ccall "HROOTCoreTKey.h TKey_SaveAs" c_tkey_saveas - :: (Ptr RawTKey) -> CString -> CString -> IO () +foreign import ccall safe "HROOTCoreTKey.h TKey_SaveAs" + c_tkey_saveas :: Ptr RawTKey -> CString -> CString -> IO () -foreign import ccall "HROOTCoreTKey.h TKey_Write" c_tkey_write - :: (Ptr RawTKey) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTCoreTKey.h TKey_Write" c_tkey_write + :: Ptr RawTKey -> CString -> CInt -> CInt -> IO CInt -foreign import ccall "HROOTCoreTKey.h TKey_delete" c_tkey_delete - :: (Ptr RawTKey) -> IO () +foreign import ccall safe "HROOTCoreTKey.h TKey_delete" + c_tkey_delete :: Ptr RawTKey -> IO () +foreign import ccall safe "HROOTCoreTKey.h TKey_newTKey" + c_tkey_newtkey :: + CString -> + CString -> + Ptr RawTClass -> CInt -> Ptr RawTDirectory -> IO (Ptr RawTKey) diff --git a/src/HROOT/Core/TKey/Implementation.hs b/src/HROOT/Core/TKey/Implementation.hs --- a/src/HROOT/Core/TKey/Implementation.hs +++ b/src/HROOT/Core/TKey/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TKey.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TKey.RawType import HROOT.Core.TKey.FFI import HROOT.Core.TKey.Interface @@ -14,6 +15,9 @@ import HROOT.Core.TClass.RawType import HROOT.Core.TClass.Cast import HROOT.Core.TClass.Interface +import HROOT.Core.TDirectory.RawType +import HROOT.Core.TDirectory.Cast +import HROOT.Core.TDirectory.Interface import HROOT.Core.TNamed.RawType import HROOT.Core.TNamed.Cast import HROOT.Core.TNamed.Interface @@ -24,56 +28,28 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - +instance ITKey TKey -instance ITKey TKey where instance ITNamed TKey where - setName = xform1 c_tkey_setname - setNameTitle = xform2 c_tkey_setnametitle - setTitle = xform1 c_tkey_settitle -instance ITObject TKey where - draw = xform1 c_tkey_draw - findObject = xform1 c_tkey_findobject - getName = xform0 c_tkey_getname - isA = xform0 c_tkey_isa - paint = xform1 c_tkey_paint - printObj = xform1 c_tkey_printobj - saveAs = xform2 c_tkey_saveas - write = xform3 c_tkey_write -instance IDeletable TKey where - delete = xform0 c_tkey_delete - -instance ITKey (Exist TKey) where - -instance ITNamed (Exist TKey) where - setName (ETKey x) = setName x - setNameTitle (ETKey x) = setNameTitle x - setTitle (ETKey x) = setTitle x -instance ITObject (Exist TKey) where - draw (ETKey x) = draw x - findObject (ETKey x) = findObject x - getName (ETKey x) = getName x - isA (ETKey x) = isA x - paint (ETKey x) = paint x - printObj (ETKey x) = printObj x - saveAs (ETKey x) = saveAs x - write (ETKey x) = write x -instance IDeletable (Exist TKey) where - delete (ETKey x) = delete x - - - - + setName = xform1 c_tkey_setname + setNameTitle = xform2 c_tkey_setnametitle + setTitle = xform1 c_tkey_settitle +instance ITObject TKey where + draw = xform1 c_tkey_draw + findObject = xform1 c_tkey_findobject + getName = xform0 c_tkey_getname + isA = xform0 c_tkey_isa + paint = xform1 c_tkey_paint + printObj = xform1 c_tkey_printobj + saveAs = xform2 c_tkey_saveas + write = xform3 c_tkey_write +instance IDeletable TKey where + delete = xform0 c_tkey_delete -instance FPtr (Exist TKey) where - type Raw (Exist TKey) = RawTKey - get_fptr (ETKey obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETKey (cast_fptr_to_obj (fptr :: ForeignPtr RawTKey) :: TKey) +newTKey :: + (ITDirectory c3, FPtr c3, ITClass c2, FPtr c2, Castable c1 CString, + Castable c0 CString) => + c0 -> c1 -> c2 -> CInt -> c3 -> IO TKey +newTKey = xform4 c_tkey_newtkey diff --git a/src/HROOT/Core/TKey/Interface.hs b/src/HROOT/Core/TKey/Interface.hs --- a/src/HROOT/Core/TKey/Interface.hs +++ b/src/HROOT/Core/TKey/Interface.hs @@ -1,36 +1,27 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TKey.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TKey.RawType - import HROOT.Core.TNamed.Interface ----- ============ ---- - - - -class (ITNamed a) => ITKey a where +import {-# SOURCE #-} HROOT.Core.TClass.Interface +import {-# SOURCE #-} HROOT.Core.TDirectory.Interface -instance Existable TKey where - data Exist TKey = forall a. (FPtr a, ITKey a) => ETKey a +class ITNamed a => ITKey a -upcastTKey :: (FPtr a, ITKey a) => a -> TKey -upcastTKey h = let fh = get_fptr h - fh2 :: ForeignPtr RawTKey = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTKey :: forall a . (FPtr a, ITKey a) => a -> TKey +upcastTKey h + = let fh = get_fptr h + fh2 :: Ptr RawTKey = castPtr fh + in cast_fptr_to_obj fh2 -downcastTKey :: (FPtr a, ITKey a) => TKey -> a -downcastTKey h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTKey :: forall a . (FPtr a, ITKey a) => TKey -> a +downcastTKey h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TKey/RawType.hs b/src/HROOT/Core/TKey/RawType.hs --- a/src/HROOT/Core/TKey/RawType.hs +++ b/src/HROOT/Core/TKey/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TKey.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTKey -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TKey = TKey (Ptr RawTKey) + deriving (Eq, Ord, Show) -data RawTKey -newtype TKey = TKey (ForeignPtr RawTKey) deriving (Eq, Ord, Show) instance FPtr TKey where - type Raw TKey = RawTKey - get_fptr (TKey fptr) = fptr - cast_fptr_to_obj = TKey + type Raw TKey = RawTKey + get_fptr (TKey ptr) = ptr + cast_fptr_to_obj = TKey diff --git a/src/HROOT/Core/TNamed.hs b/src/HROOT/Core/TNamed.hs --- a/src/HROOT/Core/TNamed.hs +++ b/src/HROOT/Core/TNamed.hs @@ -1,15 +1,6 @@ module HROOT.Core.TNamed - ( - TNamed(..) - , ITNamed(..) - , upcastTNamed - , downcastTNamed - , newTNamed - - ) where - + (TNamed(..), ITNamed(..), upcastTNamed, downcastTNamed, newTNamed) + where import HROOT.Core.TNamed.RawType import HROOT.Core.TNamed.Interface import HROOT.Core.TNamed.Implementation - - diff --git a/src/HROOT/Core/TNamed/Cast.hs b/src/HROOT/Core/TNamed/Cast.hs --- a/src/HROOT/Core/TNamed/Cast.hs +++ b/src/HROOT/Core/TNamed/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TNamed.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TNamed.RawType import HROOT.Core.TNamed.Interface instance (ITNamed a, FPtr a) => Castable a (Ptr RawTNamed) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TNamed (Ptr RawTNamed) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TNamed/FFI.hsc b/src/HROOT/Core/TNamed/FFI.hsc --- a/src/HROOT/Core/TNamed/FFI.hsc +++ b/src/HROOT/Core/TNamed/FFI.hsc @@ -1,59 +1,49 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TNamed.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TNamed.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTCoreTNamed.h" - -foreign import ccall "HROOTCoreTNamed.h TNamed_Draw" c_tnamed_draw - :: (Ptr RawTNamed) -> CString -> IO () - -foreign import ccall "HROOTCoreTNamed.h TNamed_FindObject" c_tnamed_findobject - :: (Ptr RawTNamed) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTCoreTNamed.h TNamed_Draw" + c_tnamed_draw :: Ptr RawTNamed -> CString -> IO () -foreign import ccall "HROOTCoreTNamed.h TNamed_GetName" c_tnamed_getname - :: (Ptr RawTNamed) -> IO CString +foreign import ccall safe "HROOTCoreTNamed.h TNamed_FindObject" + c_tnamed_findobject :: + Ptr RawTNamed -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTCoreTNamed.h TNamed_IsA" c_tnamed_isa - :: (Ptr RawTNamed) -> IO (Ptr RawTClass) +foreign import ccall safe "HROOTCoreTNamed.h TNamed_GetName" + c_tnamed_getname :: Ptr RawTNamed -> IO CString -foreign import ccall "HROOTCoreTNamed.h TNamed_Paint" c_tnamed_paint - :: (Ptr RawTNamed) -> CString -> IO () +foreign import ccall safe "HROOTCoreTNamed.h TNamed_IsA" + c_tnamed_isa :: Ptr RawTNamed -> IO (Ptr RawTClass) -foreign import ccall "HROOTCoreTNamed.h TNamed_printObj" c_tnamed_printobj - :: (Ptr RawTNamed) -> CString -> IO () +foreign import ccall safe "HROOTCoreTNamed.h TNamed_Paint" + c_tnamed_paint :: Ptr RawTNamed -> CString -> IO () -foreign import ccall "HROOTCoreTNamed.h TNamed_SaveAs" c_tnamed_saveas - :: (Ptr RawTNamed) -> CString -> CString -> IO () +foreign import ccall safe "HROOTCoreTNamed.h TNamed_printObj" + c_tnamed_printobj :: Ptr RawTNamed -> CString -> IO () -foreign import ccall "HROOTCoreTNamed.h TNamed_Write" c_tnamed_write - :: (Ptr RawTNamed) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTCoreTNamed.h TNamed_SaveAs" + c_tnamed_saveas :: Ptr RawTNamed -> CString -> CString -> IO () -foreign import ccall "HROOTCoreTNamed.h TNamed_delete" c_tnamed_delete - :: (Ptr RawTNamed) -> IO () +foreign import ccall safe "HROOTCoreTNamed.h TNamed_Write" + c_tnamed_write :: + Ptr RawTNamed -> CString -> CInt -> CInt -> IO CInt -foreign import ccall "HROOTCoreTNamed.h TNamed_newTNamed" c_tnamed_newtnamed - :: CString -> CString -> IO (Ptr RawTNamed) +foreign import ccall safe "HROOTCoreTNamed.h TNamed_delete" + c_tnamed_delete :: Ptr RawTNamed -> IO () -foreign import ccall "HROOTCoreTNamed.h TNamed_SetName" c_tnamed_setname - :: (Ptr RawTNamed) -> CString -> IO () +foreign import ccall safe "HROOTCoreTNamed.h TNamed_newTNamed" + c_tnamed_newtnamed :: CString -> CString -> IO (Ptr RawTNamed) -foreign import ccall "HROOTCoreTNamed.h TNamed_SetNameTitle" c_tnamed_setnametitle - :: (Ptr RawTNamed) -> CString -> CString -> IO () +foreign import ccall safe "HROOTCoreTNamed.h TNamed_SetName" + c_tnamed_setname :: Ptr RawTNamed -> CString -> IO () -foreign import ccall "HROOTCoreTNamed.h TNamed_SetTitle" c_tnamed_settitle - :: (Ptr RawTNamed) -> CString -> IO () +foreign import ccall safe "HROOTCoreTNamed.h TNamed_SetNameTitle" + c_tnamed_setnametitle :: + Ptr RawTNamed -> CString -> CString -> IO () +foreign import ccall safe "HROOTCoreTNamed.h TNamed_SetTitle" + c_tnamed_settitle :: Ptr RawTNamed -> CString -> IO () diff --git a/src/HROOT/Core/TNamed/Implementation.hs b/src/HROOT/Core/TNamed/Implementation.hs --- a/src/HROOT/Core/TNamed/Implementation.hs +++ b/src/HROOT/Core/TNamed/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TNamed.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TNamed.RawType import HROOT.Core.TNamed.FFI import HROOT.Core.TNamed.Interface @@ -21,59 +22,24 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - - instance ITNamed TNamed where - setName = xform1 c_tnamed_setname - setNameTitle = xform2 c_tnamed_setnametitle - setTitle = xform1 c_tnamed_settitle -instance ITObject TNamed where - draw = xform1 c_tnamed_draw - findObject = xform1 c_tnamed_findobject - getName = xform0 c_tnamed_getname - isA = xform0 c_tnamed_isa - paint = xform1 c_tnamed_paint - printObj = xform1 c_tnamed_printobj - saveAs = xform2 c_tnamed_saveas - write = xform3 c_tnamed_write -instance IDeletable TNamed where - delete = xform0 c_tnamed_delete + setName = xform1 c_tnamed_setname + setNameTitle = xform2 c_tnamed_setnametitle + setTitle = xform1 c_tnamed_settitle -instance ITNamed (Exist TNamed) where - setName (ETNamed x) = setName x - setNameTitle (ETNamed x) = setNameTitle x - setTitle (ETNamed x) = setTitle x -instance ITObject (Exist TNamed) where - draw (ETNamed x) = draw x - findObject (ETNamed x) = findObject x - getName (ETNamed x) = getName x - isA (ETNamed x) = isA x - paint (ETNamed x) = paint x - printObj (ETNamed x) = printObj x - saveAs (ETNamed x) = saveAs x - write (ETNamed x) = write x -instance IDeletable (Exist TNamed) where - delete (ETNamed x) = delete x +instance ITObject TNamed where + draw = xform1 c_tnamed_draw + findObject = xform1 c_tnamed_findobject + getName = xform0 c_tnamed_getname + isA = xform0 c_tnamed_isa + paint = xform1 c_tnamed_paint + printObj = xform1 c_tnamed_printobj + saveAs = xform2 c_tnamed_saveas + write = xform3 c_tnamed_write --- | constructor : --- --- > TNamed( char* name, char* title) --- +instance IDeletable TNamed where + delete = xform0 c_tnamed_delete -newTNamed :: CString -> CString -> IO TNamed +newTNamed :: + (Castable c1 CString, Castable c0 CString) => c0 -> c1 -> IO TNamed newTNamed = xform1 c_tnamed_newtnamed - - - - - -instance FPtr (Exist TNamed) where - type Raw (Exist TNamed) = RawTNamed - get_fptr (ETNamed obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETNamed (cast_fptr_to_obj (fptr :: ForeignPtr RawTNamed) :: TNamed) diff --git a/src/HROOT/Core/TNamed/Interface.hs b/src/HROOT/Core/TNamed/Interface.hs --- a/src/HROOT/Core/TNamed/Interface.hs +++ b/src/HROOT/Core/TNamed/Interface.hs @@ -1,49 +1,32 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TNamed.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TNamed.RawType - import HROOT.Core.TObject.Interface ----- ============ ---- - --- | --- Class TNamed --- reference : http://root.cern.ch - -class (ITObject a) => ITNamed a where - - setName :: a -> CString -> IO () - - setNameTitle :: a -> CString -> CString -> IO () - -- | SetTitle method - -- - -- > SetTitle( char* name, char* title ) - -- - - setTitle :: a -> CString -> IO () - -instance Existable TNamed where - data Exist TNamed = forall a. (FPtr a, ITNamed a) => ETNamed a +class ITObject a => ITNamed a where + setName :: Castable c0 CString => a -> c0 -> IO () + + setNameTitle :: + (Castable c1 CString, Castable c0 CString) => + a -> c0 -> c1 -> IO () + + setTitle :: Castable c0 CString => a -> c0 -> IO () -upcastTNamed :: (FPtr a, ITNamed a) => a -> TNamed -upcastTNamed h = let fh = get_fptr h - fh2 :: ForeignPtr RawTNamed = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTNamed :: forall a . (FPtr a, ITNamed a) => a -> TNamed +upcastTNamed h + = let fh = get_fptr h + fh2 :: Ptr RawTNamed = castPtr fh + in cast_fptr_to_obj fh2 -downcastTNamed :: (FPtr a, ITNamed a) => TNamed -> a -downcastTNamed h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTNamed :: forall a . (FPtr a, ITNamed a) => TNamed -> a +downcastTNamed h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TNamed/RawType.hs b/src/HROOT/Core/TNamed/RawType.hs --- a/src/HROOT/Core/TNamed/RawType.hs +++ b/src/HROOT/Core/TNamed/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TNamed.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTNamed -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TNamed = TNamed (Ptr RawTNamed) + deriving (Eq, Ord, Show) -data RawTNamed -newtype TNamed = TNamed (ForeignPtr RawTNamed) deriving (Eq, Ord, Show) instance FPtr TNamed where - type Raw TNamed = RawTNamed - get_fptr (TNamed fptr) = fptr - cast_fptr_to_obj = TNamed + type Raw TNamed = RawTNamed + get_fptr (TNamed ptr) = ptr + cast_fptr_to_obj = TNamed diff --git a/src/HROOT/Core/TObjArray.hs b/src/HROOT/Core/TObjArray.hs --- a/src/HROOT/Core/TObjArray.hs +++ b/src/HROOT/Core/TObjArray.hs @@ -1,15 +1,6 @@ module HROOT.Core.TObjArray - ( - TObjArray(..) - , ITObjArray - , upcastTObjArray - , downcastTObjArray - - - ) where - + (TObjArray(..), ITObjArray, upcastTObjArray, downcastTObjArray) + where import HROOT.Core.TObjArray.RawType import HROOT.Core.TObjArray.Interface import HROOT.Core.TObjArray.Implementation - - diff --git a/src/HROOT/Core/TObjArray/Cast.hs b/src/HROOT/Core/TObjArray/Cast.hs --- a/src/HROOT/Core/TObjArray/Cast.hs +++ b/src/HROOT/Core/TObjArray/Cast.hs @@ -1,22 +1,18 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TObjArray.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TObjArray.RawType import HROOT.Core.TObjArray.Interface -instance (ITObjArray a, FPtr a) => Castable a (Ptr RawTObjArray) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ +instance (ITObjArray a, FPtr a) => Castable a (Ptr RawTObjArray) + where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TObjArray (Ptr RawTObjArray) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TObjArray/FFI.hsc b/src/HROOT/Core/TObjArray/FFI.hsc --- a/src/HROOT/Core/TObjArray/FFI.hsc +++ b/src/HROOT/Core/TObjArray/FFI.hsc @@ -1,47 +1,37 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TObjArray.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TObjArray.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTCoreTObjArray.h" - -foreign import ccall "HROOTCoreTObjArray.h TObjArray_Draw" c_tobjarray_draw - :: (Ptr RawTObjArray) -> CString -> IO () - -foreign import ccall "HROOTCoreTObjArray.h TObjArray_FindObject" c_tobjarray_findobject - :: (Ptr RawTObjArray) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTCoreTObjArray.h TObjArray_Draw" + c_tobjarray_draw :: Ptr RawTObjArray -> CString -> IO () -foreign import ccall "HROOTCoreTObjArray.h TObjArray_GetName" c_tobjarray_getname - :: (Ptr RawTObjArray) -> IO CString +foreign import ccall safe + "HROOTCoreTObjArray.h TObjArray_FindObject" c_tobjarray_findobject + :: Ptr RawTObjArray -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTCoreTObjArray.h TObjArray_IsA" c_tobjarray_isa - :: (Ptr RawTObjArray) -> IO (Ptr RawTClass) +foreign import ccall safe "HROOTCoreTObjArray.h TObjArray_GetName" + c_tobjarray_getname :: Ptr RawTObjArray -> IO CString -foreign import ccall "HROOTCoreTObjArray.h TObjArray_Paint" c_tobjarray_paint - :: (Ptr RawTObjArray) -> CString -> IO () +foreign import ccall safe "HROOTCoreTObjArray.h TObjArray_IsA" + c_tobjarray_isa :: Ptr RawTObjArray -> IO (Ptr RawTClass) -foreign import ccall "HROOTCoreTObjArray.h TObjArray_printObj" c_tobjarray_printobj - :: (Ptr RawTObjArray) -> CString -> IO () +foreign import ccall safe "HROOTCoreTObjArray.h TObjArray_Paint" + c_tobjarray_paint :: Ptr RawTObjArray -> CString -> IO () -foreign import ccall "HROOTCoreTObjArray.h TObjArray_SaveAs" c_tobjarray_saveas - :: (Ptr RawTObjArray) -> CString -> CString -> IO () +foreign import ccall safe "HROOTCoreTObjArray.h TObjArray_printObj" + c_tobjarray_printobj :: Ptr RawTObjArray -> CString -> IO () -foreign import ccall "HROOTCoreTObjArray.h TObjArray_Write" c_tobjarray_write - :: (Ptr RawTObjArray) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTCoreTObjArray.h TObjArray_SaveAs" + c_tobjarray_saveas :: + Ptr RawTObjArray -> CString -> CString -> IO () -foreign import ccall "HROOTCoreTObjArray.h TObjArray_delete" c_tobjarray_delete - :: (Ptr RawTObjArray) -> IO () +foreign import ccall safe "HROOTCoreTObjArray.h TObjArray_Write" + c_tobjarray_write :: + Ptr RawTObjArray -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTCoreTObjArray.h TObjArray_delete" + c_tobjarray_delete :: Ptr RawTObjArray -> IO () diff --git a/src/HROOT/Core/TObjArray/Implementation.hs b/src/HROOT/Core/TObjArray/Implementation.hs --- a/src/HROOT/Core/TObjArray/Implementation.hs +++ b/src/HROOT/Core/TObjArray/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TObjArray.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TObjArray.RawType import HROOT.Core.TObjArray.FFI import HROOT.Core.TObjArray.Interface @@ -27,54 +28,21 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr +instance ITObjArray TObjArray -import System.IO.Unsafe +instance ITSeqCollection TObjArray +instance ITCollection TObjArray -instance ITObjArray TObjArray where -instance ITSeqCollection TObjArray where -instance ITCollection TObjArray where instance ITObject TObjArray where - draw = xform1 c_tobjarray_draw - findObject = xform1 c_tobjarray_findobject - getName = xform0 c_tobjarray_getname - isA = xform0 c_tobjarray_isa - paint = xform1 c_tobjarray_paint - printObj = xform1 c_tobjarray_printobj - saveAs = xform2 c_tobjarray_saveas - write = xform3 c_tobjarray_write -instance IDeletable TObjArray where - delete = xform0 c_tobjarray_delete - -instance ITObjArray (Exist TObjArray) where - -instance ITSeqCollection (Exist TObjArray) where - -instance ITCollection (Exist TObjArray) where - -instance ITObject (Exist TObjArray) where - draw (ETObjArray x) = draw x - findObject (ETObjArray x) = findObject x - getName (ETObjArray x) = getName x - isA (ETObjArray x) = isA x - paint (ETObjArray x) = paint x - printObj (ETObjArray x) = printObj x - saveAs (ETObjArray x) = saveAs x - write (ETObjArray x) = write x -instance IDeletable (Exist TObjArray) where - delete (ETObjArray x) = delete x - - - - - - + draw = xform1 c_tobjarray_draw + findObject = xform1 c_tobjarray_findobject + getName = xform0 c_tobjarray_getname + isA = xform0 c_tobjarray_isa + paint = xform1 c_tobjarray_paint + printObj = xform1 c_tobjarray_printobj + saveAs = xform2 c_tobjarray_saveas + write = xform3 c_tobjarray_write -instance FPtr (Exist TObjArray) where - type Raw (Exist TObjArray) = RawTObjArray - get_fptr (ETObjArray obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETObjArray (cast_fptr_to_obj (fptr :: ForeignPtr RawTObjArray) :: TObjArray) +instance IDeletable TObjArray where + delete = xform0 c_tobjarray_delete diff --git a/src/HROOT/Core/TObjArray/Interface.hs b/src/HROOT/Core/TObjArray/Interface.hs --- a/src/HROOT/Core/TObjArray/Interface.hs +++ b/src/HROOT/Core/TObjArray/Interface.hs @@ -1,36 +1,27 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TObjArray.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TObjArray.RawType - import HROOT.Core.TSeqCollection.Interface ----- ============ ---- - - -class (ITSeqCollection a) => ITObjArray a where - -instance Existable TObjArray where - data Exist TObjArray = forall a. (FPtr a, ITObjArray a) => ETObjArray a +class ITSeqCollection a => ITObjArray a -upcastTObjArray :: (FPtr a, ITObjArray a) => a -> TObjArray -upcastTObjArray h = let fh = get_fptr h - fh2 :: ForeignPtr RawTObjArray = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTObjArray :: + forall a . (FPtr a, ITObjArray a) => a -> TObjArray +upcastTObjArray h + = let fh = get_fptr h + fh2 :: Ptr RawTObjArray = castPtr fh + in cast_fptr_to_obj fh2 -downcastTObjArray :: (FPtr a, ITObjArray a) => TObjArray -> a -downcastTObjArray h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTObjArray :: + forall a . (FPtr a, ITObjArray a) => TObjArray -> a +downcastTObjArray h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TObjArray/RawType.hs b/src/HROOT/Core/TObjArray/RawType.hs --- a/src/HROOT/Core/TObjArray/RawType.hs +++ b/src/HROOT/Core/TObjArray/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TObjArray.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTObjArray -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TObjArray = TObjArray (Ptr RawTObjArray) + deriving (Eq, Ord, Show) -data RawTObjArray -newtype TObjArray = TObjArray (ForeignPtr RawTObjArray) deriving (Eq, Ord, Show) instance FPtr TObjArray where - type Raw TObjArray = RawTObjArray - get_fptr (TObjArray fptr) = fptr - cast_fptr_to_obj = TObjArray + type Raw TObjArray = RawTObjArray + get_fptr (TObjArray ptr) = ptr + cast_fptr_to_obj = TObjArray diff --git a/src/HROOT/Core/TObject.hs b/src/HROOT/Core/TObject.hs --- a/src/HROOT/Core/TObject.hs +++ b/src/HROOT/Core/TObject.hs @@ -1,15 +1,7 @@ module HROOT.Core.TObject - ( - TObject(..) - , ITObject(..) - , upcastTObject - , downcastTObject - , newTObject - , tObjectGetObjectStat - ) where - + (TObject(..), ITObject(..), upcastTObject, downcastTObject, + newTObject, tObjectGetObjectStat) + where import HROOT.Core.TObject.RawType import HROOT.Core.TObject.Interface import HROOT.Core.TObject.Implementation - - diff --git a/src/HROOT/Core/TObject/Cast.hs b/src/HROOT/Core/TObject/Cast.hs --- a/src/HROOT/Core/TObject/Cast.hs +++ b/src/HROOT/Core/TObject/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TObject.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TObject.RawType import HROOT.Core.TObject.Interface instance (ITObject a, FPtr a) => Castable a (Ptr RawTObject) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TObject (Ptr RawTObject) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TObject/FFI.hsc b/src/HROOT/Core/TObject/FFI.hsc --- a/src/HROOT/Core/TObject/FFI.hsc +++ b/src/HROOT/Core/TObject/FFI.hsc @@ -1,52 +1,42 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TObject.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTCoreTObject.h" - -foreign import ccall "HROOTCoreTObject.h TObject_delete" c_tobject_delete - :: (Ptr RawTObject) -> IO () - -foreign import ccall "HROOTCoreTObject.h TObject_newTObject" c_tobject_newtobject - :: IO (Ptr RawTObject) +foreign import ccall safe "HROOTCoreTObject.h TObject_delete" + c_tobject_delete :: Ptr RawTObject -> IO () -foreign import ccall "HROOTCoreTObject.h TObject_Draw" c_tobject_draw - :: (Ptr RawTObject) -> CString -> IO () +foreign import ccall safe "HROOTCoreTObject.h TObject_newTObject" + c_tobject_newtobject :: IO (Ptr RawTObject) -foreign import ccall "HROOTCoreTObject.h TObject_FindObject" c_tobject_findobject - :: (Ptr RawTObject) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTCoreTObject.h TObject_Draw" + c_tobject_draw :: Ptr RawTObject -> CString -> IO () -foreign import ccall "HROOTCoreTObject.h TObject_GetName" c_tobject_getname - :: (Ptr RawTObject) -> IO CString +foreign import ccall safe "HROOTCoreTObject.h TObject_FindObject" + c_tobject_findobject :: + Ptr RawTObject -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTCoreTObject.h TObject_IsA" c_tobject_isa - :: (Ptr RawTObject) -> IO (Ptr RawTClass) +foreign import ccall safe "HROOTCoreTObject.h TObject_GetName" + c_tobject_getname :: Ptr RawTObject -> IO CString -foreign import ccall "HROOTCoreTObject.h TObject_Paint" c_tobject_paint - :: (Ptr RawTObject) -> CString -> IO () +foreign import ccall safe "HROOTCoreTObject.h TObject_IsA" + c_tobject_isa :: Ptr RawTObject -> IO (Ptr RawTClass) -foreign import ccall "HROOTCoreTObject.h TObject_printObj" c_tobject_printobj - :: (Ptr RawTObject) -> CString -> IO () +foreign import ccall safe "HROOTCoreTObject.h TObject_Paint" + c_tobject_paint :: Ptr RawTObject -> CString -> IO () -foreign import ccall "HROOTCoreTObject.h TObject_SaveAs" c_tobject_saveas - :: (Ptr RawTObject) -> CString -> CString -> IO () +foreign import ccall safe "HROOTCoreTObject.h TObject_printObj" + c_tobject_printobj :: Ptr RawTObject -> CString -> IO () -foreign import ccall "HROOTCoreTObject.h TObject_Write" c_tobject_write - :: (Ptr RawTObject) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTCoreTObject.h TObject_SaveAs" + c_tobject_saveas :: Ptr RawTObject -> CString -> CString -> IO () -foreign import ccall "HROOTCoreTObject.h TObject_tObjectGetObjectStat" c_tobject_tobjectgetobjectstat - :: IO CInt +foreign import ccall safe "HROOTCoreTObject.h TObject_Write" + c_tobject_write :: + Ptr RawTObject -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe + "HROOTCoreTObject.h TObject_tObjectGetObjectStat" + c_tobject_tobjectgetobjectstat :: IO CInt diff --git a/src/HROOT/Core/TObject/Implementation.hs b/src/HROOT/Core/TObject/Implementation.hs --- a/src/HROOT/Core/TObject/Implementation.hs +++ b/src/HROOT/Core/TObject/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TObject.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TObject.RawType import HROOT.Core.TObject.FFI import HROOT.Core.TObject.Interface @@ -18,48 +19,21 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - - instance ITObject TObject where - draw = xform1 c_tobject_draw - findObject = xform1 c_tobject_findobject - getName = xform0 c_tobject_getname - isA = xform0 c_tobject_isa - paint = xform1 c_tobject_paint - printObj = xform1 c_tobject_printobj - saveAs = xform2 c_tobject_saveas - write = xform3 c_tobject_write -instance IDeletable TObject where - delete = xform0 c_tobject_delete - -instance ITObject (Exist TObject) where - draw (ETObject x) = draw x - findObject (ETObject x) = findObject x - getName (ETObject x) = getName x - isA (ETObject x) = isA x - paint (ETObject x) = paint x - printObj (ETObject x) = printObj x - saveAs (ETObject x) = saveAs x - write (ETObject x) = write x -instance IDeletable (Exist TObject) where - delete (ETObject x) = delete x + draw = xform1 c_tobject_draw + findObject = xform1 c_tobject_findobject + getName = xform0 c_tobject_getname + isA = xform0 c_tobject_isa + paint = xform1 c_tobject_paint + printObj = xform1 c_tobject_printobj + saveAs = xform2 c_tobject_saveas + write = xform3 c_tobject_write +instance IDeletable TObject where + delete = xform0 c_tobject_delete newTObject :: IO TObject newTObject = xformnull c_tobject_newtobject - - tObjectGetObjectStat :: IO CInt tObjectGetObjectStat = xformnull c_tobject_tobjectgetobjectstat - -instance FPtr (Exist TObject) where - type Raw (Exist TObject) = RawTObject - get_fptr (ETObject obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETObject (cast_fptr_to_obj (fptr :: ForeignPtr RawTObject) :: TObject) diff --git a/src/HROOT/Core/TObject/Interface.hs b/src/HROOT/Core/TObject/Interface.hs --- a/src/HROOT/Core/TObject/Interface.hs +++ b/src/HROOT/Core/TObject/Interface.hs @@ -1,61 +1,43 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TObject.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType import HROOT.Core.Deletable.Interface ----- ============ ---- - - -class (IDeletable a) => ITObject a where - -- | - -- > void TObject::Draw( char* option ) - -- - - draw :: a -> CString -> IO () - -- | - -- > TObject* TObject::FindObject( char* name ) - -- - - findObject :: a -> CString -> IO TObject - -- | - -- > char* TObject::GetName() - -- - - getName :: a -> IO CString - - isA :: a -> IO TClass - - paint :: a -> CString -> IO () - - printObj :: a -> CString -> IO () - - saveAs :: a -> CString -> CString -> IO () - - write :: a -> CString -> CInt -> CInt -> IO CInt - -instance Existable TObject where - data Exist TObject = forall a. (FPtr a, ITObject a) => ETObject a +class IDeletable a => ITObject a where + draw :: Castable c0 CString => a -> c0 -> IO () + + findObject :: Castable c0 CString => a -> c0 -> IO TObject + + getName :: a -> IO CString + + isA :: a -> IO TClass + + paint :: Castable c0 CString => a -> c0 -> IO () + + printObj :: Castable c0 CString => a -> c0 -> IO () + + saveAs :: + (Castable c1 CString, Castable c0 CString) => + a -> c0 -> c1 -> IO () + + write :: Castable c0 CString => a -> c0 -> CInt -> CInt -> IO CInt -upcastTObject :: (FPtr a, ITObject a) => a -> TObject -upcastTObject h = let fh = get_fptr h - fh2 :: ForeignPtr RawTObject = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTObject :: forall a . (FPtr a, ITObject a) => a -> TObject +upcastTObject h + = let fh = get_fptr h + fh2 :: Ptr RawTObject = castPtr fh + in cast_fptr_to_obj fh2 -downcastTObject :: (FPtr a, ITObject a) => TObject -> a -downcastTObject h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTObject :: forall a . (FPtr a, ITObject a) => TObject -> a +downcastTObject h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TObject/RawType.hs b/src/HROOT/Core/TObject/RawType.hs --- a/src/HROOT/Core/TObject/RawType.hs +++ b/src/HROOT/Core/TObject/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TObject.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTObject -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TObject = TObject (Ptr RawTObject) + deriving (Eq, Ord, Show) -data RawTObject -newtype TObject = TObject (ForeignPtr RawTObject) deriving (Eq, Ord, Show) instance FPtr TObject where - type Raw TObject = RawTObject - get_fptr (TObject fptr) = fptr - cast_fptr_to_obj = TObject + type Raw TObject = RawTObject + get_fptr (TObject ptr) = ptr + cast_fptr_to_obj = TObject diff --git a/src/HROOT/Core/TQObject.hs b/src/HROOT/Core/TQObject.hs --- a/src/HROOT/Core/TQObject.hs +++ b/src/HROOT/Core/TQObject.hs @@ -1,15 +1,5 @@ module HROOT.Core.TQObject - ( - TQObject(..) - , ITQObject - , upcastTQObject - , downcastTQObject - - - ) where - + (TQObject(..), ITQObject, upcastTQObject, downcastTQObject) where import HROOT.Core.TQObject.RawType import HROOT.Core.TQObject.Interface import HROOT.Core.TQObject.Implementation - - diff --git a/src/HROOT/Core/TQObject/Cast.hs b/src/HROOT/Core/TQObject/Cast.hs --- a/src/HROOT/Core/TQObject/Cast.hs +++ b/src/HROOT/Core/TQObject/Cast.hs @@ -1,22 +1,18 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TQObject.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TQObject.RawType import HROOT.Core.TQObject.Interface -instance (ITQObject a, FPtr a) => Castable a (Ptr RawTQObject) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ +instance (ITQObject a, FPtr a) => Castable a (Ptr RawTQObject) + where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TQObject (Ptr RawTQObject) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TQObject/FFI.hsc b/src/HROOT/Core/TQObject/FFI.hsc --- a/src/HROOT/Core/TQObject/FFI.hsc +++ b/src/HROOT/Core/TQObject/FFI.hsc @@ -1,22 +1,8 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TQObject.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TQObject.RawType - -#include "HROOTCoreTQObject.h" - -foreign import ccall "HROOTCoreTQObject.h TQObject_delete" c_tqobject_delete - :: (Ptr RawTQObject) -> IO () - +foreign import ccall safe "HROOTCoreTQObject.h TQObject_delete" + c_tqobject_delete :: Ptr RawTQObject -> IO () diff --git a/src/HROOT/Core/TQObject/Implementation.hs b/src/HROOT/Core/TQObject/Implementation.hs --- a/src/HROOT/Core/TQObject/Implementation.hs +++ b/src/HROOT/Core/TQObject/Implementation.hs @@ -1,45 +1,22 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TQObject.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TQObject.RawType import HROOT.Core.TQObject.FFI import HROOT.Core.TQObject.Interface import HROOT.Core.TQObject.Cast - import HROOT.Core.Deletable.RawType import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - +instance ITQObject TQObject -instance ITQObject TQObject where instance IDeletable TQObject where - delete = xform0 c_tqobject_delete - -instance ITQObject (Exist TQObject) where - -instance IDeletable (Exist TQObject) where - delete (ETQObject x) = delete x - - - - - - - -instance FPtr (Exist TQObject) where - type Raw (Exist TQObject) = RawTQObject - get_fptr (ETQObject obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETQObject (cast_fptr_to_obj (fptr :: ForeignPtr RawTQObject) :: TQObject) + delete = xform0 c_tqobject_delete diff --git a/src/HROOT/Core/TQObject/Interface.hs b/src/HROOT/Core/TQObject/Interface.hs --- a/src/HROOT/Core/TQObject/Interface.hs +++ b/src/HROOT/Core/TQObject/Interface.hs @@ -1,36 +1,26 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TQObject.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TQObject.RawType - import HROOT.Core.Deletable.Interface ----- ============ ---- - - -class (IDeletable a) => ITQObject a where - -instance Existable TQObject where - data Exist TQObject = forall a. (FPtr a, ITQObject a) => ETQObject a +class IDeletable a => ITQObject a -upcastTQObject :: (FPtr a, ITQObject a) => a -> TQObject -upcastTQObject h = let fh = get_fptr h - fh2 :: ForeignPtr RawTQObject = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTQObject :: forall a . (FPtr a, ITQObject a) => a -> TQObject +upcastTQObject h + = let fh = get_fptr h + fh2 :: Ptr RawTQObject = castPtr fh + in cast_fptr_to_obj fh2 -downcastTQObject :: (FPtr a, ITQObject a) => TQObject -> a -downcastTQObject h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTQObject :: + forall a . (FPtr a, ITQObject a) => TQObject -> a +downcastTQObject h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TQObject/RawType.hs b/src/HROOT/Core/TQObject/RawType.hs --- a/src/HROOT/Core/TQObject/RawType.hs +++ b/src/HROOT/Core/TQObject/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TQObject.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTQObject -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TQObject = TQObject (Ptr RawTQObject) + deriving (Eq, Ord, Show) -data RawTQObject -newtype TQObject = TQObject (ForeignPtr RawTQObject) deriving (Eq, Ord, Show) instance FPtr TQObject where - type Raw TQObject = RawTQObject - get_fptr (TQObject fptr) = fptr - cast_fptr_to_obj = TQObject + type Raw TQObject = RawTQObject + get_fptr (TQObject ptr) = ptr + cast_fptr_to_obj = TQObject diff --git a/src/HROOT/Core/TROOT.hs b/src/HROOT/Core/TROOT.hs --- a/src/HROOT/Core/TROOT.hs +++ b/src/HROOT/Core/TROOT.hs @@ -1,15 +1,7 @@ module HROOT.Core.TROOT - ( - TROOT(..) - , ITROOT - , upcastTROOT - , downcastTROOT - , tROOTGetGlobal - , tROOTInitialized - ) where - + (TROOT(..), ITROOT, upcastTROOT, downcastTROOT, tROOTGetGlobal, + tROOTInitialized) + where import HROOT.Core.TROOT.RawType import HROOT.Core.TROOT.Interface import HROOT.Core.TROOT.Implementation - - diff --git a/src/HROOT/Core/TROOT/Cast.hs b/src/HROOT/Core/TROOT/Cast.hs --- a/src/HROOT/Core/TROOT/Cast.hs +++ b/src/HROOT/Core/TROOT/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TROOT.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TROOT.RawType import HROOT.Core.TROOT.Interface instance (ITROOT a, FPtr a) => Castable a (Ptr RawTROOT) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TROOT (Ptr RawTROOT) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TROOT/FFI.hsc b/src/HROOT/Core/TROOT/FFI.hsc --- a/src/HROOT/Core/TROOT/FFI.hsc +++ b/src/HROOT/Core/TROOT/FFI.hsc @@ -1,82 +1,71 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TROOT.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TROOT.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TKey.RawType import HROOT.Core.TClass.RawType import HROOT.Core.TGlobal.RawType -#include "HROOTCoreTROOT.h" - -foreign import ccall "HROOTCoreTROOT.h TROOT_Append" c_troot_append - :: (Ptr RawTROOT) -> (Ptr RawTObject) -> CInt -> IO () - -foreign import ccall "HROOTCoreTROOT.h TROOT_addD" c_troot_addd - :: (Ptr RawTROOT) -> (Ptr RawTObject) -> CInt -> IO () +foreign import ccall safe "HROOTCoreTROOT.h TROOT_Append" + c_troot_append :: Ptr RawTROOT -> Ptr RawTObject -> CInt -> IO () -foreign import ccall "HROOTCoreTROOT.h TROOT_AppendKey" c_troot_appendkey - :: (Ptr RawTROOT) -> (Ptr RawTKey) -> IO CInt +foreign import ccall safe "HROOTCoreTROOT.h TROOT_addD" + c_troot_addd :: Ptr RawTROOT -> Ptr RawTObject -> CInt -> IO () -foreign import ccall "HROOTCoreTROOT.h TROOT_Close" c_troot_close - :: (Ptr RawTROOT) -> CString -> IO () +foreign import ccall safe "HROOTCoreTROOT.h TROOT_AppendKey" + c_troot_appendkey :: Ptr RawTROOT -> Ptr RawTKey -> IO CInt -foreign import ccall "HROOTCoreTROOT.h TROOT_Get" c_troot_get - :: (Ptr RawTROOT) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTCoreTROOT.h TROOT_Close" + c_troot_close :: Ptr RawTROOT -> CString -> IO () -foreign import ccall "HROOTCoreTROOT.h TROOT_cd_TDirectory" c_troot_cd_tdirectory - :: (Ptr RawTROOT) -> CString -> IO CInt +foreign import ccall safe "HROOTCoreTROOT.h TROOT_Get" c_troot_get + :: Ptr RawTROOT -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTCoreTROOT.h TROOT_SetName" c_troot_setname - :: (Ptr RawTROOT) -> CString -> IO () +foreign import ccall safe "HROOTCoreTROOT.h TROOT_cd_TDirectory" + c_troot_cd_tdirectory :: Ptr RawTROOT -> CString -> IO CInt -foreign import ccall "HROOTCoreTROOT.h TROOT_SetNameTitle" c_troot_setnametitle - :: (Ptr RawTROOT) -> CString -> CString -> IO () +foreign import ccall safe "HROOTCoreTROOT.h TROOT_SetName" + c_troot_setname :: Ptr RawTROOT -> CString -> IO () -foreign import ccall "HROOTCoreTROOT.h TROOT_SetTitle" c_troot_settitle - :: (Ptr RawTROOT) -> CString -> IO () +foreign import ccall safe "HROOTCoreTROOT.h TROOT_SetNameTitle" + c_troot_setnametitle :: Ptr RawTROOT -> CString -> CString -> IO () -foreign import ccall "HROOTCoreTROOT.h TROOT_Draw" c_troot_draw - :: (Ptr RawTROOT) -> CString -> IO () +foreign import ccall safe "HROOTCoreTROOT.h TROOT_SetTitle" + c_troot_settitle :: Ptr RawTROOT -> CString -> IO () -foreign import ccall "HROOTCoreTROOT.h TROOT_FindObject" c_troot_findobject - :: (Ptr RawTROOT) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTCoreTROOT.h TROOT_Draw" + c_troot_draw :: Ptr RawTROOT -> CString -> IO () -foreign import ccall "HROOTCoreTROOT.h TROOT_GetName" c_troot_getname - :: (Ptr RawTROOT) -> IO CString +foreign import ccall safe "HROOTCoreTROOT.h TROOT_FindObject" + c_troot_findobject :: + Ptr RawTROOT -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTCoreTROOT.h TROOT_IsA" c_troot_isa - :: (Ptr RawTROOT) -> IO (Ptr RawTClass) +foreign import ccall safe "HROOTCoreTROOT.h TROOT_GetName" + c_troot_getname :: Ptr RawTROOT -> IO CString -foreign import ccall "HROOTCoreTROOT.h TROOT_Paint" c_troot_paint - :: (Ptr RawTROOT) -> CString -> IO () +foreign import ccall safe "HROOTCoreTROOT.h TROOT_IsA" c_troot_isa + :: Ptr RawTROOT -> IO (Ptr RawTClass) -foreign import ccall "HROOTCoreTROOT.h TROOT_printObj" c_troot_printobj - :: (Ptr RawTROOT) -> CString -> IO () +foreign import ccall safe "HROOTCoreTROOT.h TROOT_Paint" + c_troot_paint :: Ptr RawTROOT -> CString -> IO () -foreign import ccall "HROOTCoreTROOT.h TROOT_SaveAs" c_troot_saveas - :: (Ptr RawTROOT) -> CString -> CString -> IO () +foreign import ccall safe "HROOTCoreTROOT.h TROOT_printObj" + c_troot_printobj :: Ptr RawTROOT -> CString -> IO () -foreign import ccall "HROOTCoreTROOT.h TROOT_Write" c_troot_write - :: (Ptr RawTROOT) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTCoreTROOT.h TROOT_SaveAs" + c_troot_saveas :: Ptr RawTROOT -> CString -> CString -> IO () -foreign import ccall "HROOTCoreTROOT.h TROOT_delete" c_troot_delete - :: (Ptr RawTROOT) -> IO () +foreign import ccall safe "HROOTCoreTROOT.h TROOT_Write" + c_troot_write :: Ptr RawTROOT -> CString -> CInt -> CInt -> IO CInt -foreign import ccall "HROOTCoreTROOT.h TROOT_tROOTGetGlobal" c_troot_trootgetglobal - :: (Ptr RawTROOT) -> CString -> CInt -> IO (Ptr RawTGlobal) +foreign import ccall safe "HROOTCoreTROOT.h TROOT_delete" + c_troot_delete :: Ptr RawTROOT -> IO () -foreign import ccall "HROOTCoreTROOT.h TROOT_tROOTInitialized" c_troot_trootinitialized - :: IO CInt +foreign import ccall safe "HROOTCoreTROOT.h TROOT_tROOTGetGlobal" + c_troot_trootgetglobal :: + Ptr RawTROOT -> CString -> CInt -> IO (Ptr RawTGlobal) +foreign import ccall safe "HROOTCoreTROOT.h TROOT_tROOTInitialized" + c_troot_trootinitialized :: IO CInt diff --git a/src/HROOT/Core/TROOT/Implementation.hs b/src/HROOT/Core/TROOT/Implementation.hs --- a/src/HROOT/Core/TROOT/Implementation.hs +++ b/src/HROOT/Core/TROOT/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TROOT.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TROOT.RawType import HROOT.Core.TROOT.FFI import HROOT.Core.TROOT.Interface @@ -33,72 +34,37 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - +instance ITROOT TROOT -instance ITROOT TROOT where instance ITDirectory TROOT where - append = xform2 c_troot_append - addD = xform2 c_troot_addd - appendKey = xform1 c_troot_appendkey - close = xform1 c_troot_close - get = xform1 c_troot_get - cd_TDirectory = xform1 c_troot_cd_tdirectory -instance ITNamed TROOT where - setName = xform1 c_troot_setname - setNameTitle = xform2 c_troot_setnametitle - setTitle = xform1 c_troot_settitle -instance ITObject TROOT where - draw = xform1 c_troot_draw - findObject = xform1 c_troot_findobject - getName = xform0 c_troot_getname - isA = xform0 c_troot_isa - paint = xform1 c_troot_paint - printObj = xform1 c_troot_printobj - saveAs = xform2 c_troot_saveas - write = xform3 c_troot_write -instance IDeletable TROOT where - delete = xform0 c_troot_delete - -instance ITROOT (Exist TROOT) where + append = xform2 c_troot_append + addD = xform2 c_troot_addd + appendKey = xform1 c_troot_appendkey + close = xform1 c_troot_close + get = xform1 c_troot_get + cd_TDirectory = xform1 c_troot_cd_tdirectory -instance ITDirectory (Exist TROOT) where - append (ETROOT x) = append x - addD (ETROOT x) = addD x - appendKey (ETROOT x) = appendKey x - close (ETROOT x) = close x - get (ETROOT x) = get x - cd_TDirectory (ETROOT x) = cd_TDirectory x -instance ITNamed (Exist TROOT) where - setName (ETROOT x) = setName x - setNameTitle (ETROOT x) = setNameTitle x - setTitle (ETROOT x) = setTitle x -instance ITObject (Exist TROOT) where - draw (ETROOT x) = draw x - findObject (ETROOT x) = findObject x - getName (ETROOT x) = getName x - isA (ETROOT x) = isA x - paint (ETROOT x) = paint x - printObj (ETROOT x) = printObj x - saveAs (ETROOT x) = saveAs x - write (ETROOT x) = write x -instance IDeletable (Exist TROOT) where - delete (ETROOT x) = delete x +instance ITNamed TROOT where + setName = xform1 c_troot_setname + setNameTitle = xform2 c_troot_setnametitle + setTitle = xform1 c_troot_settitle +instance ITObject TROOT where + draw = xform1 c_troot_draw + findObject = xform1 c_troot_findobject + getName = xform0 c_troot_getname + isA = xform0 c_troot_isa + paint = xform1 c_troot_paint + printObj = xform1 c_troot_printobj + saveAs = xform2 c_troot_saveas + write = xform3 c_troot_write +instance IDeletable TROOT where + delete = xform0 c_troot_delete -tROOTGetGlobal :: TROOT -> CString -> CInt -> IO TGlobal +tROOTGetGlobal :: + Castable c0 CString => TROOT -> c0 -> CInt -> IO TGlobal tROOTGetGlobal = xform2 c_troot_trootgetglobal tROOTInitialized :: IO CInt tROOTInitialized = xformnull c_troot_trootinitialized - -instance FPtr (Exist TROOT) where - type Raw (Exist TROOT) = RawTROOT - get_fptr (ETROOT obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETROOT (cast_fptr_to_obj (fptr :: ForeignPtr RawTROOT) :: TROOT) diff --git a/src/HROOT/Core/TROOT/Interface.hs b/src/HROOT/Core/TROOT/Interface.hs --- a/src/HROOT/Core/TROOT/Interface.hs +++ b/src/HROOT/Core/TROOT/Interface.hs @@ -1,36 +1,26 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TROOT.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TROOT.RawType import HROOT.Core.TGlobal.RawType import HROOT.Core.TDirectory.Interface ----- ============ ---- - - -class (ITDirectory a) => ITROOT a where - -instance Existable TROOT where - data Exist TROOT = forall a. (FPtr a, ITROOT a) => ETROOT a +class ITDirectory a => ITROOT a -upcastTROOT :: (FPtr a, ITROOT a) => a -> TROOT -upcastTROOT h = let fh = get_fptr h - fh2 :: ForeignPtr RawTROOT = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTROOT :: forall a . (FPtr a, ITROOT a) => a -> TROOT +upcastTROOT h + = let fh = get_fptr h + fh2 :: Ptr RawTROOT = castPtr fh + in cast_fptr_to_obj fh2 -downcastTROOT :: (FPtr a, ITROOT a) => TROOT -> a -downcastTROOT h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTROOT :: forall a . (FPtr a, ITROOT a) => TROOT -> a +downcastTROOT h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TROOT/RawType.hs b/src/HROOT/Core/TROOT/RawType.hs --- a/src/HROOT/Core/TROOT/RawType.hs +++ b/src/HROOT/Core/TROOT/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TROOT.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTROOT -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TROOT = TROOT (Ptr RawTROOT) + deriving (Eq, Ord, Show) -data RawTROOT -newtype TROOT = TROOT (ForeignPtr RawTROOT) deriving (Eq, Ord, Show) instance FPtr TROOT where - type Raw TROOT = RawTROOT - get_fptr (TROOT fptr) = fptr - cast_fptr_to_obj = TROOT + type Raw TROOT = RawTROOT + get_fptr (TROOT ptr) = ptr + cast_fptr_to_obj = TROOT diff --git a/src/HROOT/Core/TSeqCollection.hs b/src/HROOT/Core/TSeqCollection.hs --- a/src/HROOT/Core/TSeqCollection.hs +++ b/src/HROOT/Core/TSeqCollection.hs @@ -1,15 +1,7 @@ module HROOT.Core.TSeqCollection - ( - TSeqCollection(..) - , ITSeqCollection - , upcastTSeqCollection - , downcastTSeqCollection - - - ) where - + (TSeqCollection(..), ITSeqCollection, upcastTSeqCollection, + downcastTSeqCollection) + where import HROOT.Core.TSeqCollection.RawType import HROOT.Core.TSeqCollection.Interface import HROOT.Core.TSeqCollection.Implementation - - diff --git a/src/HROOT/Core/TSeqCollection/Cast.hs b/src/HROOT/Core/TSeqCollection/Cast.hs --- a/src/HROOT/Core/TSeqCollection/Cast.hs +++ b/src/HROOT/Core/TSeqCollection/Cast.hs @@ -1,22 +1,18 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TSeqCollection.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TSeqCollection.RawType import HROOT.Core.TSeqCollection.Interface -instance (ITSeqCollection a, FPtr a) => Castable a (Ptr RawTSeqCollection) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ +instance (ITSeqCollection a, FPtr a) => Castable a + (Ptr RawTSeqCollection) where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TSeqCollection (Ptr RawTSeqCollection) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TSeqCollection/FFI.hsc b/src/HROOT/Core/TSeqCollection/FFI.hsc --- a/src/HROOT/Core/TSeqCollection/FFI.hsc +++ b/src/HROOT/Core/TSeqCollection/FFI.hsc @@ -1,47 +1,47 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TSeqCollection.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TSeqCollection.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTCoreTSeqCollection.h" - -foreign import ccall "HROOTCoreTSeqCollection.h TSeqCollection_Draw" c_tseqcollection_draw - :: (Ptr RawTSeqCollection) -> CString -> IO () - -foreign import ccall "HROOTCoreTSeqCollection.h TSeqCollection_FindObject" c_tseqcollection_findobject - :: (Ptr RawTSeqCollection) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe + "HROOTCoreTSeqCollection.h TSeqCollection_Draw" + c_tseqcollection_draw :: Ptr RawTSeqCollection -> CString -> IO () -foreign import ccall "HROOTCoreTSeqCollection.h TSeqCollection_GetName" c_tseqcollection_getname - :: (Ptr RawTSeqCollection) -> IO CString +foreign import ccall safe + "HROOTCoreTSeqCollection.h TSeqCollection_FindObject" + c_tseqcollection_findobject :: + Ptr RawTSeqCollection -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTCoreTSeqCollection.h TSeqCollection_IsA" c_tseqcollection_isa - :: (Ptr RawTSeqCollection) -> IO (Ptr RawTClass) +foreign import ccall safe + "HROOTCoreTSeqCollection.h TSeqCollection_GetName" + c_tseqcollection_getname :: Ptr RawTSeqCollection -> IO CString -foreign import ccall "HROOTCoreTSeqCollection.h TSeqCollection_Paint" c_tseqcollection_paint - :: (Ptr RawTSeqCollection) -> CString -> IO () +foreign import ccall safe + "HROOTCoreTSeqCollection.h TSeqCollection_IsA" c_tseqcollection_isa + :: Ptr RawTSeqCollection -> IO (Ptr RawTClass) -foreign import ccall "HROOTCoreTSeqCollection.h TSeqCollection_printObj" c_tseqcollection_printobj - :: (Ptr RawTSeqCollection) -> CString -> IO () +foreign import ccall safe + "HROOTCoreTSeqCollection.h TSeqCollection_Paint" + c_tseqcollection_paint :: Ptr RawTSeqCollection -> CString -> IO () -foreign import ccall "HROOTCoreTSeqCollection.h TSeqCollection_SaveAs" c_tseqcollection_saveas - :: (Ptr RawTSeqCollection) -> CString -> CString -> IO () +foreign import ccall safe + "HROOTCoreTSeqCollection.h TSeqCollection_printObj" + c_tseqcollection_printobj :: + Ptr RawTSeqCollection -> CString -> IO () -foreign import ccall "HROOTCoreTSeqCollection.h TSeqCollection_Write" c_tseqcollection_write - :: (Ptr RawTSeqCollection) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe + "HROOTCoreTSeqCollection.h TSeqCollection_SaveAs" + c_tseqcollection_saveas :: + Ptr RawTSeqCollection -> CString -> CString -> IO () -foreign import ccall "HROOTCoreTSeqCollection.h TSeqCollection_delete" c_tseqcollection_delete - :: (Ptr RawTSeqCollection) -> IO () +foreign import ccall safe + "HROOTCoreTSeqCollection.h TSeqCollection_Write" + c_tseqcollection_write :: + Ptr RawTSeqCollection -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe + "HROOTCoreTSeqCollection.h TSeqCollection_delete" + c_tseqcollection_delete :: Ptr RawTSeqCollection -> IO () diff --git a/src/HROOT/Core/TSeqCollection/Implementation.hs b/src/HROOT/Core/TSeqCollection/Implementation.hs --- a/src/HROOT/Core/TSeqCollection/Implementation.hs +++ b/src/HROOT/Core/TSeqCollection/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TSeqCollection.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TSeqCollection.RawType import HROOT.Core.TSeqCollection.FFI import HROOT.Core.TSeqCollection.Interface @@ -24,51 +25,19 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe +instance ITSeqCollection TSeqCollection +instance ITCollection TSeqCollection -instance ITSeqCollection TSeqCollection where -instance ITCollection TSeqCollection where instance ITObject TSeqCollection where - draw = xform1 c_tseqcollection_draw - findObject = xform1 c_tseqcollection_findobject - getName = xform0 c_tseqcollection_getname - isA = xform0 c_tseqcollection_isa - paint = xform1 c_tseqcollection_paint - printObj = xform1 c_tseqcollection_printobj - saveAs = xform2 c_tseqcollection_saveas - write = xform3 c_tseqcollection_write -instance IDeletable TSeqCollection where - delete = xform0 c_tseqcollection_delete - -instance ITSeqCollection (Exist TSeqCollection) where - -instance ITCollection (Exist TSeqCollection) where - -instance ITObject (Exist TSeqCollection) where - draw (ETSeqCollection x) = draw x - findObject (ETSeqCollection x) = findObject x - getName (ETSeqCollection x) = getName x - isA (ETSeqCollection x) = isA x - paint (ETSeqCollection x) = paint x - printObj (ETSeqCollection x) = printObj x - saveAs (ETSeqCollection x) = saveAs x - write (ETSeqCollection x) = write x -instance IDeletable (Exist TSeqCollection) where - delete (ETSeqCollection x) = delete x - - - - - - + draw = xform1 c_tseqcollection_draw + findObject = xform1 c_tseqcollection_findobject + getName = xform0 c_tseqcollection_getname + isA = xform0 c_tseqcollection_isa + paint = xform1 c_tseqcollection_paint + printObj = xform1 c_tseqcollection_printobj + saveAs = xform2 c_tseqcollection_saveas + write = xform3 c_tseqcollection_write -instance FPtr (Exist TSeqCollection) where - type Raw (Exist TSeqCollection) = RawTSeqCollection - get_fptr (ETSeqCollection obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETSeqCollection (cast_fptr_to_obj (fptr :: ForeignPtr RawTSeqCollection) :: TSeqCollection) +instance IDeletable TSeqCollection where + delete = xform0 c_tseqcollection_delete diff --git a/src/HROOT/Core/TSeqCollection/Interface.hs b/src/HROOT/Core/TSeqCollection/Interface.hs --- a/src/HROOT/Core/TSeqCollection/Interface.hs +++ b/src/HROOT/Core/TSeqCollection/Interface.hs @@ -1,36 +1,27 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TSeqCollection.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TSeqCollection.RawType - import HROOT.Core.TCollection.Interface ----- ============ ---- - - -class (ITCollection a) => ITSeqCollection a where - -instance Existable TSeqCollection where - data Exist TSeqCollection = forall a. (FPtr a, ITSeqCollection a) => ETSeqCollection a +class ITCollection a => ITSeqCollection a -upcastTSeqCollection :: (FPtr a, ITSeqCollection a) => a -> TSeqCollection -upcastTSeqCollection h = let fh = get_fptr h - fh2 :: ForeignPtr RawTSeqCollection = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTSeqCollection :: + forall a . (FPtr a, ITSeqCollection a) => a -> TSeqCollection +upcastTSeqCollection h + = let fh = get_fptr h + fh2 :: Ptr RawTSeqCollection = castPtr fh + in cast_fptr_to_obj fh2 -downcastTSeqCollection :: (FPtr a, ITSeqCollection a) => TSeqCollection -> a -downcastTSeqCollection h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTSeqCollection :: + forall a . (FPtr a, ITSeqCollection a) => TSeqCollection -> a +downcastTSeqCollection h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TSeqCollection/RawType.hs b/src/HROOT/Core/TSeqCollection/RawType.hs --- a/src/HROOT/Core/TSeqCollection/RawType.hs +++ b/src/HROOT/Core/TSeqCollection/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TSeqCollection.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTSeqCollection -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TSeqCollection = TSeqCollection (Ptr RawTSeqCollection) + deriving (Eq, Ord, Show) -data RawTSeqCollection -newtype TSeqCollection = TSeqCollection (ForeignPtr RawTSeqCollection) deriving (Eq, Ord, Show) instance FPtr TSeqCollection where - type Raw TSeqCollection = RawTSeqCollection - get_fptr (TSeqCollection fptr) = fptr - cast_fptr_to_obj = TSeqCollection + type Raw TSeqCollection = RawTSeqCollection + get_fptr (TSeqCollection ptr) = ptr + cast_fptr_to_obj = TSeqCollection diff --git a/src/HROOT/Core/TSystem.hs b/src/HROOT/Core/TSystem.hs --- a/src/HROOT/Core/TSystem.hs +++ b/src/HROOT/Core/TSystem.hs @@ -1,15 +1,5 @@ module HROOT.Core.TSystem - ( - TSystem(..) - , ITSystem(..) - , upcastTSystem - , downcastTSystem - - - ) where - + (TSystem(..), ITSystem(..), upcastTSystem, downcastTSystem) where import HROOT.Core.TSystem.RawType import HROOT.Core.TSystem.Interface import HROOT.Core.TSystem.Implementation - - diff --git a/src/HROOT/Core/TSystem/Cast.hs b/src/HROOT/Core/TSystem/Cast.hs --- a/src/HROOT/Core/TSystem/Cast.hs +++ b/src/HROOT/Core/TSystem/Cast.hs @@ -1,22 +1,17 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TSystem.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TSystem.RawType import HROOT.Core.TSystem.Interface instance (ITSystem a, FPtr a) => Castable a (Ptr RawTSystem) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TSystem (Ptr RawTSystem) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TSystem/FFI.hsc b/src/HROOT/Core/TSystem/FFI.hsc --- a/src/HROOT/Core/TSystem/FFI.hsc +++ b/src/HROOT/Core/TSystem/FFI.hsc @@ -1,59 +1,50 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TSystem.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TSystem.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTCoreTSystem.h" - -foreign import ccall "HROOTCoreTSystem.h TSystem_SetName" c_tsystem_setname - :: (Ptr RawTSystem) -> CString -> IO () - -foreign import ccall "HROOTCoreTSystem.h TSystem_SetNameTitle" c_tsystem_setnametitle - :: (Ptr RawTSystem) -> CString -> CString -> IO () +foreign import ccall safe "HROOTCoreTSystem.h TSystem_SetName" + c_tsystem_setname :: Ptr RawTSystem -> CString -> IO () -foreign import ccall "HROOTCoreTSystem.h TSystem_SetTitle" c_tsystem_settitle - :: (Ptr RawTSystem) -> CString -> IO () +foreign import ccall safe "HROOTCoreTSystem.h TSystem_SetNameTitle" + c_tsystem_setnametitle :: + Ptr RawTSystem -> CString -> CString -> IO () -foreign import ccall "HROOTCoreTSystem.h TSystem_Draw" c_tsystem_draw - :: (Ptr RawTSystem) -> CString -> IO () +foreign import ccall safe "HROOTCoreTSystem.h TSystem_SetTitle" + c_tsystem_settitle :: Ptr RawTSystem -> CString -> IO () -foreign import ccall "HROOTCoreTSystem.h TSystem_FindObject" c_tsystem_findobject - :: (Ptr RawTSystem) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTCoreTSystem.h TSystem_Draw" + c_tsystem_draw :: Ptr RawTSystem -> CString -> IO () -foreign import ccall "HROOTCoreTSystem.h TSystem_GetName" c_tsystem_getname - :: (Ptr RawTSystem) -> IO CString +foreign import ccall safe "HROOTCoreTSystem.h TSystem_FindObject" + c_tsystem_findobject :: + Ptr RawTSystem -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTCoreTSystem.h TSystem_IsA" c_tsystem_isa - :: (Ptr RawTSystem) -> IO (Ptr RawTClass) +foreign import ccall safe "HROOTCoreTSystem.h TSystem_GetName" + c_tsystem_getname :: Ptr RawTSystem -> IO CString -foreign import ccall "HROOTCoreTSystem.h TSystem_Paint" c_tsystem_paint - :: (Ptr RawTSystem) -> CString -> IO () +foreign import ccall safe "HROOTCoreTSystem.h TSystem_IsA" + c_tsystem_isa :: Ptr RawTSystem -> IO (Ptr RawTClass) -foreign import ccall "HROOTCoreTSystem.h TSystem_printObj" c_tsystem_printobj - :: (Ptr RawTSystem) -> CString -> IO () +foreign import ccall safe "HROOTCoreTSystem.h TSystem_Paint" + c_tsystem_paint :: Ptr RawTSystem -> CString -> IO () -foreign import ccall "HROOTCoreTSystem.h TSystem_SaveAs" c_tsystem_saveas - :: (Ptr RawTSystem) -> CString -> CString -> IO () +foreign import ccall safe "HROOTCoreTSystem.h TSystem_printObj" + c_tsystem_printobj :: Ptr RawTSystem -> CString -> IO () -foreign import ccall "HROOTCoreTSystem.h TSystem_Write" c_tsystem_write - :: (Ptr RawTSystem) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe "HROOTCoreTSystem.h TSystem_SaveAs" + c_tsystem_saveas :: Ptr RawTSystem -> CString -> CString -> IO () -foreign import ccall "HROOTCoreTSystem.h TSystem_delete" c_tsystem_delete - :: (Ptr RawTSystem) -> IO () +foreign import ccall safe "HROOTCoreTSystem.h TSystem_Write" + c_tsystem_write :: + Ptr RawTSystem -> CString -> CInt -> CInt -> IO CInt -foreign import ccall "HROOTCoreTSystem.h TSystem_ProcessEvents" c_tsystem_processevents - :: (Ptr RawTSystem) -> IO CInt +foreign import ccall safe "HROOTCoreTSystem.h TSystem_delete" + c_tsystem_delete :: Ptr RawTSystem -> IO () +foreign import ccall safe + "HROOTCoreTSystem.h TSystem_ProcessEvents" c_tsystem_processevents + :: Ptr RawTSystem -> IO CInt diff --git a/src/HROOT/Core/TSystem/Implementation.hs b/src/HROOT/Core/TSystem/Implementation.hs --- a/src/HROOT/Core/TSystem/Implementation.hs +++ b/src/HROOT/Core/TSystem/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TSystem.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TSystem.RawType import HROOT.Core.TSystem.FFI import HROOT.Core.TSystem.Interface @@ -24,57 +25,23 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - - instance ITSystem TSystem where - processEvents = xform0 c_tsystem_processevents -instance ITNamed TSystem where - setName = xform1 c_tsystem_setname - setNameTitle = xform2 c_tsystem_setnametitle - setTitle = xform1 c_tsystem_settitle -instance ITObject TSystem where - draw = xform1 c_tsystem_draw - findObject = xform1 c_tsystem_findobject - getName = xform0 c_tsystem_getname - isA = xform0 c_tsystem_isa - paint = xform1 c_tsystem_paint - printObj = xform1 c_tsystem_printobj - saveAs = xform2 c_tsystem_saveas - write = xform3 c_tsystem_write -instance IDeletable TSystem where - delete = xform0 c_tsystem_delete - -instance ITSystem (Exist TSystem) where - processEvents (ETSystem x) = processEvents x -instance ITNamed (Exist TSystem) where - setName (ETSystem x) = setName x - setNameTitle (ETSystem x) = setNameTitle x - setTitle (ETSystem x) = setTitle x -instance ITObject (Exist TSystem) where - draw (ETSystem x) = draw x - findObject (ETSystem x) = findObject x - getName (ETSystem x) = getName x - isA (ETSystem x) = isA x - paint (ETSystem x) = paint x - printObj (ETSystem x) = printObj x - saveAs (ETSystem x) = saveAs x - write (ETSystem x) = write x -instance IDeletable (Exist TSystem) where - delete (ETSystem x) = delete x - - - - + processEvents = xform0 c_tsystem_processevents +instance ITNamed TSystem where + setName = xform1 c_tsystem_setname + setNameTitle = xform2 c_tsystem_setnametitle + setTitle = xform1 c_tsystem_settitle +instance ITObject TSystem where + draw = xform1 c_tsystem_draw + findObject = xform1 c_tsystem_findobject + getName = xform0 c_tsystem_getname + isA = xform0 c_tsystem_isa + paint = xform1 c_tsystem_paint + printObj = xform1 c_tsystem_printobj + saveAs = xform2 c_tsystem_saveas + write = xform3 c_tsystem_write -instance FPtr (Exist TSystem) where - type Raw (Exist TSystem) = RawTSystem - get_fptr (ETSystem obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETSystem (cast_fptr_to_obj (fptr :: ForeignPtr RawTSystem) :: TSystem) +instance IDeletable TSystem where + delete = xform0 c_tsystem_delete diff --git a/src/HROOT/Core/TSystem/Interface.hs b/src/HROOT/Core/TSystem/Interface.hs --- a/src/HROOT/Core/TSystem/Interface.hs +++ b/src/HROOT/Core/TSystem/Interface.hs @@ -1,38 +1,26 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TSystem.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TSystem.RawType - import HROOT.Core.TNamed.Interface ----- ============ ---- - - -class (ITNamed a) => ITSystem a where - - processEvents :: a -> IO CInt - -instance Existable TSystem where - data Exist TSystem = forall a. (FPtr a, ITSystem a) => ETSystem a +class ITNamed a => ITSystem a where + processEvents :: a -> IO CInt -upcastTSystem :: (FPtr a, ITSystem a) => a -> TSystem -upcastTSystem h = let fh = get_fptr h - fh2 :: ForeignPtr RawTSystem = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTSystem :: forall a . (FPtr a, ITSystem a) => a -> TSystem +upcastTSystem h + = let fh = get_fptr h + fh2 :: Ptr RawTSystem = castPtr fh + in cast_fptr_to_obj fh2 -downcastTSystem :: (FPtr a, ITSystem a) => TSystem -> a -downcastTSystem h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTSystem :: forall a . (FPtr a, ITSystem a) => TSystem -> a +downcastTSystem h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TSystem/RawType.hs b/src/HROOT/Core/TSystem/RawType.hs --- a/src/HROOT/Core/TSystem/RawType.hs +++ b/src/HROOT/Core/TSystem/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TSystem.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTSystem -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TSystem = TSystem (Ptr RawTSystem) + deriving (Eq, Ord, Show) -data RawTSystem -newtype TSystem = TSystem (ForeignPtr RawTSystem) deriving (Eq, Ord, Show) instance FPtr TSystem where - type Raw TSystem = RawTSystem - get_fptr (TSystem fptr) = fptr - cast_fptr_to_obj = TSystem + type Raw TSystem = RawTSystem + get_fptr (TSystem ptr) = ptr + cast_fptr_to_obj = TSystem diff --git a/src/HROOT/Core/TVirtualPad.hs b/src/HROOT/Core/TVirtualPad.hs --- a/src/HROOT/Core/TVirtualPad.hs +++ b/src/HROOT/Core/TVirtualPad.hs @@ -1,15 +1,7 @@ module HROOT.Core.TVirtualPad - ( - TVirtualPad(..) - , ITVirtualPad(..) - , upcastTVirtualPad - , downcastTVirtualPad - - - ) where - + (TVirtualPad(..), ITVirtualPad(..), upcastTVirtualPad, + downcastTVirtualPad) + where import HROOT.Core.TVirtualPad.RawType import HROOT.Core.TVirtualPad.Interface import HROOT.Core.TVirtualPad.Implementation - - diff --git a/src/HROOT/Core/TVirtualPad/Cast.hs b/src/HROOT/Core/TVirtualPad/Cast.hs --- a/src/HROOT/Core/TVirtualPad/Cast.hs +++ b/src/HROOT/Core/TVirtualPad/Cast.hs @@ -1,22 +1,18 @@ -{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, - MultiParamTypeClasses, OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} module HROOT.Core.TVirtualPad.Cast where - - import Foreign.Ptr -import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_) -import Foreign.ForeignPtr.Unsafe import FFICXX.Runtime.Cast import System.IO.Unsafe - import HROOT.Core.TVirtualPad.RawType import HROOT.Core.TVirtualPad.Interface -instance (ITVirtualPad a, FPtr a) => Castable a (Ptr RawTVirtualPad) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ +instance (ITVirtualPad a, FPtr a) => Castable a + (Ptr RawTVirtualPad) where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) instance Castable TVirtualPad (Ptr RawTVirtualPad) where - cast = unsafeForeignPtrToPtr . castForeignPtr . get_fptr - uncast = cast_fptr_to_obj . castForeignPtr . unsafePerformIO . newForeignPtr_ + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/Core/TVirtualPad/FFI.hsc b/src/HROOT/Core/TVirtualPad/FFI.hsc --- a/src/HROOT/Core/TVirtualPad/FFI.hsc +++ b/src/HROOT/Core/TVirtualPad/FFI.hsc @@ -1,62 +1,64 @@ {-# LANGUAGE ForeignFunctionInterface #-} - --- module HROOT.Class.FFI where - module HROOT.Core.TVirtualPad.FFI where - - -import Foreign.C +import Foreign.C import Foreign.Ptr - --- import HROOT.Class.Interface - --- #include "" - import HROOT.Core.TVirtualPad.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TClass.RawType -#include "HROOTCoreTVirtualPad.h" - -foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_Draw" c_tvirtualpad_draw - :: (Ptr RawTVirtualPad) -> CString -> IO () - -foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_FindObject" c_tvirtualpad_findobject - :: (Ptr RawTVirtualPad) -> CString -> IO (Ptr RawTObject) +foreign import ccall safe "HROOTCoreTVirtualPad.h TVirtualPad_Draw" + c_tvirtualpad_draw :: Ptr RawTVirtualPad -> CString -> IO () -foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_GetName" c_tvirtualpad_getname - :: (Ptr RawTVirtualPad) -> IO CString +foreign import ccall safe + "HROOTCoreTVirtualPad.h TVirtualPad_FindObject" + c_tvirtualpad_findobject :: + Ptr RawTVirtualPad -> CString -> IO (Ptr RawTObject) -foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_IsA" c_tvirtualpad_isa - :: (Ptr RawTVirtualPad) -> IO (Ptr RawTClass) +foreign import ccall safe + "HROOTCoreTVirtualPad.h TVirtualPad_GetName" c_tvirtualpad_getname + :: Ptr RawTVirtualPad -> IO CString -foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_Paint" c_tvirtualpad_paint - :: (Ptr RawTVirtualPad) -> CString -> IO () +foreign import ccall safe "HROOTCoreTVirtualPad.h TVirtualPad_IsA" + c_tvirtualpad_isa :: Ptr RawTVirtualPad -> IO (Ptr RawTClass) -foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_printObj" c_tvirtualpad_printobj - :: (Ptr RawTVirtualPad) -> CString -> IO () +foreign import ccall safe + "HROOTCoreTVirtualPad.h TVirtualPad_Paint" c_tvirtualpad_paint :: + Ptr RawTVirtualPad -> CString -> IO () -foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_SaveAs" c_tvirtualpad_saveas - :: (Ptr RawTVirtualPad) -> CString -> CString -> IO () +foreign import ccall safe + "HROOTCoreTVirtualPad.h TVirtualPad_printObj" + c_tvirtualpad_printobj :: Ptr RawTVirtualPad -> CString -> IO () -foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_Write" c_tvirtualpad_write - :: (Ptr RawTVirtualPad) -> CString -> CInt -> CInt -> IO CInt +foreign import ccall safe + "HROOTCoreTVirtualPad.h TVirtualPad_SaveAs" c_tvirtualpad_saveas :: + Ptr RawTVirtualPad -> CString -> CString -> IO () -foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_delete" c_tvirtualpad_delete - :: (Ptr RawTVirtualPad) -> IO () +foreign import ccall safe + "HROOTCoreTVirtualPad.h TVirtualPad_Write" c_tvirtualpad_write :: + Ptr RawTVirtualPad -> CString -> CInt -> CInt -> IO CInt -foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_cd" c_tvirtualpad_cd - :: (Ptr RawTVirtualPad) -> CInt -> IO (Ptr RawTVirtualPad) +foreign import ccall safe + "HROOTCoreTVirtualPad.h TVirtualPad_delete" c_tvirtualpad_delete :: + Ptr RawTVirtualPad -> IO () -foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_divide_tvirtualpad" c_tvirtualpad_divide_tvirtualpad - :: (Ptr RawTVirtualPad) -> CInt -> CInt -> CDouble -> CDouble -> CInt -> IO () +foreign import ccall safe "HROOTCoreTVirtualPad.h TVirtualPad_cd" + c_tvirtualpad_cd :: + Ptr RawTVirtualPad -> CInt -> IO (Ptr RawTVirtualPad) -foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_SetLogx" c_tvirtualpad_setlogx - :: (Ptr RawTVirtualPad) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTVirtualPad.h TVirtualPad_divide_tvirtualpad" + c_tvirtualpad_divide_tvirtualpad :: + Ptr RawTVirtualPad -> + CInt -> CInt -> CDouble -> CDouble -> CInt -> IO () -foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_SetLogy" c_tvirtualpad_setlogy - :: (Ptr RawTVirtualPad) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTVirtualPad.h TVirtualPad_SetLogx" c_tvirtualpad_setlogx + :: Ptr RawTVirtualPad -> CInt -> IO () -foreign import ccall "HROOTCoreTVirtualPad.h TVirtualPad_SetLogz" c_tvirtualpad_setlogz - :: (Ptr RawTVirtualPad) -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTVirtualPad.h TVirtualPad_SetLogy" c_tvirtualpad_setlogy + :: Ptr RawTVirtualPad -> CInt -> IO () +foreign import ccall safe + "HROOTCoreTVirtualPad.h TVirtualPad_SetLogz" c_tvirtualpad_setlogz + :: Ptr RawTVirtualPad -> CInt -> IO () diff --git a/src/HROOT/Core/TVirtualPad/Implementation.hs b/src/HROOT/Core/TVirtualPad/Implementation.hs --- a/src/HROOT/Core/TVirtualPad/Implementation.hs +++ b/src/HROOT/Core/TVirtualPad/Implementation.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, EmptyDataDecls, - OverlappingInstances, IncoherentInstances #-} - +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TVirtualPad.Implementation where - - import FFICXX.Runtime.Cast - +import Data.Word +import Foreign.C +import Foreign.Ptr +import System.IO.Unsafe import HROOT.Core.TVirtualPad.RawType import HROOT.Core.TVirtualPad.FFI import HROOT.Core.TVirtualPad.Interface @@ -21,57 +22,22 @@ import HROOT.Core.Deletable.Cast import HROOT.Core.Deletable.Interface -import Data.Word -import Foreign.C -import Foreign.Ptr -import Foreign.ForeignPtr - -import System.IO.Unsafe - - instance ITVirtualPad TVirtualPad where - cd = xform1 c_tvirtualpad_cd - divide_tvirtualpad = xform5 c_tvirtualpad_divide_tvirtualpad - setLogx = xform1 c_tvirtualpad_setlogx - setLogy = xform1 c_tvirtualpad_setlogy - setLogz = xform1 c_tvirtualpad_setlogz -instance ITObject TVirtualPad where - draw = xform1 c_tvirtualpad_draw - findObject = xform1 c_tvirtualpad_findobject - getName = xform0 c_tvirtualpad_getname - isA = xform0 c_tvirtualpad_isa - paint = xform1 c_tvirtualpad_paint - printObj = xform1 c_tvirtualpad_printobj - saveAs = xform2 c_tvirtualpad_saveas - write = xform3 c_tvirtualpad_write -instance IDeletable TVirtualPad where - delete = xform0 c_tvirtualpad_delete - -instance ITVirtualPad (Exist TVirtualPad) where - cd (ETVirtualPad x) a1 = return . ETVirtualPad =<< cd x a1 - divide_tvirtualpad (ETVirtualPad x) = divide_tvirtualpad x - setLogx (ETVirtualPad x) = setLogx x - setLogy (ETVirtualPad x) = setLogy x - setLogz (ETVirtualPad x) = setLogz x -instance ITObject (Exist TVirtualPad) where - draw (ETVirtualPad x) = draw x - findObject (ETVirtualPad x) = findObject x - getName (ETVirtualPad x) = getName x - isA (ETVirtualPad x) = isA x - paint (ETVirtualPad x) = paint x - printObj (ETVirtualPad x) = printObj x - saveAs (ETVirtualPad x) = saveAs x - write (ETVirtualPad x) = write x -instance IDeletable (Exist TVirtualPad) where - delete (ETVirtualPad x) = delete x - - - - - + cd = xform1 c_tvirtualpad_cd + divide_tvirtualpad = xform5 c_tvirtualpad_divide_tvirtualpad + setLogx = xform1 c_tvirtualpad_setlogx + setLogy = xform1 c_tvirtualpad_setlogy + setLogz = xform1 c_tvirtualpad_setlogz +instance ITObject TVirtualPad where + draw = xform1 c_tvirtualpad_draw + findObject = xform1 c_tvirtualpad_findobject + getName = xform0 c_tvirtualpad_getname + isA = xform0 c_tvirtualpad_isa + paint = xform1 c_tvirtualpad_paint + printObj = xform1 c_tvirtualpad_printobj + saveAs = xform2 c_tvirtualpad_saveas + write = xform3 c_tvirtualpad_write -instance FPtr (Exist TVirtualPad) where - type Raw (Exist TVirtualPad) = RawTVirtualPad - get_fptr (ETVirtualPad obj) = castForeignPtr (get_fptr obj) - cast_fptr_to_obj fptr = ETVirtualPad (cast_fptr_to_obj (fptr :: ForeignPtr RawTVirtualPad) :: TVirtualPad) +instance IDeletable TVirtualPad where + delete = xform0 c_tvirtualpad_delete diff --git a/src/HROOT/Core/TVirtualPad/Interface.hs b/src/HROOT/Core/TVirtualPad/Interface.hs --- a/src/HROOT/Core/TVirtualPad/Interface.hs +++ b/src/HROOT/Core/TVirtualPad/Interface.hs @@ -1,46 +1,37 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - --- module HROOT.Class.Interface where - +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} module HROOT.Core.TVirtualPad.Interface where - - import Data.Word import Foreign.C import Foreign.Ptr -import Foreign.ForeignPtr import FFICXX.Runtime.Cast - import HROOT.Core.TVirtualPad.RawType - import HROOT.Core.TObject.Interface ----- ============ ---- - - -class (ITObject a) => ITVirtualPad a where - - cd :: a -> CInt -> IO a - - divide_tvirtualpad :: a -> CInt -> CInt -> CDouble -> CDouble -> CInt -> IO () - - setLogx :: a -> CInt -> IO () - - setLogy :: a -> CInt -> IO () - - setLogz :: a -> CInt -> IO () - -instance Existable TVirtualPad where - data Exist TVirtualPad = forall a. (FPtr a, ITVirtualPad a) => ETVirtualPad a +class ITObject a => ITVirtualPad a where + cd :: a -> CInt -> IO a + + divide_tvirtualpad :: + a -> CInt -> CInt -> CDouble -> CDouble -> CInt -> IO () + + setLogx :: a -> CInt -> IO () + + setLogy :: a -> CInt -> IO () + + setLogz :: a -> CInt -> IO () -upcastTVirtualPad :: (FPtr a, ITVirtualPad a) => a -> TVirtualPad -upcastTVirtualPad h = let fh = get_fptr h - fh2 :: ForeignPtr RawTVirtualPad = castForeignPtr fh - in cast_fptr_to_obj fh2 +upcastTVirtualPad :: + forall a . (FPtr a, ITVirtualPad a) => a -> TVirtualPad +upcastTVirtualPad h + = let fh = get_fptr h + fh2 :: Ptr RawTVirtualPad = castPtr fh + in cast_fptr_to_obj fh2 -downcastTVirtualPad :: (FPtr a, ITVirtualPad a) => TVirtualPad -> a -downcastTVirtualPad h = let fh = get_fptr h - fh2 = castForeignPtr fh - in cast_fptr_to_obj fh2 +downcastTVirtualPad :: + forall a . (FPtr a, ITVirtualPad a) => TVirtualPad -> a +downcastTVirtualPad h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/Core/TVirtualPad/RawType.hs b/src/HROOT/Core/TVirtualPad/RawType.hs --- a/src/HROOT/Core/TVirtualPad/RawType.hs +++ b/src/HROOT/Core/TVirtualPad/RawType.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} - +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} module HROOT.Core.TVirtualPad.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast +data RawTVirtualPad -import Foreign.ForeignPtr -import FFICXX.Runtime.Cast +newtype TVirtualPad = TVirtualPad (Ptr RawTVirtualPad) + deriving (Eq, Ord, Show) -data RawTVirtualPad -newtype TVirtualPad = TVirtualPad (ForeignPtr RawTVirtualPad) deriving (Eq, Ord, Show) instance FPtr TVirtualPad where - type Raw TVirtualPad = RawTVirtualPad - get_fptr (TVirtualPad fptr) = fptr - cast_fptr_to_obj = TVirtualPad + type Raw TVirtualPad = RawTVirtualPad + get_fptr (TVirtualPad ptr) = ptr + cast_fptr_to_obj = TVirtualPad