contrib/haskell/src/Hkl/Projects/Sixs.hs

   1 {-# LANGUAGE CPP #-}
   2 {-# LANGUAGE GADTs #-}
   3 module Hkl.Projects.Sixs
   4        ( main_sixs )
   5        where
   6
   7 import Prelude hiding (concat, head, print)
   8
   9 #if __GLASGOW_HASKELL__ < 710
  10 import Control.Applicative ((<$>), (<*>))
  11 #endif
  12
  13 import Data.ByteString.Char8 (pack)
  14 import Data.Vector.Storable (concat, head)
  15 import Control.Exception (bracket)
  16 import Control.Monad (forM_)
  17 import Numeric.LinearAlgebra (Matrix)
  18 import Numeric.Units.Dimensional.Prelude (meter, nano, (*~))
  19 import Pipes (Producer, runEffect, (>->), lift, yield)
  20 import Pipes.Prelude (print)
  21 import System.FilePath.Posix ((</>))
  22
  23 import Hkl
  24
  25 {-# ANN module "HLint: ignore Use camelCase" #-}
  26
  27 data DataFrameHklH5Path
  28     = DataFrameHklH5Path
  29       (DataItem H5) -- Image
  30       (DataItem H5) -- Mu
  31       (DataItem H5) -- Omega
  32       (DataItem H5) -- delta
  33       (DataItem H5) -- gamma
  34       (DataItem H5) -- UB
  35       (DataItem H5) -- Wavelength
  36       (DataItem H5) -- DiffractometerType
  37     deriving (Show)
  38
  39 data DataFrameHklH5
  40     = DataFrameHklH5
  41       Dataset -- image
  42       Dataset -- mu
  43       Dataset -- omega
  44       Dataset -- delta
  45       Dataset -- gamma
  46       Dataset -- ub
  47       Dataset -- wavelength
  48       Dataset -- dtype
  49
  50 data DataFrame
  51     = DataFrame
  52       Int -- n
  53       Geometry -- geometry
  54       (Matrix Double) -- ub
  55     deriving (Show)
  56
  57 withDataframeH5 :: File -> DataFrameHklH5Path -> (DataFrameHklH5 -> IO r) -> IO r
  58 withDataframeH5 h5file dfp = bracket (hkl_h5_open h5file dfp) hkl_h5_close
  59
  60 hkl_h5_open :: File -> DataFrameHklH5Path -> IO DataFrameHklH5
  61 hkl_h5_open h5file (DataFrameHklH5Path i m o d g u w t) = DataFrameHklH5
  62                          <$> openDataset' h5file i
  63                          <*> openDataset' h5file m
  64                          <*> openDataset' h5file o
  65                          <*> openDataset' h5file d
  66                          <*> openDataset' h5file g
  67                          <*> openDataset' h5file u
  68                          <*> openDataset' h5file w
  69                          <*> openDataset' h5file t
  70   where
  71     openDataset' :: File -> DataItem H5 -> IO Dataset
  72     openDataset' hid (DataItemH5 name _) = openDataset hid (pack name) Nothing
  73
  74 hkl_h5_is_valid :: DataFrameHklH5 -> IO Bool
  75 hkl_h5_is_valid (DataFrameHklH5 _ m o d g _ _ _) = do
  76   True <- check_ndims m 1
  77   True <- check_ndims o 1
  78   True <- check_ndims d 1
  79   True <- check_ndims g 1
  80   return True
  81
  82 hkl_h5_close :: DataFrameHklH5 -> IO ()
  83 hkl_h5_close (DataFrameHklH5 i m o d g u w t) = do
  84   closeDataset i
  85   closeDataset m
  86   closeDataset o
  87   closeDataset d
  88   closeDataset g
  89   closeDataset u
  90   closeDataset w
  91   closeDataset t
  92
  93 getDataFrame' ::  DataFrameHklH5 -> Int -> IO DataFrame
  94 getDataFrame' (DataFrameHklH5 _ m o d g u w _) i = do
  95   mu <- get_position m i
  96   omega <- get_position o i
  97   delta <- get_position d i
  98   gamma <- get_position g i
  99   wavelength <- get_position w 0
 100   ub <- get_ub u
 101   let positions = concat [mu, omega, delta, gamma]
 102   let source = Source (head wavelength *~ nano meter)
 103   return $ DataFrame i (Geometry Uhv source positions Nothing) ub
 104
 105 getDataFrame :: DataFrameHklH5 -> Producer DataFrame IO ()
 106 getDataFrame d@(DataFrameHklH5 _ m _ _ _ _ _ _) = do
 107   (Just n) <- lift $ lenH5Dataspace m
 108   forM_ [0..n-1] (\i -> lift (getDataFrame' d i) >>= yield)
 109
 110 main_sixs :: IO ()
 111 main_sixs = do
 112   let root = "/nfs/ruche-sixs/sixs-soleil/com-sixs/2015/Shutdown4-5/XpadAu111/"
 113   let filename = "align_FLY2_omega_00045.nxs"
 114   let dataframe_h5p = DataFrameHklH5Path
 115                       (DataItemH5 "com_113934/scan_data/xpad_image" StrictDims)
 116                       (DataItemH5 "com_113934/scan_data/UHV_MU" ExtendDims)
 117                       (DataItemH5 "com_113934/scan_data/UHV_OMEGA" ExtendDims)
 118                       (DataItemH5 "com_113934/scan_data/UHV_DELTA" ExtendDims)
 119                       (DataItemH5 "com_113934/scan_data/UHV_GAMMA" ExtendDims)
 120                       (DataItemH5 "com_113934/SIXS/I14-C-CX2__EX__DIFF-UHV__#1/UB" StrictDims)
 121                       (DataItemH5 "com_113934/SIXS/Monochromator/wavelength" StrictDims)
 122                       (DataItemH5 "com_113934/SIXS/I14-C-CX2__EX__DIFF-UHV__#1/type" StrictDims)
 123
 124   withH5File (root </> filename) $ \h5file ->
 125     withDataframeH5 h5file dataframe_h5p $ \dataframe_h5 -> do
 126       True <- hkl_h5_is_valid dataframe_h5
 127       runEffect $ getDataFrame dataframe_h5
 128         >->  print