[Haskell-beginners] ODP: howto Pipe

PICCA Frederic-Emmanuel frederic-emmanuel.picca at synchrotron-soleil.fr
Sat Feb 20 10:12:26 UTC 2016


Hello

first a big thanks your for all your comment :)


I end-up with this solution


data Diffractometer = Diffractometer { difEngineList :: (ForeignPtr HklEngineList)
                                     , difGeometry :: (ForeignPtr HklGeometry)
                                     , difDetector :: (ForeignPtr HklDetector)
                                     , difSample :: (ForeignPtr HklSample)
                                     }
                      deriving (Show)

newDiffractometer :: Factory ->  Geometry -> Detector -> Sample -> IO Diffractometer
newDiffractometer f g d s = do
  f_engines <- newEngineList f
  f_geometry <- newGeometry f g
  f_detector <- newDetector d
  f_sample <- newSample s
  withForeignPtr f_sample $ \sample ->
      withForeignPtr f_detector $ \detector ->
          withForeignPtr f_geometry $ \geometry ->
              withForeignPtr f_engines $ \engines -> do
                  c_hkl_engine_list_init engines geometry detector sample
                  return $ Diffractometer f_engines f_geometry f_detector f_sample

solve' :: Ptr HklEngine -> CSize -> Engine -> IO (ForeignPtr HklGeometryList)
solve' engine n (Engine _ ps _) = do
  let positions = [v | (Parameter _ v _) <- ps]
  withArray positions $ \values ->
      c_hkl_engine_pseudo_axis_values_set engine values n unit nullPtr
      >>= newForeignPtr c_hkl_geometry_list_free

solveTrajPipe' :: Diffractometer -> Pipe Engine Geometry IO ()
solveTrajPipe' dif = forever $ do
    -- Inside here we are using `StateT Int (Consumer a IO) r`
    e <- await
    let name = engineName e
    solutions <- lift $ withForeignPtr (difEngineList dif) $ \engines ->
     withCString name $ \cname -> do
       engine <- c_hkl_engine_list_engine_get_by_name engines cname nullPtr
       n <- c_hkl_engine_pseudo_axis_names_get engine >>= darrayStringLen
       solutions <- solve' engine n e >>= getSolution0
       return solutions
    yield solutions

solveTrajPipe :: Factory -> Geometry -> Detector -> Sample -> Pipe Engine Geometry IO ()
solveTrajPipe f g d s = do
  dif <- lift $ newDiffractometer f g d s
  solveTrajPipe' dif


so, I created a data type with contain all my foreignPtr.
instanciate them at the begining. this newDiffractometer function also initialise the C library objects
c_hkl_engine_list_init engines geometry detector sample

then I just need to do a forever loop and use this type data to keep the C internal state.

what's worring me is that I have a sort of internal state but this is not expressed anywhere in the type system...

Cheers

Frederic


More information about the Beginners mailing list