<div dir="ltr">Do you mean it's ugly because of the nested withHdf4PathP? If so, have you considered ResourceT?<div><br></div><div>But I saw something else that seems more noteworthy. Why is withUhvPathP being used to repeatedly open and close the same files using the filenames contained in dif? (I suppose withHdf5PathP opens and closes HDF5 files.) Why don't you open the files once in the beginning of your loop and close them at the end? You can do this by wrapping everything in a ResourceT and use allocate.</div></div><br><div class="gmail_quote"><div dir="ltr" class="gmail_attr">On Wed, May 20, 2020 at 6:25 PM Compl Yue <<a href="mailto:compl.yue@gmail.com">compl.yue@gmail.com</a>> wrote:<br></div><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex">Maybe fork another thread, keep reading data and putting into a shared `MVar` / `TMVar`, then current thread keep taking from that var?<br>
<br>
> On 2020-05-20, at 14:23, PICCA Frederic-Emmanuel <<a href="mailto:frederic-emmanuel.picca@synchrotron-soleil.fr" target="_blank">frederic-emmanuel.picca@synchrotron-soleil.fr</a>> wrote:<br>
> <br>
> Hello, I am writing a software which  do some data treatement from hdf5 files.<br>
> <br>
> In order to access the data which are stored in arrays, I need to open and closes ressources.<br>
> This is the purpose of the withHdf5PathP function.<br>
> <br>
> given a file f and a UhvPath I end up with this<br>
> <br>
> withUhvPathP :: (MonadSafe m, Location l) => l -> UhvPath -> ((Int -> IO Geometry) -> m r) -> m r<br>
> withUhvPathP f (UhvPath m o d g w) gg =<br>
>      withHdf5PathP f m $ \m' -><br>
>      withHdf5PathP f o $ \o' -><br>
>      withHdf5PathP f d $ \d'-><br>
>      withHdf5PathP f g $ \g' -><br>
>      withHdf5PathP f w $ \w' -> gg (\j -> do<br>
>                                      mu <- get_position m' j<br>
>                                      omega <- get_position o' j<br>
>                                      delta <- get_position d' j<br>
>                                      gamma' <- get_position g' j<br>
>                                      wavelength <- getValueWithUnit w' 0 angstrom<br>
>                                      let positions = Data.Vector.Storable.fromList [mu, omega, delta, gamma']<br>
>                                      let source = Source wavelength<br>
>                                      pure $ Geometry Uhv source positions Nothing)<br>
> <br>
> <br>
> then I use this like this<br>
> <br>
> forever $ do<br>
>    (Chunk fp from to) <- await<br>
>    withFileP (openH5 fp) $ \f -><br>
>      withHdf5PathP f imgs $ \dimgs -><br>
>      withUhvPathP f dif $ \getDiffractometer -><br>
>      withSamplePathP f samp $ \getSample -><br>
>      forM_ [from..to-1] (\j -> yield =<< liftIO<br>
>                               (DataFrameHkl<br>
>                                <$> pure j<br>
>                                <*> get_image' det dimgs j<br>
>                                <*> getDiffractometer j<br>
>                                <*> getSample j))<br>
> <br>
> so once I open the resources, I use the getDiffratometer ((Int -> IO Geometry) -> m r) function give the position on the stream and it return the value at the j position.<br>
> the purpose of this is to open the ressources only once at the begining and then send the values in a Pipe via the yield function of pipes package.<br>
> <br>
> I hope, I was clear.<br>
> <br>
> 1) I find the withUhvPathP sort of ugly, and I would like to know if it could be written more elegantly, because I will need to write a lot's of these function for different types.<br>
> <br>
> 2) It is the right way to design a solution to my problem (open ressources and send each values into a stream).<br>
> <br>
> thanks for you attention.<br>
> <br>
> Frederic<br>
> _______________________________________________<br>
> Haskell-Cafe mailing list<br>
> To (un)subscribe, modify options or view archives go to:<br>
> <a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a><br>
> Only members subscribed via the mailman list are allowed to post.<br>
<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
To (un)subscribe, modify options or view archives go to:<br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a><br>
Only members subscribed via the mailman list are allowed to post.</blockquote></div>