From b6bddad8aa9581278b618e2340ac34fc8eca782e Mon Sep 17 00:00:00 2001 From: =?utf8?q?Picca=20Fr=C3=A9d=C3=A9ric-Emmanuel?= Date: Wed, 5 Apr 2017 17:41:01 +0200 Subject: [PATCH] [contrib][haskell] add the Hkl.C.Engine --- contrib/haskell/hkl.cabal | 1 + contrib/haskell/src/Hkl/C.hsc | 60 ++------------------------ contrib/haskell/src/Hkl/C/Engine.hsc | 81 ++++++++++++++++++++++++++++++++++++ 3 files changed, 85 insertions(+), 57 deletions(-) create mode 100644 contrib/haskell/src/Hkl/C/Engine.hsc diff --git a/contrib/haskell/hkl.cabal b/contrib/haskell/hkl.cabal index e81ccb8f..320d0de3 100644 --- a/contrib/haskell/hkl.cabal +++ b/contrib/haskell/hkl.cabal @@ -96,6 +96,7 @@ library , Hkl.C , Hkl.C.DArray , Hkl.C.Detector + , Hkl.C.Engine , Hkl.C.Geometry , Hkl.C.GeometryList , Hkl.C.Lattice diff --git a/contrib/haskell/src/Hkl/C.hsc b/contrib/haskell/src/Hkl/C.hsc index 9d70eaa6..f258a605 100644 --- a/contrib/haskell/src/Hkl/C.hsc +++ b/contrib/haskell/src/Hkl/C.hsc @@ -23,14 +23,15 @@ import Foreign ( ForeignPtr , withForeignPtr , peekArray , withArray) -import Foreign.C (CInt(..), CSize(..), CString, - peekCString, withCString) +import Foreign.C ( CInt(..), CSize(..), CString + , withCString) import Foreign.Storable import Pipes (Pipe, await, lift, yield) import Hkl.C.DArray as X import Hkl.C.Detector as X +import Hkl.C.Engine as X import Hkl.C.Geometry as X import Hkl.C.GeometryList as X import Hkl.C.Lattice as X @@ -42,7 +43,6 @@ import Hkl.Types -- private types -data HklEngine data HklEngineList -- Engine @@ -66,9 +66,6 @@ solve g@(Geometry f _ _ _) d s e@(Engine name _ _) = do engine <- c_hkl_engine_list_engine_get_by_name engines cname nullPtr solve' engine e >>= peekHklGeometryList -engineName :: Engine -> String -engineName (Engine name _ _) = name - solveTraj :: Geometry -> Detector a -> Sample b -> [Engine] -> IO [Geometry] solveTraj g@(Geometry f _ _ _) d s es = do let name = engineName (head es) @@ -153,57 +150,6 @@ foreign import ccall unsafe "hkl.h hkl_engine_pseudo_axis_values_set" foreign import ccall unsafe "hkl.h &hkl_geometry_list_free" c_hkl_geometry_list_free :: FunPtr (Ptr HklGeometryList -> IO ()) --- Engine - -peekMode :: Ptr HklEngine -> IO Mode -peekMode e = do - name <- c_hkl_engine_current_mode_get e >>= peekCString - (DArray _ ns) <- peek =<< c_hkl_engine_parameters_names_get e - parameters <- mapM f ns - return (Mode name parameters) - where - f n = (c_hkl_engine_parameter_get e n nullPtr >>= peek) - -foreign import ccall unsafe "hkl.h hkl_engine_current_mode_get" - c_hkl_engine_current_mode_get :: Ptr HklEngine -> IO CString - -foreign import ccall unsafe "hkl.h hkl_engine_parameters_names_get" - c_hkl_engine_parameters_names_get:: Ptr HklEngine -> IO (Ptr (DArray CString)) - -foreign import ccall unsafe "hkl.h hkl_engine_parameter_get" - c_hkl_engine_parameter_get:: Ptr HklEngine -> CString -> Ptr () -> IO (Ptr Parameter) -- darray_string - - -peekEngine :: Ptr HklEngine -> IO Engine -peekEngine e = do - name <- peekCString =<< c_hkl_engine_name_get e - ps <- enginePseudoAxesGet e - mode <- peekMode e - return (Engine name ps mode) - --- engineNameGet :: Ptr HklEngine -> IO String --- engineNameGet engine = c_hkl_engine_name_get engine >>= peekCString - -foreign import ccall unsafe "hkl.h hkl_engine_name_get" - c_hkl_engine_name_get :: Ptr HklEngine -> IO CString - -foreign import ccall unsafe "hkl.h hkl_engine_pseudo_axis_names_get" - c_hkl_engine_pseudo_axis_names_get:: Ptr HklEngine -> IO (Ptr (DArray CString)) - --- enginePseudoAxisNamesGet :: Ptr HklEngine -> IO [String] --- enginePseudoAxisNamesGet e = enginePseudoAxisNamesGet' e >>= mapM peekCString - -enginePseudoAxisGet :: Ptr HklEngine -> CString -> IO Parameter -enginePseudoAxisGet e n = c_hkl_engine_pseudo_axis_get e n nullPtr >>= peek - -foreign import ccall unsafe "hkl.h hkl_engine_pseudo_axis_get" - c_hkl_engine_pseudo_axis_get:: Ptr HklEngine -> CString -> Ptr () -> IO (Ptr Parameter) - -enginePseudoAxesGet :: Ptr HklEngine -> IO [Parameter] -enginePseudoAxesGet ptr = do - (DArray _ ns) <- peek =<< c_hkl_engine_pseudo_axis_names_get ptr - mapM (enginePseudoAxisGet ptr) ns - -- EngineList withEngineList :: Factory -> (Ptr HklEngineList -> IO b) -> IO b diff --git a/contrib/haskell/src/Hkl/C/Engine.hsc b/contrib/haskell/src/Hkl/C/Engine.hsc new file mode 100644 index 00000000..9d5ecede --- /dev/null +++ b/contrib/haskell/src/Hkl/C/Engine.hsc @@ -0,0 +1,81 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE GADTs #-} + +module Hkl.C.Engine + ( HklEngine + , engineName + , peekEngine + ) where + +import Prelude hiding (min, max) + +import Foreign (Ptr, nullPtr) +import Foreign.C (CString, peekCString) +import Foreign.Storable + +import Hkl.C.DArray +import Hkl.Types + +#include "hkl.h" + +-- private types + +data HklEngine + +-- Engine + +engineName :: Engine -> String +engineName (Engine name _ _) = name + +-- Engine + +peekMode :: Ptr HklEngine -> IO Mode +peekMode e = do + name <- c_hkl_engine_current_mode_get e >>= peekCString + (DArray _ ns) <- peek =<< c_hkl_engine_parameters_names_get e + parameters <- mapM f ns + return (Mode name parameters) + where + f n = (c_hkl_engine_parameter_get e n nullPtr >>= peek) + +foreign import ccall unsafe "hkl.h hkl_engine_current_mode_get" + c_hkl_engine_current_mode_get :: Ptr HklEngine -> IO CString + +foreign import ccall unsafe "hkl.h hkl_engine_parameters_names_get" + c_hkl_engine_parameters_names_get:: Ptr HklEngine -> IO (Ptr (DArray CString)) + +foreign import ccall unsafe "hkl.h hkl_engine_parameter_get" + c_hkl_engine_parameter_get:: Ptr HklEngine -> CString -> Ptr () -> IO (Ptr Parameter) -- darray_string + + +peekEngine :: Ptr HklEngine -> IO Engine +peekEngine e = do + name <- peekCString =<< c_hkl_engine_name_get e + ps <- enginePseudoAxesGet e + mode <- peekMode e + return (Engine name ps mode) + +-- engineNameGet :: Ptr HklEngine -> IO String +-- engineNameGet engine = c_hkl_engine_name_get engine >>= peekCString + +foreign import ccall unsafe "hkl.h hkl_engine_name_get" + c_hkl_engine_name_get :: Ptr HklEngine -> IO CString + +foreign import ccall unsafe "hkl.h hkl_engine_pseudo_axis_names_get" + c_hkl_engine_pseudo_axis_names_get:: Ptr HklEngine -> IO (Ptr (DArray CString)) + +-- enginePseudoAxisNamesGet :: Ptr HklEngine -> IO [String] +-- enginePseudoAxisNamesGet e = enginePseudoAxisNamesGet' e >>= mapM peekCString + +enginePseudoAxisGet :: Ptr HklEngine -> CString -> IO Parameter +enginePseudoAxisGet e n = c_hkl_engine_pseudo_axis_get e n nullPtr >>= peek + +foreign import ccall unsafe "hkl.h hkl_engine_pseudo_axis_get" + c_hkl_engine_pseudo_axis_get:: Ptr HklEngine -> CString -> Ptr () -> IO (Ptr Parameter) + +enginePseudoAxesGet :: Ptr HklEngine -> IO [Parameter] +enginePseudoAxesGet ptr = do + (DArray _ ns) <- peek =<< c_hkl_engine_pseudo_axis_names_get ptr + mapM (enginePseudoAxisGet ptr) ns + -- 2.11.4.GIT