diff --git a/CHANGES b/CHANGES new file mode 100644 --- /dev/null +++ b/CHANGES @@ -0,0 +1,60 @@ +# Changelog for HROOT + +## 0.10.0.1 +- Use hackage-version of fficxx (#18) +- Generate docs in CI (#17) +- Update flake.nix with recent fficxx and ormolu format (#16) +- Update fficxx to support GHC 9.4 (#15) +- Add TMutex and test multithreading with GUI (#12) +- HROOT now uses common stdcxx (#11) +- idealized gas simulation (#10) +- Add TMarker and Range. Test 2D graphics using gas example (#9) +- HROOT generation and packing via nix (#8) +- Revive umbrella package generation (#7) +- Static files (Config.hs, Setup.lhs) and custom-setup dependency (#6) +- Modernize HROOT with fficxx 0.5.1 (#5) + +## 0.9.0.1 + +## 0.9 +- HROOT-tree +- HROOT only support ROOT > 6 + +## 0.8 +- separate packages into HROOT-core, HROOT-hist, HROOT-io, HROOT-math, HROOT-graf and HROOT is now an umbrella package + +## 0.7 +- separate all class interfaces and implementation in different modules +- overhaul Existential + +## 0.7.1 +- support for static methods +- add TROOT + +## 0.6.9 +- implement almost all class methods of TLine, TAttLine, TAttMarker, TAttText and TAttPad + +## 0.6.8 +- implement almost all class methods of TH2, TH3, TFormula, TF1 and TGraph + +## 0.6.7 +- implement almost all TH1 class methods + +## 0.6.6 +- do not need OverlappingInstances, IncoherentInstances, UndecidableInstances + +## 0.6.4 +- add many TH2 class methods + +## 0.6.3 +- Implement Existential Types + +## 0.6 +- implement Deletable. delete method for every object +- refactor HROOT generated file names (Interface.hs, Implementation.hs, FFI.hs) + +## 0.5.1 +- support for delete + +## 0.5.0 +- initial preview release 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-io.cabal b/HROOT-io.cabal --- a/HROOT-io.cabal +++ b/HROOT-io.cabal @@ -1,60 +1,79 @@ -Name: HROOT-io -Version: 0.9.0.1 -Synopsis: Haskell binding to ROOT IO 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 -Category: Graphics, Statistics, Math, Numerical -Tested-with: GHC >= 7.6 -Build-Type: Custom -cabal-version: >=1.10 +Cabal-version: 3.0 +Name: HROOT-io +Version: 0.10.0.1 +Synopsis: Haskell binding to ROOT IO 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: https://wavewave.github.io/HROOT +license: LGPL-2.1-or-later +license-file: LICENSE +Author: Ian-Woo Kim +Maintainer: Ian-Woo Kim +Category: Graphics, Statistics, Math, Numerical +Tested-with: GHC == 9.0.2 || == 9.2.4 || == 9.4.2 Extra-source-files: - Config.hs - csrc/HROOTIOTDirectoryFile.h - csrc/HROOTIOTFile.h - csrc/HROOTIOTDirectoryFile.cpp - csrc/HROOTIOTFile.cpp - - + CHANGES + csrc/HROOTIOTDirectoryFile.h + csrc/HROOTIOTFile.h + csrc/HROOTIOTMemFile.h + csrc/HROOTIOTDirectoryFile.cpp + csrc/HROOTIOTFile.cpp + csrc/HROOTIOTMemFile.cpp +Build-Type: Custom +custom-setup + setup-depends: Cabal < 4, base > 4 && < 5, process +Source-repository head + type: git + location: https://github.com/wavewave/HROOT Library default-language: Haskell2010 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 - cc-options: -std=c++14 - Build-Depends: base>4 && < 5, fficxx >= 0.3, fficxx-runtime >= 0.3, template-haskell,HROOT-core + cxx-options: -std=c++17 + Build-Depends: base > 4 && < 5, fficxx >= 0.7, fficxx-runtime >= 0.7, template-haskell, stdcxx, HROOT-core == 0.10.0.1 Exposed-Modules: HROOT.IO + HROOT.IO.Ordinary + HROOT.IO.Template + HROOT.IO.TH HROOT.IO.TDirectoryFile HROOT.IO.TFile + HROOT.IO.TMemFile HROOT.IO.TDirectoryFile.RawType HROOT.IO.TFile.RawType + HROOT.IO.TMemFile.RawType HROOT.IO.TDirectoryFile.FFI HROOT.IO.TFile.FFI + HROOT.IO.TMemFile.FFI HROOT.IO.TDirectoryFile.Interface HROOT.IO.TFile.Interface + HROOT.IO.TMemFile.Interface HROOT.IO.TDirectoryFile.Cast HROOT.IO.TFile.Cast + HROOT.IO.TMemFile.Cast HROOT.IO.TDirectoryFile.Implementation HROOT.IO.TFile.Implementation + HROOT.IO.TMemFile.Implementation Other-Modules: + extra-lib-dirs: - extra-libraries: stdc++ + extra-libraries: Include-dirs: csrc + pkgconfig-depends: Install-includes: HROOT-ioType.h HROOTIOTDirectoryFile.h HROOTIOTFile.h + HROOTIOTMemFile.h - C-sources: + Cxx-sources: csrc/HROOTIOTDirectoryFile.cpp csrc/HROOTIOTFile.cpp - + csrc/HROOTIOTMemFile.cpp diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,27 @@ +import Distribution.Simple +import Distribution.Simple.Setup +import Distribution.PackageDescription +import Distribution.Simple.LocalBuildInfo +import Config + +myconfigHook = simpleUserHooks { confHook = hookfunction } + +hookfunction x y = do + binfo <- confHook simpleUserHooks x y + r_pbi <- config binfo + let pkg_descr = localPkgDescr binfo + + let newbinfo = case r_pbi of + Just pbi -> binfo { localPkgDescr = updatePackageDescription pbi pkg_descr } + Nothing -> do + let r_lib = library pkg_descr + case r_lib of + Just lib -> + let binfo2 = libBuildInfo lib + newlib = lib { libBuildInfo = binfo2 { cSources = [] }} + in binfo { localPkgDescr = pkg_descr { library = Just newlib }} + Nothing -> error "some library setting is wrong." +-- putStrLn (show (localPkgDescr newbinfo)) + return newbinfo + +main = defaultMainWithHooks myconfigHook diff --git a/Setup.lhs b/Setup.lhs deleted file mode 100644 --- a/Setup.lhs +++ /dev/null @@ -1,33 +0,0 @@ -#! /usr/bin/env runhaskell - -> import Distribution.Simple -> import Distribution.Simple.Setup -> import Distribution.PackageDescription -> import Distribution.Simple.LocalBuildInfo -> -> import Config -> -> myconfigHook = simpleUserHooks { confHook = hookfunction } -> -> hookfunction x y = do -> binfo <- confHook simpleUserHooks x y -> r_pbi <- config binfo -> let pkg_descr = localPkgDescr binfo -> -> let newbinfo = case r_pbi of -> Just pbi -> binfo { localPkgDescr = updatePackageDescription pbi pkg_descr } -> Nothing -> do -> let r_lib = library pkg_descr -> case r_lib of -> Just lib -> -> let binfo2 = libBuildInfo lib -> newlib = lib { libBuildInfo = binfo2 { cSources = [] }} -> in binfo { localPkgDescr = pkg_descr { library = Just newlib }} -> Nothing -> error "some library setting is wrong." -> -- putStrLn (show (localPkgDescr newbinfo)) -> return newbinfo -> -> -> main = defaultMainWithHooks myconfigHook -> - diff --git a/csrc/HROOT-ioType.h b/csrc/HROOT-ioType.h --- a/csrc/HROOT-ioType.h +++ b/csrc/HROOT-ioType.h @@ -1,24 +1,16 @@ + #ifdef __cplusplus -extern "C" { +extern "C" { #endif -#ifndef __HROOT_IO__ -#define __HROOT_IO__ - -// Opaque type definition for TDirectoryFile -typedef struct TDirectoryFile_tag TDirectoryFile_t; -typedef TDirectoryFile_t * TDirectoryFile_p; -typedef TDirectoryFile_t const* const_TDirectoryFile_p; - - -// Opaque type definition for TFile -typedef struct TFile_tag TFile_t; -typedef TFile_t * TFile_p; -typedef TFile_t const* const_TFile_p; - - -#endif // __HROOT_IO__ +#pragma once +// Opaque type definition for $classname +typedef struct TDirectoryFile_tag TDirectoryFile_t;typedef TDirectoryFile_t * TDirectoryFile_p;typedef TDirectoryFile_t const* const_TDirectoryFile_p; +// Opaque type definition for $classname +typedef struct TFile_tag TFile_t;typedef TFile_t * TFile_p;typedef TFile_t const* const_TFile_p; +// Opaque type definition for $classname +typedef struct TMemFile_tag TMemFile_t;typedef TMemFile_t * TMemFile_p;typedef TMemFile_t const* const_TMemFile_p; #ifdef __cplusplus } #endif diff --git a/csrc/HROOTIOTDirectoryFile.cpp b/csrc/HROOTIOTDirectoryFile.cpp --- a/csrc/HROOTIOTDirectoryFile.cpp +++ b/csrc/HROOTIOTDirectoryFile.cpp @@ -1,24 +1,26 @@ -#include + +#include "MacroPatternMatch.h" + #include "HROOTCoreTDirectory.h" + #include "TDirectoryFile.h" -#include "HROOTIOTDirectoryFile.h" +#include "HROOTIOTDirectoryFile.h" +using namespace ROOT; -#define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) +#define CHECKPROTECT(x,y) FXIS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ - IIF( CHECKPROTECT(cname,mname) ) ( \ - (to_nonconst), \ - (to_nonconst) ) - + FXIIF( CHECKPROTECT(cname,mname) ) ( \ + (from_nonconst_to_nonconst), \ + (from_nonconst_to_nonconst) ) TDIRECTORY_DEF_VIRT(TDirectoryFile) TNAMED_DEF_VIRT(TDirectoryFile) TOBJECT_DEF_VIRT(TDirectoryFile) DELETABLE_DEF_VIRT(TDirectoryFile) - TDIRECTORYFILE_DEF_VIRT(TDirectoryFile) - TDIRECTORYFILE_DEF_NONVIRT(TDirectoryFile) +TDIRECTORYFILE_DEF_ACCESSOR(TDirectoryFile) diff --git a/csrc/HROOTIOTDirectoryFile.h b/csrc/HROOTIOTDirectoryFile.h --- a/csrc/HROOTIOTDirectoryFile.h +++ b/csrc/HROOTIOTDirectoryFile.h @@ -1,46 +1,55 @@ + #ifdef __cplusplus -extern "C" { +extern "C" { #endif -#ifndef __HROOT_IO__TDirectoryFile__ -#define __HROOT_IO__TDirectoryFile__ +#pragma once + #include "HROOT-ioType.h" + #include "HROOTCoreTDirectory.h" + #include "HROOTCoreTNamed.h" + #include "HROOTCoreTObject.h" -#include "HROOTCoreDeletable.h" + +#include "STDDeletable.h" + #include "HROOT-coreType.h" -#undef TDIRECTORYFILE_DECL_VIRT + #define TDIRECTORYFILE_DECL_VIRT(Type) \ -#undef TDIRECTORYFILE_DECL_NONVIRT + #define TDIRECTORYFILE_DECL_NONVIRT(Type) \ -#undef TDIRECTORYFILE_DEF_VIRT -#define TDIRECTORYFILE_DEF_VIRT(Type)\ +#define TDIRECTORYFILE_DECL_ACCESSOR(Type) \ -#undef TDIRECTORYFILE_DEF_NONVIRT -#define TDIRECTORYFILE_DEF_NONVIRT(Type)\ -TDIRECTORY_DECL_VIRT(TDirectoryFile); -TNAMED_DECL_VIRT(TDirectoryFile); -TOBJECT_DECL_VIRT(TDirectoryFile); -DELETABLE_DECL_VIRT(TDirectoryFile); +#define TDIRECTORYFILE_DEF_VIRT(Type) \ -TDIRECTORYFILE_DECL_VIRT(TDirectoryFile); +#define TDIRECTORYFILE_DEF_NONVIRT(Type) \ -TDIRECTORYFILE_DECL_NONVIRT(TDirectoryFile); -#endif // __HROOT_IO__TDirectoryFile__ +#define TDIRECTORYFILE_DEF_ACCESSOR(Type) \ + + + +TDIRECTORY_DECL_VIRT(TDirectoryFile) +TNAMED_DECL_VIRT(TDirectoryFile) +TOBJECT_DECL_VIRT(TDirectoryFile) +DELETABLE_DECL_VIRT(TDirectoryFile) +TDIRECTORYFILE_DECL_VIRT(TDirectoryFile) +TDIRECTORYFILE_DECL_NONVIRT(TDirectoryFile) +TDIRECTORYFILE_DECL_ACCESSOR(TDirectoryFile) #ifdef __cplusplus } diff --git a/csrc/HROOTIOTFile.cpp b/csrc/HROOTIOTFile.cpp --- a/csrc/HROOTIOTFile.cpp +++ b/csrc/HROOTIOTFile.cpp @@ -1,25 +1,27 @@ -#include + +#include "MacroPatternMatch.h" + #include "HROOTIOTDirectoryFile.h" + #include "TFile.h" -#include "HROOTIOTFile.h" +#include "HROOTIOTFile.h" +using namespace ROOT; -#define CHECKPROTECT(x,y) IS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) +#define CHECKPROTECT(x,y) FXIS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) #define TYPECASTMETHOD(cname,mname,oname) \ - IIF( CHECKPROTECT(cname,mname) ) ( \ - (to_nonconst), \ - (to_nonconst) ) - + FXIIF( CHECKPROTECT(cname,mname) ) ( \ + (from_nonconst_to_nonconst), \ + (from_nonconst_to_nonconst) ) TDIRECTORYFILE_DEF_VIRT(TFile) TDIRECTORY_DEF_VIRT(TFile) TNAMED_DEF_VIRT(TFile) TOBJECT_DEF_VIRT(TFile) DELETABLE_DEF_VIRT(TFile) - TFILE_DEF_VIRT(TFile) - TFILE_DEF_NONVIRT(TFile) +TFILE_DEF_ACCESSOR(TFile) diff --git a/csrc/HROOTIOTFile.h b/csrc/HROOTIOTFile.h --- a/csrc/HROOTIOTFile.h +++ b/csrc/HROOTIOTFile.h @@ -1,51 +1,58 @@ + #ifdef __cplusplus -extern "C" { +extern "C" { #endif -#ifndef __HROOT_IO__TFile__ -#define __HROOT_IO__TFile__ +#pragma once + #include "HROOT-ioType.h" + #include "HROOTIOTDirectoryFile.h" + #include "HROOTCoreTDirectory.h" + #include "HROOTCoreTNamed.h" + #include "HROOTCoreTObject.h" -#include "HROOTCoreDeletable.h" -#undef TFILE_DECL_VIRT +#include "STDDeletable.h" + + #define TFILE_DECL_VIRT(Type) \ -#undef TFILE_DECL_NONVIRT + #define TFILE_DECL_NONVIRT(Type) \ -Type ## _p Type ## _newTFile ( const char* fname, const char* option, const char* ftitle, int compress ) +Type##_p Type##_newTFile ( const char* fname, const char* option, const char* ftitle, int compress ); -#undef TFILE_DEF_VIRT -#define TFILE_DEF_VIRT(Type)\ +#define TFILE_DECL_ACCESSOR(Type) \ -#undef TFILE_DEF_NONVIRT -#define TFILE_DEF_NONVIRT(Type)\ -Type ## _p Type ## _newTFile ( const char* fname, const char* option, const char* ftitle, int compress )\ -{\ -Type * newp = new Type (fname, option, ftitle, compress); \ -return to_nonconst(newp);\ -} -TDIRECTORYFILE_DECL_VIRT(TFile); -TDIRECTORY_DECL_VIRT(TFile); -TNAMED_DECL_VIRT(TFile); -TOBJECT_DECL_VIRT(TFile); -DELETABLE_DECL_VIRT(TFile); +#define TFILE_DEF_VIRT(Type) \ -TFILE_DECL_VIRT(TFile); -TFILE_DECL_NONVIRT(TFile); +#define TFILE_DEF_NONVIRT(Type) \ +Type##_p Type##_newTFile ( const char* fname, const char* option, const char* ftitle, int compress ) {\ +Type* newp=new Type(fname, option, ftitle, compress);return from_nonconst_to_nonconst(newp);\ +} -#endif // __HROOT_IO__TFile__ +#define TFILE_DEF_ACCESSOR(Type) \ + + + +TDIRECTORYFILE_DECL_VIRT(TFile) +TDIRECTORY_DECL_VIRT(TFile) +TNAMED_DECL_VIRT(TFile) +TOBJECT_DECL_VIRT(TFile) +DELETABLE_DECL_VIRT(TFile) +TFILE_DECL_VIRT(TFile) +TFILE_DECL_NONVIRT(TFile) +TFILE_DECL_ACCESSOR(TFile) #ifdef __cplusplus } diff --git a/csrc/HROOTIOTMemFile.cpp b/csrc/HROOTIOTMemFile.cpp new file mode 100644 --- /dev/null +++ b/csrc/HROOTIOTMemFile.cpp @@ -0,0 +1,28 @@ + +#include "MacroPatternMatch.h" + +#include "HROOTIOTFile.h" + +#include "TMemFile.h" + +#include "HROOTIOTMemFile.h" + +using namespace ROOT; + +#define CHECKPROTECT(x,y) FXIS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) + +#define TYPECASTMETHOD(cname,mname,oname) \ + FXIIF( CHECKPROTECT(cname,mname) ) ( \ + (from_nonconst_to_nonconst), \ + (from_nonconst_to_nonconst) ) + +TFILE_DEF_VIRT(TMemFile) +TDIRECTORYFILE_DEF_VIRT(TMemFile) +TDIRECTORY_DEF_VIRT(TMemFile) +TNAMED_DEF_VIRT(TMemFile) +TOBJECT_DEF_VIRT(TMemFile) +DELETABLE_DEF_VIRT(TMemFile) +TMEMFILE_DEF_VIRT(TMemFile) +TMEMFILE_DEF_NONVIRT(TMemFile) +TMEMFILE_DEF_ACCESSOR(TMemFile) + diff --git a/csrc/HROOTIOTMemFile.h b/csrc/HROOTIOTMemFile.h new file mode 100644 --- /dev/null +++ b/csrc/HROOTIOTMemFile.h @@ -0,0 +1,63 @@ + +#ifdef __cplusplus +extern "C" { +#endif + +#pragma once + + +#include "HROOT-ioType.h" + +#include "HROOTIOTFile.h" + +#include "HROOTIOTDirectoryFile.h" + +#include "HROOTCoreTDirectory.h" + +#include "HROOTCoreTNamed.h" + +#include "HROOTCoreTObject.h" + +#include "STDDeletable.h" + + +#define TMEMFILE_DECL_VIRT(Type) \ + + + +#define TMEMFILE_DECL_NONVIRT(Type) \ +Type##_p Type##_newTMemFile ( const char* path, const char* option, const char* ftitle, int compress ); + + +#define TMEMFILE_DECL_ACCESSOR(Type) \ + + + +#define TMEMFILE_DEF_VIRT(Type) \ + + + +#define TMEMFILE_DEF_NONVIRT(Type) \ +Type##_p Type##_newTMemFile ( const char* path, const char* option, const char* ftitle, int compress ) {\ +Type* newp=new Type(path, option, ftitle, compress);return from_nonconst_to_nonconst(newp);\ +} + + +#define TMEMFILE_DEF_ACCESSOR(Type) \ + + + +TFILE_DECL_VIRT(TMemFile) +TDIRECTORYFILE_DECL_VIRT(TMemFile) +TDIRECTORY_DECL_VIRT(TMemFile) +TNAMED_DECL_VIRT(TMemFile) +TOBJECT_DECL_VIRT(TMemFile) +DELETABLE_DECL_VIRT(TMemFile) +TMEMFILE_DECL_VIRT(TMemFile) +TMEMFILE_DECL_NONVIRT(TMemFile) +TMEMFILE_DECL_ACCESSOR(TMemFile) + +#ifdef __cplusplus +} +#endif + diff --git a/src/HROOT/IO.hs b/src/HROOT/IO.hs --- a/src/HROOT/IO.hs +++ b/src/HROOT/IO.hs @@ -1,11 +1,13 @@ -module HROOT.IO ( - module HROOT.IO.TDirectoryFile -, module HROOT.IO.TFile -) where - +{-# LANGUAGE FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, InterruptibleFFI #-} +module HROOT.IO + (module HROOT.IO.TDirectoryFile, module HROOT.IO.TFile, + module HROOT.IO.TMemFile, module HROOT.IO.Ordinary, + module HROOT.IO.Template, module HROOT.IO.TH) + where import HROOT.IO.TDirectoryFile import HROOT.IO.TFile - - - - +import HROOT.IO.TMemFile +import HROOT.IO.Template +import HROOT.IO.TH +import HROOT.IO.Ordinary diff --git a/src/HROOT/IO/Ordinary.hs b/src/HROOT/IO/Ordinary.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/IO/Ordinary.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, InterruptibleFFI #-} +module HROOT.IO.Ordinary () where +import Foreign.C +import Foreign.Ptr +import FFICXX.Runtime.Cast diff --git a/src/HROOT/IO/TDirectoryFile/Cast.hs b/src/HROOT/IO/TDirectoryFile/Cast.hs --- a/src/HROOT/IO/TDirectoryFile/Cast.hs +++ b/src/HROOT/IO/TDirectoryFile/Cast.hs @@ -8,11 +8,13 @@ import HROOT.IO.TDirectoryFile.RawType import HROOT.IO.TDirectoryFile.Interface -instance (ITDirectoryFile a, FPtr a) => Castable a - (Ptr RawTDirectoryFile) where +instance (ITDirectoryFile a, FPtr a) => + Castable (a) (Ptr RawTDirectoryFile) + where cast x f = f (castPtr (get_fptr x)) uncast x f = f (cast_fptr_to_obj (castPtr x)) -instance Castable TDirectoryFile (Ptr RawTDirectoryFile) where +instance () => Castable (TDirectoryFile) (Ptr RawTDirectoryFile) + where cast x f = f (castPtr (get_fptr x)) uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/IO/TDirectoryFile/FFI.hsc b/src/HROOT/IO/TDirectoryFile/FFI.hsc --- a/src/HROOT/IO/TDirectoryFile/FFI.hsc +++ b/src/HROOT/IO/TDirectoryFile/FFI.hsc @@ -1,90 +1,101 @@ -{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE ForeignFunctionInterface, InterruptibleFFI #-} module HROOT.IO.TDirectoryFile.FFI where +import Data.Word +import Data.Int import Foreign.C import Foreign.Ptr import HROOT.IO.TDirectoryFile.RawType +import HROOT.IO.TDirectoryFile.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TKey.RawType import HROOT.Core.TClass.RawType -foreign import ccall safe +foreign import ccall interruptible "HROOTIOTDirectoryFile.h TDirectoryFile_Append" c_tdirectoryfile_append :: - Ptr RawTDirectoryFile -> Ptr RawTObject -> CInt -> IO () + Ptr RawTDirectoryFile -> Ptr RawTObject -> CBool -> IO () -foreign import ccall safe +foreign import ccall interruptible "HROOTIOTDirectoryFile.h TDirectoryFile_addD" c_tdirectoryfile_addd - :: Ptr RawTDirectoryFile -> Ptr RawTObject -> CInt -> IO () + :: Ptr RawTDirectoryFile -> Ptr RawTObject -> CBool -> IO () -foreign import ccall safe +foreign import ccall interruptible "HROOTIOTDirectoryFile.h TDirectoryFile_AppendKey" c_tdirectoryfile_appendkey :: Ptr RawTDirectoryFile -> Ptr RawTKey -> IO CInt -foreign import ccall safe +foreign import ccall interruptible "HROOTIOTDirectoryFile.h TDirectoryFile_Close" c_tdirectoryfile_close :: Ptr RawTDirectoryFile -> CString -> IO () -foreign import ccall safe +foreign import ccall interruptible "HROOTIOTDirectoryFile.h TDirectoryFile_Get" c_tdirectoryfile_get :: Ptr RawTDirectoryFile -> CString -> IO (Ptr RawTObject) -foreign import ccall safe +foreign import ccall interruptible "HROOTIOTDirectoryFile.h TDirectoryFile_cd_TDirectory" c_tdirectoryfile_cd_tdirectory :: - Ptr RawTDirectoryFile -> CString -> IO CInt + Ptr RawTDirectoryFile -> CString -> IO CBool -foreign import ccall safe +foreign import ccall interruptible "HROOTIOTDirectoryFile.h TDirectoryFile_SetName" c_tdirectoryfile_setname :: Ptr RawTDirectoryFile -> CString -> IO () -foreign import ccall safe +foreign import ccall interruptible "HROOTIOTDirectoryFile.h TDirectoryFile_SetNameTitle" c_tdirectoryfile_setnametitle :: Ptr RawTDirectoryFile -> CString -> CString -> IO () -foreign import ccall safe +foreign import ccall interruptible "HROOTIOTDirectoryFile.h TDirectoryFile_SetTitle" c_tdirectoryfile_settitle :: Ptr RawTDirectoryFile -> CString -> IO () -foreign import ccall safe +foreign import ccall interruptible + "HROOTIOTDirectoryFile.h TDirectoryFile_Clear" + c_tdirectoryfile_clear :: Ptr RawTDirectoryFile -> CString -> IO () + +foreign import ccall interruptible "HROOTIOTDirectoryFile.h TDirectoryFile_Draw" c_tdirectoryfile_draw :: Ptr RawTDirectoryFile -> CString -> IO () -foreign import ccall safe +foreign import ccall interruptible "HROOTIOTDirectoryFile.h TDirectoryFile_FindObject" c_tdirectoryfile_findobject :: Ptr RawTDirectoryFile -> CString -> IO (Ptr RawTObject) -foreign import ccall safe +foreign import ccall interruptible "HROOTIOTDirectoryFile.h TDirectoryFile_GetName" c_tdirectoryfile_getname :: Ptr RawTDirectoryFile -> IO CString -foreign import ccall safe +foreign import ccall interruptible "HROOTIOTDirectoryFile.h TDirectoryFile_IsA" c_tdirectoryfile_isa :: Ptr RawTDirectoryFile -> IO (Ptr RawTClass) -foreign import ccall safe +foreign import ccall interruptible "HROOTIOTDirectoryFile.h TDirectoryFile_Paint" c_tdirectoryfile_paint :: Ptr RawTDirectoryFile -> CString -> IO () -foreign import ccall safe +foreign import ccall interruptible "HROOTIOTDirectoryFile.h TDirectoryFile_printObj" c_tdirectoryfile_printobj :: Ptr RawTDirectoryFile -> CString -> IO () -foreign import ccall safe +foreign import ccall interruptible "HROOTIOTDirectoryFile.h TDirectoryFile_SaveAs" c_tdirectoryfile_saveas :: Ptr RawTDirectoryFile -> CString -> CString -> IO () -foreign import ccall safe +foreign import ccall interruptible "HROOTIOTDirectoryFile.h TDirectoryFile_Write" c_tdirectoryfile_write :: Ptr RawTDirectoryFile -> CString -> CInt -> CInt -> IO CInt -foreign import ccall safe +foreign import ccall interruptible + "HROOTIOTDirectoryFile.h TDirectoryFile_Write_" + c_tdirectoryfile_write_ :: Ptr RawTDirectoryFile -> IO CInt + +foreign import ccall interruptible "HROOTIOTDirectoryFile.h TDirectoryFile_delete" c_tdirectoryfile_delete :: Ptr RawTDirectoryFile -> IO () diff --git a/src/HROOT/IO/TDirectoryFile/Implementation.hs b/src/HROOT/IO/TDirectoryFile/Implementation.hs --- a/src/HROOT/IO/TDirectoryFile/Implementation.hs +++ b/src/HROOT/IO/TDirectoryFile/Implementation.hs @@ -1,17 +1,26 @@ {-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, IncoherentInstances, - MultiParamTypeClasses, OverlappingInstances, TypeFamilies, - TypeSynonymInstances #-} + MultiParamTypeClasses, OverlappingInstances, TemplateHaskell, + TypeFamilies, TypeSynonymInstances #-} module HROOT.IO.TDirectoryFile.Implementation where -import FFICXX.Runtime.Cast +import Data.Monoid import Data.Word +import Data.Int import Foreign.C import Foreign.Ptr +import Language.Haskell.TH +import Language.Haskell.TH.Syntax import System.IO.Unsafe +import FFICXX.Runtime.Cast +import FFICXX.Runtime.CodeGen.Cxx +import FFICXX.Runtime.TH import HROOT.IO.TDirectoryFile.RawType import HROOT.IO.TDirectoryFile.FFI import HROOT.IO.TDirectoryFile.Interface import HROOT.IO.TDirectoryFile.Cast +import HROOT.IO.TDirectoryFile.RawType +import HROOT.IO.TDirectoryFile.Cast +import HROOT.IO.TDirectoryFile.Interface import HROOT.Core.TKey.RawType import HROOT.Core.TKey.Cast import HROOT.Core.TKey.Interface @@ -27,13 +36,13 @@ import HROOT.Core.TObject.RawType import HROOT.Core.TObject.Cast import HROOT.Core.TObject.Interface -import HROOT.Core.Deletable.RawType -import HROOT.Core.Deletable.Cast -import HROOT.Core.Deletable.Interface +import STD.Deletable.RawType +import STD.Deletable.Cast +import STD.Deletable.Interface -instance ITDirectoryFile TDirectoryFile +instance () => ITDirectoryFile (TDirectoryFile) where -instance ITDirectory TDirectoryFile where +instance () => ITDirectory (TDirectoryFile) where append = xform2 c_tdirectoryfile_append addD = xform2 c_tdirectoryfile_addd appendKey = xform1 c_tdirectoryfile_appendkey @@ -41,12 +50,13 @@ get = xform1 c_tdirectoryfile_get cd_TDirectory = xform1 c_tdirectoryfile_cd_tdirectory -instance ITNamed TDirectoryFile where +instance () => ITNamed (TDirectoryFile) where setName = xform1 c_tdirectoryfile_setname setNameTitle = xform2 c_tdirectoryfile_setnametitle setTitle = xform1 c_tdirectoryfile_settitle -instance ITObject TDirectoryFile where +instance () => ITObject (TDirectoryFile) where + clear = xform1 c_tdirectoryfile_clear draw = xform1 c_tdirectoryfile_draw findObject = xform1 c_tdirectoryfile_findobject getName = xform0 c_tdirectoryfile_getname @@ -55,6 +65,7 @@ printObj = xform1 c_tdirectoryfile_printobj saveAs = xform2 c_tdirectoryfile_saveas write = xform3 c_tdirectoryfile_write + write_ = xform0 c_tdirectoryfile_write_ -instance IDeletable TDirectoryFile where +instance () => IDeletable (TDirectoryFile) where delete = xform0 c_tdirectoryfile_delete diff --git a/src/HROOT/IO/TDirectoryFile/Interface.hs b/src/HROOT/IO/TDirectoryFile/Interface.hs --- a/src/HROOT/IO/TDirectoryFile/Interface.hs +++ b/src/HROOT/IO/TDirectoryFile/Interface.hs @@ -4,13 +4,14 @@ TypeSynonymInstances #-} module HROOT.IO.TDirectoryFile.Interface where import Data.Word +import Data.Int import Foreign.C import Foreign.Ptr import FFICXX.Runtime.Cast import HROOT.IO.TDirectoryFile.RawType import HROOT.Core.TDirectory.Interface -class ITDirectory a => ITDirectoryFile a +class (ITDirectory a) => ITDirectoryFile a where upcastTDirectoryFile :: forall a . (FPtr a, ITDirectoryFile a) => a -> TDirectoryFile diff --git a/src/HROOT/IO/TDirectoryFile/RawType.hs b/src/HROOT/IO/TDirectoryFile/RawType.hs --- a/src/HROOT/IO/TDirectoryFile/RawType.hs +++ b/src/HROOT/IO/TDirectoryFile/RawType.hs @@ -8,9 +8,9 @@ data RawTDirectoryFile newtype TDirectoryFile = TDirectoryFile (Ptr RawTDirectoryFile) - deriving (Eq, Ord, Show) + deriving (Eq, Ord, Show) -instance FPtr TDirectoryFile where +instance () => FPtr (TDirectoryFile) where type Raw TDirectoryFile = RawTDirectoryFile get_fptr (TDirectoryFile ptr) = ptr cast_fptr_to_obj = TDirectoryFile diff --git a/src/HROOT/IO/TFile/Cast.hs b/src/HROOT/IO/TFile/Cast.hs --- a/src/HROOT/IO/TFile/Cast.hs +++ b/src/HROOT/IO/TFile/Cast.hs @@ -8,10 +8,10 @@ import HROOT.IO.TFile.RawType import HROOT.IO.TFile.Interface -instance (ITFile a, FPtr a) => Castable a (Ptr RawTFile) where +instance (ITFile a, FPtr a) => Castable (a) (Ptr RawTFile) where cast x f = f (castPtr (get_fptr x)) uncast x f = f (cast_fptr_to_obj (castPtr x)) -instance Castable TFile (Ptr RawTFile) where +instance () => Castable (TFile) (Ptr RawTFile) where cast x f = f (castPtr (get_fptr x)) uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/IO/TFile/FFI.hsc b/src/HROOT/IO/TFile/FFI.hsc --- a/src/HROOT/IO/TFile/FFI.hsc +++ b/src/HROOT/IO/TFile/FFI.hsc @@ -1,67 +1,78 @@ -{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE ForeignFunctionInterface, InterruptibleFFI #-} module HROOT.IO.TFile.FFI where +import Data.Word +import Data.Int import Foreign.C import Foreign.Ptr import HROOT.IO.TFile.RawType +import HROOT.IO.TFile.RawType import HROOT.Core.TObject.RawType import HROOT.Core.TKey.RawType import HROOT.Core.TClass.RawType -foreign import ccall safe "HROOTIOTFile.h TFile_Append" - c_tfile_append :: Ptr RawTFile -> Ptr RawTObject -> CInt -> IO () +foreign import ccall interruptible "HROOTIOTFile.h TFile_Append" + c_tfile_append :: Ptr RawTFile -> Ptr RawTObject -> CBool -> IO () -foreign import ccall safe "HROOTIOTFile.h TFile_addD" c_tfile_addd - :: Ptr RawTFile -> Ptr RawTObject -> CInt -> IO () +foreign import ccall interruptible "HROOTIOTFile.h TFile_addD" + c_tfile_addd :: Ptr RawTFile -> Ptr RawTObject -> CBool -> IO () -foreign import ccall safe "HROOTIOTFile.h TFile_AppendKey" +foreign import ccall interruptible "HROOTIOTFile.h TFile_AppendKey" c_tfile_appendkey :: Ptr RawTFile -> Ptr RawTKey -> IO CInt -foreign import ccall safe "HROOTIOTFile.h TFile_Close" +foreign import ccall interruptible "HROOTIOTFile.h TFile_Close" c_tfile_close :: Ptr RawTFile -> CString -> IO () -foreign import ccall safe "HROOTIOTFile.h TFile_Get" c_tfile_get :: - Ptr RawTFile -> CString -> IO (Ptr RawTObject) +foreign import ccall interruptible "HROOTIOTFile.h TFile_Get" + c_tfile_get :: Ptr RawTFile -> CString -> IO (Ptr RawTObject) -foreign import ccall safe "HROOTIOTFile.h TFile_cd_TDirectory" - c_tfile_cd_tdirectory :: Ptr RawTFile -> CString -> IO CInt +foreign import ccall interruptible + "HROOTIOTFile.h TFile_cd_TDirectory" c_tfile_cd_tdirectory :: + Ptr RawTFile -> CString -> IO CBool -foreign import ccall safe "HROOTIOTFile.h TFile_SetName" +foreign import ccall interruptible "HROOTIOTFile.h TFile_SetName" c_tfile_setname :: Ptr RawTFile -> CString -> IO () -foreign import ccall safe "HROOTIOTFile.h TFile_SetNameTitle" - c_tfile_setnametitle :: Ptr RawTFile -> CString -> CString -> IO () +foreign import ccall interruptible + "HROOTIOTFile.h TFile_SetNameTitle" c_tfile_setnametitle :: + Ptr RawTFile -> CString -> CString -> IO () -foreign import ccall safe "HROOTIOTFile.h TFile_SetTitle" +foreign import ccall interruptible "HROOTIOTFile.h TFile_SetTitle" c_tfile_settitle :: Ptr RawTFile -> CString -> IO () -foreign import ccall safe "HROOTIOTFile.h TFile_Draw" c_tfile_draw - :: Ptr RawTFile -> CString -> IO () +foreign import ccall interruptible "HROOTIOTFile.h TFile_Clear" + c_tfile_clear :: Ptr RawTFile -> CString -> IO () -foreign import ccall safe "HROOTIOTFile.h TFile_FindObject" - c_tfile_findobject :: +foreign import ccall interruptible "HROOTIOTFile.h TFile_Draw" + c_tfile_draw :: Ptr RawTFile -> CString -> IO () + +foreign import ccall interruptible + "HROOTIOTFile.h TFile_FindObject" c_tfile_findobject :: Ptr RawTFile -> CString -> IO (Ptr RawTObject) -foreign import ccall safe "HROOTIOTFile.h TFile_GetName" +foreign import ccall interruptible "HROOTIOTFile.h TFile_GetName" c_tfile_getname :: Ptr RawTFile -> IO CString -foreign import ccall safe "HROOTIOTFile.h TFile_IsA" c_tfile_isa :: - Ptr RawTFile -> IO (Ptr RawTClass) +foreign import ccall interruptible "HROOTIOTFile.h TFile_IsA" + c_tfile_isa :: Ptr RawTFile -> IO (Ptr RawTClass) -foreign import ccall safe "HROOTIOTFile.h TFile_Paint" +foreign import ccall interruptible "HROOTIOTFile.h TFile_Paint" c_tfile_paint :: Ptr RawTFile -> CString -> IO () -foreign import ccall safe "HROOTIOTFile.h TFile_printObj" +foreign import ccall interruptible "HROOTIOTFile.h TFile_printObj" c_tfile_printobj :: Ptr RawTFile -> CString -> IO () -foreign import ccall safe "HROOTIOTFile.h TFile_SaveAs" +foreign import ccall interruptible "HROOTIOTFile.h TFile_SaveAs" c_tfile_saveas :: Ptr RawTFile -> CString -> CString -> IO () -foreign import ccall safe "HROOTIOTFile.h TFile_Write" +foreign import ccall interruptible "HROOTIOTFile.h TFile_Write" c_tfile_write :: Ptr RawTFile -> CString -> CInt -> CInt -> IO CInt -foreign import ccall safe "HROOTIOTFile.h TFile_delete" +foreign import ccall interruptible "HROOTIOTFile.h TFile_Write_" + c_tfile_write_ :: Ptr RawTFile -> IO CInt + +foreign import ccall interruptible "HROOTIOTFile.h TFile_delete" c_tfile_delete :: Ptr RawTFile -> IO () -foreign import ccall safe "HROOTIOTFile.h TFile_newTFile" +foreign import ccall interruptible "HROOTIOTFile.h TFile_newTFile" c_tfile_newtfile :: CString -> CString -> CString -> CInt -> IO (Ptr RawTFile) diff --git a/src/HROOT/IO/TFile/Implementation.hs b/src/HROOT/IO/TFile/Implementation.hs --- a/src/HROOT/IO/TFile/Implementation.hs +++ b/src/HROOT/IO/TFile/Implementation.hs @@ -1,17 +1,26 @@ {-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, IncoherentInstances, - MultiParamTypeClasses, OverlappingInstances, TypeFamilies, - TypeSynonymInstances #-} + MultiParamTypeClasses, OverlappingInstances, TemplateHaskell, + TypeFamilies, TypeSynonymInstances #-} module HROOT.IO.TFile.Implementation where -import FFICXX.Runtime.Cast +import Data.Monoid import Data.Word +import Data.Int import Foreign.C import Foreign.Ptr +import Language.Haskell.TH +import Language.Haskell.TH.Syntax import System.IO.Unsafe +import FFICXX.Runtime.Cast +import FFICXX.Runtime.CodeGen.Cxx +import FFICXX.Runtime.TH import HROOT.IO.TFile.RawType import HROOT.IO.TFile.FFI import HROOT.IO.TFile.Interface import HROOT.IO.TFile.Cast +import HROOT.IO.TFile.RawType +import HROOT.IO.TFile.Cast +import HROOT.IO.TFile.Interface import HROOT.Core.TKey.RawType import HROOT.Core.TKey.Cast import HROOT.Core.TKey.Interface @@ -30,15 +39,15 @@ import HROOT.Core.TObject.RawType import HROOT.Core.TObject.Cast import HROOT.Core.TObject.Interface -import HROOT.Core.Deletable.RawType -import HROOT.Core.Deletable.Cast -import HROOT.Core.Deletable.Interface +import STD.Deletable.RawType +import STD.Deletable.Cast +import STD.Deletable.Interface -instance ITFile TFile +instance () => ITFile (TFile) where -instance ITDirectoryFile TFile +instance () => ITDirectoryFile (TFile) where -instance ITDirectory TFile where +instance () => ITDirectory (TFile) where append = xform2 c_tfile_append addD = xform2 c_tfile_addd appendKey = xform1 c_tfile_appendkey @@ -46,12 +55,13 @@ get = xform1 c_tfile_get cd_TDirectory = xform1 c_tfile_cd_tdirectory -instance ITNamed TFile where +instance () => ITNamed (TFile) where setName = xform1 c_tfile_setname setNameTitle = xform2 c_tfile_setnametitle setTitle = xform1 c_tfile_settitle -instance ITObject TFile where +instance () => ITObject (TFile) where + clear = xform1 c_tfile_clear draw = xform1 c_tfile_draw findObject = xform1 c_tfile_findobject getName = xform0 c_tfile_getname @@ -60,8 +70,9 @@ printObj = xform1 c_tfile_printobj saveAs = xform2 c_tfile_saveas write = xform3 c_tfile_write + write_ = xform0 c_tfile_write_ -instance IDeletable TFile where +instance () => IDeletable (TFile) where delete = xform0 c_tfile_delete newTFile :: diff --git a/src/HROOT/IO/TFile/Interface.hs b/src/HROOT/IO/TFile/Interface.hs --- a/src/HROOT/IO/TFile/Interface.hs +++ b/src/HROOT/IO/TFile/Interface.hs @@ -4,13 +4,14 @@ TypeSynonymInstances #-} module HROOT.IO.TFile.Interface where import Data.Word +import Data.Int import Foreign.C import Foreign.Ptr import FFICXX.Runtime.Cast import HROOT.IO.TFile.RawType import HROOT.IO.TDirectoryFile.Interface -class ITDirectoryFile a => ITFile a +class (ITDirectoryFile a) => ITFile a where upcastTFile :: forall a . (FPtr a, ITFile a) => a -> TFile upcastTFile h diff --git a/src/HROOT/IO/TFile/RawType.hs b/src/HROOT/IO/TFile/RawType.hs --- a/src/HROOT/IO/TFile/RawType.hs +++ b/src/HROOT/IO/TFile/RawType.hs @@ -8,9 +8,9 @@ data RawTFile newtype TFile = TFile (Ptr RawTFile) - deriving (Eq, Ord, Show) + deriving (Eq, Ord, Show) -instance FPtr TFile where +instance () => FPtr (TFile) where type Raw TFile = RawTFile get_fptr (TFile ptr) = ptr cast_fptr_to_obj = TFile diff --git a/src/HROOT/IO/TH.hs b/src/HROOT/IO/TH.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/IO/TH.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, InterruptibleFFI, TemplateHaskell #-} +module HROOT.IO.TH () where +import Data.Char +import Data.List +import Data.Monoid +import Foreign.C.Types +import Foreign.Ptr +import Language.Haskell.TH +import Language.Haskell.TH.Syntax +import FFICXX.Runtime.CodeGen.Cxx +import FFICXX.Runtime.TH diff --git a/src/HROOT/IO/TMemFile.hs b/src/HROOT/IO/TMemFile.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/IO/TMemFile.hs @@ -0,0 +1,7 @@ +module HROOT.IO.TMemFile + (TMemFile(..), ITMemFile, upcastTMemFile, downcastTMemFile, + newTMemFile) + where +import HROOT.IO.TMemFile.RawType +import HROOT.IO.TMemFile.Interface +import HROOT.IO.TMemFile.Implementation diff --git a/src/HROOT/IO/TMemFile/Cast.hs b/src/HROOT/IO/TMemFile/Cast.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/IO/TMemFile/Cast.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} +module HROOT.IO.TMemFile.Cast where +import Foreign.Ptr +import FFICXX.Runtime.Cast +import System.IO.Unsafe +import HROOT.IO.TMemFile.RawType +import HROOT.IO.TMemFile.Interface + +instance (ITMemFile a, FPtr a) => Castable (a) (Ptr RawTMemFile) + where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) + +instance () => Castable (TMemFile) (Ptr RawTMemFile) where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/HROOT/IO/TMemFile/FFI.hsc b/src/HROOT/IO/TMemFile/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/HROOT/IO/TMemFile/FFI.hsc @@ -0,0 +1,93 @@ +{-# LANGUAGE ForeignFunctionInterface, InterruptibleFFI #-} +module HROOT.IO.TMemFile.FFI where +import Data.Word +import Data.Int +import Foreign.C +import Foreign.Ptr +import HROOT.IO.TMemFile.RawType +import HROOT.IO.TMemFile.RawType +import HROOT.Core.TObject.RawType +import HROOT.Core.TKey.RawType +import HROOT.Core.TClass.RawType + +foreign import ccall interruptible + "HROOTIOTMemFile.h TMemFile_Append" c_tmemfile_append :: + Ptr RawTMemFile -> Ptr RawTObject -> CBool -> IO () + +foreign import ccall interruptible + "HROOTIOTMemFile.h TMemFile_addD" c_tmemfile_addd :: + Ptr RawTMemFile -> Ptr RawTObject -> CBool -> IO () + +foreign import ccall interruptible + "HROOTIOTMemFile.h TMemFile_AppendKey" c_tmemfile_appendkey :: + Ptr RawTMemFile -> Ptr RawTKey -> IO CInt + +foreign import ccall interruptible + "HROOTIOTMemFile.h TMemFile_Close" c_tmemfile_close :: + Ptr RawTMemFile -> CString -> IO () + +foreign import ccall interruptible "HROOTIOTMemFile.h TMemFile_Get" + c_tmemfile_get :: Ptr RawTMemFile -> CString -> IO (Ptr RawTObject) + +foreign import ccall interruptible + "HROOTIOTMemFile.h TMemFile_cd_TDirectory" c_tmemfile_cd_tdirectory + :: Ptr RawTMemFile -> CString -> IO CBool + +foreign import ccall interruptible + "HROOTIOTMemFile.h TMemFile_SetName" c_tmemfile_setname :: + Ptr RawTMemFile -> CString -> IO () + +foreign import ccall interruptible + "HROOTIOTMemFile.h TMemFile_SetNameTitle" c_tmemfile_setnametitle + :: Ptr RawTMemFile -> CString -> CString -> IO () + +foreign import ccall interruptible + "HROOTIOTMemFile.h TMemFile_SetTitle" c_tmemfile_settitle :: + Ptr RawTMemFile -> CString -> IO () + +foreign import ccall interruptible + "HROOTIOTMemFile.h TMemFile_Clear" c_tmemfile_clear :: + Ptr RawTMemFile -> CString -> IO () + +foreign import ccall interruptible + "HROOTIOTMemFile.h TMemFile_Draw" c_tmemfile_draw :: + Ptr RawTMemFile -> CString -> IO () + +foreign import ccall interruptible + "HROOTIOTMemFile.h TMemFile_FindObject" c_tmemfile_findobject :: + Ptr RawTMemFile -> CString -> IO (Ptr RawTObject) + +foreign import ccall interruptible + "HROOTIOTMemFile.h TMemFile_GetName" c_tmemfile_getname :: + Ptr RawTMemFile -> IO CString + +foreign import ccall interruptible "HROOTIOTMemFile.h TMemFile_IsA" + c_tmemfile_isa :: Ptr RawTMemFile -> IO (Ptr RawTClass) + +foreign import ccall interruptible + "HROOTIOTMemFile.h TMemFile_Paint" c_tmemfile_paint :: + Ptr RawTMemFile -> CString -> IO () + +foreign import ccall interruptible + "HROOTIOTMemFile.h TMemFile_printObj" c_tmemfile_printobj :: + Ptr RawTMemFile -> CString -> IO () + +foreign import ccall interruptible + "HROOTIOTMemFile.h TMemFile_SaveAs" c_tmemfile_saveas :: + Ptr RawTMemFile -> CString -> CString -> IO () + +foreign import ccall interruptible + "HROOTIOTMemFile.h TMemFile_Write" c_tmemfile_write :: + Ptr RawTMemFile -> CString -> CInt -> CInt -> IO CInt + +foreign import ccall interruptible + "HROOTIOTMemFile.h TMemFile_Write_" c_tmemfile_write_ :: + Ptr RawTMemFile -> IO CInt + +foreign import ccall interruptible + "HROOTIOTMemFile.h TMemFile_delete" c_tmemfile_delete :: + Ptr RawTMemFile -> IO () + +foreign import ccall interruptible + "HROOTIOTMemFile.h TMemFile_newTMemFile" c_tmemfile_newtmemfile :: + CString -> CString -> CString -> CInt -> IO (Ptr RawTMemFile) diff --git a/src/HROOT/IO/TMemFile/Implementation.hs b/src/HROOT/IO/TMemFile/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/IO/TMemFile/Implementation.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TemplateHaskell, + TypeFamilies, TypeSynonymInstances #-} +module HROOT.IO.TMemFile.Implementation where +import Data.Monoid +import Data.Word +import Data.Int +import Foreign.C +import Foreign.Ptr +import Language.Haskell.TH +import Language.Haskell.TH.Syntax +import System.IO.Unsafe +import FFICXX.Runtime.Cast +import FFICXX.Runtime.CodeGen.Cxx +import FFICXX.Runtime.TH +import HROOT.IO.TMemFile.RawType +import HROOT.IO.TMemFile.FFI +import HROOT.IO.TMemFile.Interface +import HROOT.IO.TMemFile.Cast +import HROOT.IO.TMemFile.RawType +import HROOT.IO.TMemFile.Cast +import HROOT.IO.TMemFile.Interface +import HROOT.Core.TKey.RawType +import HROOT.Core.TKey.Cast +import HROOT.Core.TKey.Interface +import HROOT.Core.TClass.RawType +import HROOT.Core.TClass.Cast +import HROOT.Core.TClass.Interface +import HROOT.IO.TFile.RawType +import HROOT.IO.TFile.Cast +import HROOT.IO.TFile.Interface +import HROOT.IO.TDirectoryFile.RawType +import HROOT.IO.TDirectoryFile.Cast +import HROOT.IO.TDirectoryFile.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 +import HROOT.Core.TObject.RawType +import HROOT.Core.TObject.Cast +import HROOT.Core.TObject.Interface +import STD.Deletable.RawType +import STD.Deletable.Cast +import STD.Deletable.Interface + +instance () => ITMemFile (TMemFile) where + +instance () => ITFile (TMemFile) where + +instance () => ITDirectoryFile (TMemFile) where + +instance () => ITDirectory (TMemFile) where + append = xform2 c_tmemfile_append + addD = xform2 c_tmemfile_addd + appendKey = xform1 c_tmemfile_appendkey + close = xform1 c_tmemfile_close + get = xform1 c_tmemfile_get + cd_TDirectory = xform1 c_tmemfile_cd_tdirectory + +instance () => ITNamed (TMemFile) where + setName = xform1 c_tmemfile_setname + setNameTitle = xform2 c_tmemfile_setnametitle + setTitle = xform1 c_tmemfile_settitle + +instance () => ITObject (TMemFile) where + clear = xform1 c_tmemfile_clear + draw = xform1 c_tmemfile_draw + findObject = xform1 c_tmemfile_findobject + getName = xform0 c_tmemfile_getname + isA = xform0 c_tmemfile_isa + paint = xform1 c_tmemfile_paint + printObj = xform1 c_tmemfile_printobj + saveAs = xform2 c_tmemfile_saveas + write = xform3 c_tmemfile_write + write_ = xform0 c_tmemfile_write_ + +instance () => IDeletable (TMemFile) where + delete = xform0 c_tmemfile_delete + +newTMemFile :: + (Castable c2 CString, Castable c1 CString, Castable c0 CString) => + c0 -> c1 -> c2 -> CInt -> IO TMemFile +newTMemFile = xform3 c_tmemfile_newtmemfile diff --git a/src/HROOT/IO/TMemFile/Interface.hs b/src/HROOT/IO/TMemFile/Interface.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/IO/TMemFile/Interface.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} +module HROOT.IO.TMemFile.Interface where +import Data.Word +import Data.Int +import Foreign.C +import Foreign.Ptr +import FFICXX.Runtime.Cast +import HROOT.IO.TMemFile.RawType +import HROOT.IO.TFile.Interface + +class (ITFile a) => ITMemFile a where + +upcastTMemFile :: forall a . (FPtr a, ITMemFile a) => a -> TMemFile +upcastTMemFile h + = let fh = get_fptr h + fh2 :: Ptr RawTMemFile = castPtr fh + in cast_fptr_to_obj fh2 + +downcastTMemFile :: + forall a . (FPtr a, ITMemFile a) => TMemFile -> a +downcastTMemFile h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/HROOT/IO/TMemFile/RawType.hs b/src/HROOT/IO/TMemFile/RawType.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/IO/TMemFile/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} +module HROOT.IO.TMemFile.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast + +data RawTMemFile + +newtype TMemFile = TMemFile (Ptr RawTMemFile) + deriving (Eq, Ord, Show) + +instance () => FPtr (TMemFile) where + type Raw TMemFile = RawTMemFile + get_fptr (TMemFile ptr) = ptr + cast_fptr_to_obj = TMemFile diff --git a/src/HROOT/IO/Template.hs b/src/HROOT/IO/Template.hs new file mode 100644 --- /dev/null +++ b/src/HROOT/IO/Template.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE EmptyDataDecls, FlexibleInstances, + ForeignFunctionInterface, InterruptibleFFI, MultiParamTypeClasses, + TypeFamilies #-} +module HROOT.IO.Template () where +import Foreign.C.Types +import Foreign.Ptr +import FFICXX.Runtime.Cast