binoculars-ng/src/Hkl/Binoculars/Projections/QCustom.hs

   1 {-# LANGUAGE DataKinds             #-}
   2 {-# LANGUAGE DeriveAnyClass        #-}
   3 {-# LANGUAGE DeriveGeneric         #-}
   4 {-# LANGUAGE FlexibleContexts      #-}
   5 {-# LANGUAGE FlexibleInstances     #-}
   6 {-# LANGUAGE LambdaCase            #-}
   7 {-# LANGUAGE MultiParamTypeClasses #-}
   8 {-# LANGUAGE OverloadedStrings     #-}
   9 {-# LANGUAGE RankNTypes            #-}
  10 {-# LANGUAGE ScopedTypeVariables   #-}
  11 {-# LANGUAGE TypeFamilies          #-}
  12
  13 {-# OPTIONS_GHC -fno-warn-orphans #-}
  14 {-# OPTIONS_GHC -ddump-simpl -ddump-to-file -ddump-splices #-}
  15 {-
  16     Copyright  : Copyright (C) 2014-2024 Synchrotron SOLEIL
  17                                          L'Orme des Merisiers Saint-Aubin
  18                                          BP 48 91192 GIF-sur-YVETTE CEDEX
  19     License    : GPL3+
  20
  21     Maintainer : Picca Frédéric-Emmanuel <picca@synchrotron-soleil.fr>
  22     Stability  : Experimental
  23     Portability: GHC only (not tested)
  24 -}
  25
  26 module Hkl.Binoculars.Projections.QCustom
  27     ( Args(..)
  28     , Config(..)
  29     , DataFrameQCustom(..)
  30     , DataSourcePath(..)
  31     , FramesP(..)
  32     , default'DataSourcePath'DataFrameQCustom
  33     , guess'DataSourcePath'DataFrameQCustom
  34     , newQCustom
  35     , overload'DataSourcePath'DataFrameQCustom
  36     , processQCustom
  37     , updateQCustom
  38     ) where
  39
  40 import           Control.Applicative               ((<|>))
  41 import           Control.Concurrent.Async          (mapConcurrently)
  42 import           Control.Monad.Catch               (MonadThrow)
  43 import           Control.Monad.IO.Class            (MonadIO (liftIO))
  44 import           Control.Monad.Logger              (MonadLogger, logDebugN,
  45                                                     logInfoN)
  46 import           Control.Monad.Reader              (MonadReader, ask, forM_,
  47                                                     forever)
  48 import           Data.Aeson                        (FromJSON, ToJSON,
  49                                                     eitherDecode', encode)
  50 import           Data.ByteString.Lazy              (fromStrict, toStrict)
  51 import           Data.HashMap.Lazy                 (fromList)
  52 import           Data.Ini                          (Ini (..))
  53 import           Data.Ini.Config.Bidir             (FieldValue (..))
  54 import           Data.Maybe                        (fromJust, fromMaybe)
  55 import           Data.Text                         (pack, unpack)
  56 import           Data.Text.Encoding                (decodeUtf8, encodeUtf8)
  57 import           Data.Text.IO                      (putStr)
  58 import           Data.Vector.Storable.Mutable      (unsafeWith)
  59 import           Foreign.C.Types                   (CDouble (..))
  60 import           Foreign.ForeignPtr                (ForeignPtr, withForeignPtr)
  61 import           GHC.Generics                      (Generic)
  62 import           Numeric.Units.Dimensional.Prelude (Angle, degree, radian, (*~),
  63                                                     (/~))
  64 import           Path                              (Abs, Dir, Path)
  65 import           Pipes                             (await, each, runEffect,
  66                                                     yield, (>->))
  67 import           Pipes.Prelude                     (filter, map, tee, toListM)
  68 import           Pipes.Safe                        (runSafeT)
  69 import           Text.Printf                       (printf)
  70
  71 import           Hkl.Binoculars.Common
  72 import           Hkl.Binoculars.Config
  73 import           Hkl.Binoculars.Config.Common
  74 import           Hkl.Binoculars.Pipes
  75 import           Hkl.Binoculars.Projections
  76 import           Hkl.C.Binoculars
  77 import           Hkl.C.Hkl
  78 import           Hkl.DataSource
  79 import           Hkl.Detector
  80 import           Hkl.Geometry
  81 import           Hkl.H5
  82 import           Hkl.Image
  83 import           Hkl.Orphan                        ()
  84 import           Hkl.Pipes
  85 import           Hkl.Repa
  86 import           Hkl.Types
  87 import           Hkl.Utils
  88
  89 -----------------------
  90 -- QCustom Projection --
  91 -----------------------
  92
  93 -- Cursor
  94
  95 data DataFrameQCustom
  96     = DataFrameQCustom
  97       Attenuation -- attenuation
  98       (ForeignPtr C'HklGeometry) -- geometry
  99       Image -- image
 100       Timestamp -- timestamp in double
 101     deriving Show
 102
 103 instance DataSource DataFrameQCustom where
 104   data DataSourcePath DataFrameQCustom
 105     = DataSourcePath'DataFrameQCustom
 106       (DataSourcePath Attenuation)
 107       (DataSourcePath Geometry)
 108       (DataSourcePath Image)
 109       (DataSourcePath Timestamp)
 110     deriving (Generic, Show, FromJSON, ToJSON)
 111
 112   data DataSourceAcq DataFrameQCustom
 113     = DataSourceAcq'DataFrameQCustom
 114       (DataSourceAcq Attenuation)
 115       (DataSourceAcq Geometry)
 116       (DataSourceAcq Image)
 117       (DataSourceAcq Timestamp)
 118
 119   withDataSourceP f (DataSourcePath'DataFrameQCustom a g i idx) gg =
 120     withDataSourceP f a $ \a' ->
 121     withDataSourceP f g $ \g' ->
 122     withDataSourceP f i $ \i' ->
 123     withDataSourceP f idx $ \idx' -> gg (DataSourceAcq'DataFrameQCustom a' g' i' idx')
 124
 125 instance Is1DStreamable (DataSourceAcq DataFrameQCustom) DataFrameQCustom where
 126     extract1DStreamValue (DataSourceAcq'DataFrameQCustom att geom img idx) i =
 127       DataFrameQCustom
 128       <$> extract1DStreamValue att i
 129       <*> extract1DStreamValue geom i
 130       <*> extract1DStreamValue img i
 131       <*> extract1DStreamValue idx i
 132
 133 default'DataSourcePath'DataFrameQCustom :: DataSourcePath DataFrameQCustom
 134 default'DataSourcePath'DataFrameQCustom
 135   = DataSourcePath'DataFrameQCustom
 136     (DataSourcePath'Attenuation
 137       (DataSourcePath'Float (hdf5p $ grouppat 0 $ datasetp "scan_data/attenuation"))
 138       2 0 Nothing)
 139     (DataSourcePath'Geometry
 140       (Geometry'Factory Uhv)
 141       (DataSourcePath'Double (hdf5p $ grouppat 0 $ datasetp "SIXS/Monochromator/wavelength"))
 142       [ DataSourcePath'Double(hdf5p $ grouppat 0 $ datasetp "scan_data/UHV_MU")
 143       , DataSourcePath'Double(hdf5p $ grouppat 0 $ datasetp "scan_data/UHV_OMEGA")
 144       , DataSourcePath'Double(hdf5p $ grouppat 0 $ datasetp "scan_data/UHV_DELTA")
 145       , DataSourcePath'Double(hdf5p $ grouppat 0 $ datasetp "scan_data/UHV_GAMMA")
 146       ])
 147     (DataSourcePath'Image
 148       (hdf5p $ grouppat 0 $ datasetp "scan_data/xpad_image")
 149       defaultDetector)
 150     (DataSourcePath'Timestamp(hdf5p $ grouppat 0 $ datasetp "scan_data/epoch"))
 151
 152 instance HasFieldComment (DataSourcePath DataFrameQCustom) where
 153   fieldComment _ = [ "`datapath` internal value used to find the data in the data file."
 154                    , ""
 155                    , "This value is for expert only."
 156                    , ""
 157                    , "default value: <not set>"
 158                    ]
 159
 160 instance HasFieldValue (DataSourcePath DataFrameQCustom) where
 161   fieldvalue = FieldValue
 162                { fvParse = eitherDecode' . fromStrict . encodeUtf8
 163                , fvEmit = decodeUtf8 . toStrict . encode
 164                }
 165
 166 ------------
 167 -- Config --
 168 ------------
 169
 170 data instance Config 'QCustomProjection
 171   = BinocularsConfig'QCustom
 172     { binocularsConfig'QCustom'Common :: BinocularsConfig'Common
 173     , binocularsConfig'QCustom'HklBinocularsSurfaceOrientationEnum     :: HklBinocularsSurfaceOrientationEnum
 174     , binocularsConfig'QCustom'ProjectionType         :: ProjectionType
 175     , binocularsConfig'QCustom'ProjectionResolution   :: Resolutions DIM3
 176     , binocularsConfig'QCustom'ProjectionLimits       :: Maybe (RLimits DIM3)
 177     , binocularsConfig'QCustom'DataPath               :: DataSourcePath DataFrameQCustom
 178     , binocularsConfig'QCustom'SubProjection          :: Maybe HklBinocularsQCustomSubProjectionEnum
 179     , binocularsConfig'QCustom'Uqx                    :: Degree
 180     , binocularsConfig'QCustom'Uqy                    :: Degree
 181     , binocularsConfig'QCustom'Uqz                    :: Degree
 182     , binocularsConfig'QCustom'SampleAxis             :: Maybe SampleAxis
 183     } deriving (Show, Generic)
 184
 185 newtype instance Args 'QCustomProjection = Args'QCustomProjection (Maybe ConfigRange)
 186
 187 default'BinocularsConfig'QCustom :: Config 'QCustomProjection
 188 default'BinocularsConfig'QCustom
 189   = BinocularsConfig'QCustom
 190     { binocularsConfig'QCustom'Common = default'BinocularsConfig'Common
 191     , binocularsConfig'QCustom'HklBinocularsSurfaceOrientationEnum = HklBinocularsSurfaceOrientationEnum'Vertical
 192     , binocularsConfig'QCustom'ProjectionType = QCustomProjection
 193     , binocularsConfig'QCustom'ProjectionResolution = Resolutions3 0.01 0.01 0.01
 194     , binocularsConfig'QCustom'ProjectionLimits  = Nothing
 195     , binocularsConfig'QCustom'DataPath = default'DataSourcePath'DataFrameQCustom
 196     , binocularsConfig'QCustom'SubProjection = Just HklBinocularsQCustomSubProjectionEnum'QxQyQz
 197     , binocularsConfig'QCustom'Uqx = Degree (0.0 *~ degree)
 198     , binocularsConfig'QCustom'Uqy = Degree (0.0 *~ degree)
 199     , binocularsConfig'QCustom'Uqz = Degree (0.0 *~ degree)
 200     , binocularsConfig'QCustom'SampleAxis = Nothing
 201     }
 202
 203
 204 instance HasIniConfig 'QCustomProjection where
 205
 206   getConfig content@(ConfigContent cfg) (Args'QCustomProjection mr) capabilities = do
 207     common <- parse'BinocularsConfig'Common cfg mr capabilities
 208     projectiontype <- parseFDef cfg "projection" "type" (binocularsConfig'QCustom'ProjectionType default'BinocularsConfig'QCustom)
 209
 210     let msubprojection' = parseMbDef cfg "projection" "subprojection" (binocularsConfig'QCustom'SubProjection default'BinocularsConfig'QCustom)
 211     let msubprojection = case projectiontype of
 212                            QIndexProjection -> Just HklBinocularsQCustomSubProjectionEnum'QTimestamp
 213                            QparQperProjection -> Just HklBinocularsQCustomSubProjectionEnum'QparQper
 214                            QxQyQzProjection -> Just HklBinocularsQCustomSubProjectionEnum'QxQyQz
 215                            AnglesProjection -> msubprojection'
 216                            Angles2Projection -> msubprojection'
 217                            HklProjection -> msubprojection'
 218                            QCustomProjection -> msubprojection'
 219                            RealSpaceProjection -> Just HklBinocularsQCustomSubProjectionEnum'XYZ
 220                            PixelsProjection -> Just HklBinocularsQCustomSubProjectionEnum'YZTimestamp
 221                            TestProjection -> msubprojection'
 222
 223     let errorMissingSampleAxis = case msubprojection of
 224                                    Nothing -> Nothing
 225                                    Just sub -> case sub of
 226                                                 HklBinocularsQCustomSubProjectionEnum'QxQyQz -> Nothing
 227                                                 HklBinocularsQCustomSubProjectionEnum'QTthTimestamp -> Nothing
 228                                                 HklBinocularsQCustomSubProjectionEnum'QTimestamp -> Nothing
 229                                                 HklBinocularsQCustomSubProjectionEnum'QparQperTimestamp -> Nothing
 230                                                 HklBinocularsQCustomSubProjectionEnum'QparQper -> Nothing
 231                                                 HklBinocularsQCustomSubProjectionEnum'QPhiQx -> Nothing
 232                                                 HklBinocularsQCustomSubProjectionEnum'QPhiQy -> Nothing
 233                                                 HklBinocularsQCustomSubProjectionEnum'QPhiQz -> Nothing
 234                                                 HklBinocularsQCustomSubProjectionEnum'QStereo -> Nothing
 235                                                 HklBinocularsQCustomSubProjectionEnum'DeltalabGammalabSampleaxis -> error "expect a valid  [projection] 'sampleaxis' key"
 236                                                 HklBinocularsQCustomSubProjectionEnum'XYZ -> Nothing
 237                                                 HklBinocularsQCustomSubProjectionEnum'YZTimestamp -> Nothing
 238                                                 HklBinocularsQCustomSubProjectionEnum'QQparQper -> Nothing
 239                                                 HklBinocularsQCustomSubProjectionEnum'QparsQperTimestamp -> Nothing
 240                                                 HklBinocularsQCustomSubProjectionEnum'QparQperSampleaxis -> error "expect a valid [projection] 'sampleaxis' key"
 241                                                 HklBinocularsQCustomSubProjectionEnum'QSampleaxisTth -> error "expect a valid [projection] 'sampleaxis' key"
 242                                                 HklBinocularsQCustomSubProjectionEnum'QSampleaxisTimestamp -> error "expect a valid [projection] 'sampleaxis' key"
 243                                                 HklBinocularsQCustomSubProjectionEnum'QxQyTimestamp -> Nothing
 244                                                 HklBinocularsQCustomSubProjectionEnum'QxQzTimestamp -> Nothing
 245                                                 HklBinocularsQCustomSubProjectionEnum'QyQzTimestamp -> Nothing
 246
 247
 248     BinocularsConfig'QCustom
 249       common
 250       <$> parseFDef cfg "input" "surface_orientation" (binocularsConfig'QCustom'HklBinocularsSurfaceOrientationEnum default'BinocularsConfig'QCustom)
 251       <*> pure projectiontype
 252       <*> parseFDef cfg "projection" "resolution" (binocularsConfig'QCustom'ProjectionResolution default'BinocularsConfig'QCustom)
 253       <*> parseMb cfg "projection" "limits"
 254       <*> pure (eitherF (const $ guess'DataSourcePath'DataFrameQCustom common msubprojection content) (parse' cfg "input" "datapath")
 255                 (\case
 256                     Nothing -> guess'DataSourcePath'DataFrameQCustom common msubprojection content
 257                     Just d ->  overload'DataSourcePath'DataFrameQCustom common msubprojection d))
 258       <*> pure msubprojection
 259       <*> parseFDef cfg "projection" "uqx" (binocularsConfig'QCustom'Uqx default'BinocularsConfig'QCustom)
 260       <*> parseFDef cfg "projection" "uqy" (binocularsConfig'QCustom'Uqy default'BinocularsConfig'QCustom)
 261       <*> parseFDef cfg "projection" "uqz" (binocularsConfig'QCustom'Uqz default'BinocularsConfig'QCustom)
 262       <*> pure (eitherF (const $ errorMissingSampleAxis) (parse' cfg "projection" "sampleaxis")
 263                 (\case
 264                     Nothing -> errorMissingSampleAxis
 265                     Just d  -> Just d
 266                 ))
 267
 268 instance ToIni (Config 'QCustomProjection) where
 269
 270   toIni c = toIni (binocularsConfig'QCustom'Common c)
 271             `mergeIni`
 272             Ini { iniSections = fromList [ ("input",    elemFDef' "surface_orientation" binocularsConfig'QCustom'HklBinocularsSurfaceOrientationEnum c default'BinocularsConfig'QCustom
 273                                                      <> elemFDef' "datapath" binocularsConfig'QCustom'DataPath c default'BinocularsConfig'QCustom
 274                                            )
 275                                          , ("projection",    elemFDef' "type" binocularsConfig'QCustom'ProjectionType c default'BinocularsConfig'QCustom
 276                                                           <> elemFDef' "resolution" binocularsConfig'QCustom'ProjectionResolution c default'BinocularsConfig'QCustom
 277                                                           <> elemFMbDef' "limits" binocularsConfig'QCustom'ProjectionLimits c default'BinocularsConfig'QCustom
 278                                                           <> elemFMbDef' "subprojection" binocularsConfig'QCustom'SubProjection c default'BinocularsConfig'QCustom
 279                                                           <> elemFDef "uqx" binocularsConfig'QCustom'Uqx c default'BinocularsConfig'QCustom
 280                                                           [ "rotation around the x-axis of the sample in the surface basis system -- degree"
 281                                                           , ""
 282                                                           , "in this basis, the x-axis is colinear to the surface of the sample along the x-rays."
 283                                                           , ""
 284                                                           , " `<not set>` - use the default value `0.0`"
 285                                                           , " `a value`   - use this value"
 286                                                           ]
 287                                                           <> elemFDef "uqy" binocularsConfig'QCustom'Uqy c default'BinocularsConfig'QCustom
 288                                                           [ "rotation around the y-axis of the sample in the surface basis system -- degree"
 289                                                           , ""
 290                                                           , "in this basis, the y-axis is colinear to the surface of the sample and"
 291                                                           , "forme a directe basis with x-axis and z-axis."
 292                                                           , ""
 293                                                           , "examples:"
 294                                                           , "  - all motors set to zero and a vertical surface - y-axis along -z (labo basis)"
 295                                                           , "  - all motors set to zero and an horizontal surcafe - y-axis along y (labo basis)"
 296                                                           , ""
 297                                                           , " `<not set>` - use the default value `0.0`"
 298                                                           , " `a value`   - use this value"
 299                                                           ]
 300                                                           <> elemFDef "uqz" binocularsConfig'QCustom'Uqz c default'BinocularsConfig'QCustom
 301                                                           [ "rotation around the z-axis of the sample in the surface basis system -- degree"
 302                                                           , ""
 303                                                           , "in this basis, the z-axis is perpendicular to the surface of the sample."
 304                                                           , ""
 305                                                           , "examples:"
 306                                                           , "  - all motors set to zero and a vertical surface - z-axis along y (labo basis)"
 307                                                           , "  - all motors set to zero and an horizontal surcafe - z-axis along z (labo basis)"
 308                                                           , ""
 309                                                           , ""
 310                                                           , " `<not set>` - use the default value `0.0`"
 311                                                           , " `a value`   - use this value"
 312                                                           ]
 313                                                           <> elemFMbDef "sampleaxis" binocularsConfig'QCustom'SampleAxis c default'BinocularsConfig'QCustom
 314                                                           [ "the name of the sample axis expected by some subprojections."
 315                                                           , ""
 316                                                           , " `<not set>` - for all subprojections which does not expect a value."
 317                                                           , " `a value`   - use this value for the subprojection expecting this axis."
 318                                                           ]
 319                                            )]
 320
 321                 , iniGlobals = []
 322                 }
 323
 324 ------------------
 325 -- Input Path's --
 326 ------------------
 327
 328 mkAttenuation :: Maybe Double -> DataSourcePath Attenuation -> DataSourcePath Attenuation
 329 mkAttenuation ma att =
 330     case ma of
 331       Nothing -> case att of
 332                   DataSourcePath'NoAttenuation     -> DataSourcePath'NoAttenuation
 333                   DataSourcePath'Attenuation{} ->  DataSourcePath'NoAttenuation
 334                            -- logWarnN "The current configuration extract the attenuation from the data files."
 335                            -- logWarnN "You forgot to provide the attenuation coefficient in the config file."
 336                            -- logWarnN "I continue without attenuation correction"
 337                            -- logWarnN "Add attenuation_coefficient=<something> under the [input] section, to fix this"
 338                            -- return DataSourcePath'NoAttenuation
 339                   applyed@DataSourcePath'ApplyedAttenuationFactor{} -> applyed
 340       (Just coef) -> case att of
 341                       DataSourcePath'NoAttenuation           -> DataSourcePath'NoAttenuation
 342                       (DataSourcePath'Attenuation p o _ m) -> DataSourcePath'Attenuation p o coef m
 343                       (DataSourcePath'ApplyedAttenuationFactor _) -> undefined
 344
 345 mkDetector'Sixs'Fly :: Detector Hkl DIM2 -> DataSourcePath Image
 346 mkDetector'Sixs'Fly det@(Detector2D d _ _)
 347   = case d of
 348       HklBinocularsDetectorEnum'ImxpadS140 ->
 349         DataSourcePath'Image
 350         (hdf5p $ grouppat 0 (datasetp "scan_data/xpad_image"
 351                               `H5Or`
 352                               datasetp "scan_data/xpad_s140_image"))
 353         det
 354       HklBinocularsDetectorEnum'XpadFlatCorrected -> undefined
 355       HklBinocularsDetectorEnum'ImxpadS70 ->
 356         DataSourcePath'Image
 357         (hdf5p $ grouppat 0 $ datasetp "scan_data/xpad_s70_image")
 358         det
 359       HklBinocularsDetectorEnum'DectrisEiger1M ->
 360         DataSourcePath'Image
 361         (hdf5p $ grouppat 0 $ datasetp "scan_data/eiger_image")
 362         det
 363       HklBinocularsDetectorEnum'Ufxc ->
 364         DataSourcePath'Image
 365         (hdf5p $ grouppat 0 $ datasetp "scan_data/ufxc_sixs_image")
 366         det
 367       HklBinocularsDetectorEnum'Merlin -> undefined
 368       HklBinocularsDetectorEnum'MerlinMedipix3rxQuad -> undefined
 369       HklBinocularsDetectorEnum'MerlinMedipix3rxQuad512 -> undefined
 370
 371 mkDetector'Sixs'Sbs :: Detector Hkl DIM2 -> DataSourcePath Image
 372 mkDetector'Sixs'Sbs det@(Detector2D d _ _)
 373   = case d of
 374       HklBinocularsDetectorEnum'ImxpadS140 ->
 375         DataSourcePath'Image
 376         (hdf5p (datasetpattr ("long_name", "i14-c-c00/dt/xpad.s140/image")
 377                 `H5Or`
 378                 datasetpattr ("long_name", "i14-c-c00/dt/xpad.1/image")))
 379         det
 380       HklBinocularsDetectorEnum'XpadFlatCorrected -> undefined
 381       HklBinocularsDetectorEnum'ImxpadS70 ->
 382         DataSourcePath'Image
 383         (hdf5p $ datasetpattr ("long_name", "i14-c-c00/dt/xpad.s70/image"))
 384         det
 385       HklBinocularsDetectorEnum'DectrisEiger1M ->
 386         DataSourcePath'Image
 387         (hdf5p $ datasetpattr ("long_name", "i14-c-c00/dt/eiger.1/image"))
 388         det
 389       HklBinocularsDetectorEnum'Ufxc -> undefined
 390       HklBinocularsDetectorEnum'Merlin -> undefined
 391       HklBinocularsDetectorEnum'MerlinMedipix3rxQuad -> undefined
 392       HklBinocularsDetectorEnum'MerlinMedipix3rxQuad512 -> undefined
 393
 394 overloadAttenuationPath :: Maybe Double -> Maybe Float -> DataSourcePath Attenuation -> DataSourcePath Attenuation
 395 overloadAttenuationPath ma m' (DataSourcePath'Attenuation p o a m)
 396   = DataSourcePath'Attenuation p o (fromMaybe a ma) (m' <|> m)
 397 overloadAttenuationPath _ _ ap@DataSourcePath'ApplyedAttenuationFactor{} = ap
 398 overloadAttenuationPath _ _ ap@DataSourcePath'NoAttenuation = ap
 399
 400 overloadTimestampPath :: Maybe HklBinocularsQCustomSubProjectionEnum -> DataSourcePath Timestamp -> DataSourcePath Timestamp
 401 overloadTimestampPath msub idx =
 402   case msub of
 403     Nothing -> DataSourcePath'Timestamp'NoTimestamp
 404     (Just sub) -> case sub of
 405                    HklBinocularsQCustomSubProjectionEnum'QxQyQz -> DataSourcePath'Timestamp'NoTimestamp
 406                    HklBinocularsQCustomSubProjectionEnum'QTthTimestamp -> idx
 407                    HklBinocularsQCustomSubProjectionEnum'QTimestamp -> idx
 408                    HklBinocularsQCustomSubProjectionEnum'QparQperTimestamp -> idx
 409                    HklBinocularsQCustomSubProjectionEnum'QparQper -> DataSourcePath'Timestamp'NoTimestamp
 410                    HklBinocularsQCustomSubProjectionEnum'QPhiQx -> DataSourcePath'Timestamp'NoTimestamp
 411                    HklBinocularsQCustomSubProjectionEnum'QPhiQy -> DataSourcePath'Timestamp'NoTimestamp
 412                    HklBinocularsQCustomSubProjectionEnum'QPhiQz -> DataSourcePath'Timestamp'NoTimestamp
 413                    HklBinocularsQCustomSubProjectionEnum'QStereo -> DataSourcePath'Timestamp'NoTimestamp
 414                    HklBinocularsQCustomSubProjectionEnum'DeltalabGammalabSampleaxis -> DataSourcePath'Timestamp'NoTimestamp
 415                    HklBinocularsQCustomSubProjectionEnum'XYZ -> DataSourcePath'Timestamp'NoTimestamp
 416                    HklBinocularsQCustomSubProjectionEnum'YZTimestamp -> idx
 417                    HklBinocularsQCustomSubProjectionEnum'QQparQper -> DataSourcePath'Timestamp'NoTimestamp
 418                    HklBinocularsQCustomSubProjectionEnum'QparsQperTimestamp -> idx
 419                    HklBinocularsQCustomSubProjectionEnum'QparQperSampleaxis -> DataSourcePath'Timestamp'NoTimestamp
 420                    HklBinocularsQCustomSubProjectionEnum'QSampleaxisTth -> DataSourcePath'Timestamp'NoTimestamp
 421                    HklBinocularsQCustomSubProjectionEnum'QSampleaxisTimestamp -> idx
 422                    HklBinocularsQCustomSubProjectionEnum'QxQyTimestamp -> idx
 423                    HklBinocularsQCustomSubProjectionEnum'QxQzTimestamp -> idx
 424                    HklBinocularsQCustomSubProjectionEnum'QyQzTimestamp -> idx
 425
 426 overloadWaveLength :: Maybe Double -> DataSourcePath Double -> DataSourcePath Double
 427 overloadWaveLength ma wp = maybe wp DataSourcePath'Double'Const ma
 428
 429 overloadGeometryPath ::  Maybe Double -> DataSourcePath Geometry -> DataSourcePath Geometry
 430 overloadGeometryPath mw (DataSourcePath'Geometry g wp as) = DataSourcePath'Geometry g (overloadWaveLength mw wp) as
 431 overloadGeometryPath mw (DataSourcePath'Geometry'Fix wp) = DataSourcePath'Geometry'Fix (overloadWaveLength mw wp)
 432
 433
 434 overloadImagePath :: Detector Hkl DIM2 -> DataSourcePath Image -> DataSourcePath Image
 435 overloadImagePath det (DataSourcePath'Image p _) = DataSourcePath'Image p det
 436
 437 overload'DataSourcePath'DataFrameQCustom :: BinocularsConfig'Common
 438                                          -> Maybe HklBinocularsQCustomSubProjectionEnum
 439                                          -> DataSourcePath DataFrameQCustom
 440                                          -> DataSourcePath DataFrameQCustom
 441 overload'DataSourcePath'DataFrameQCustom common msub (DataSourcePath'DataFrameQCustom attenuationPath' geometryPath imagePath indexP)
 442   = let mAttCoef = binocularsConfig'Common'AttenuationCoefficient common
 443         mMaxAtt = binocularsConfig'Common'AttenuationMax common
 444         mWavelength = binocularsConfig'Common'Wavelength common
 445         detector =  binocularsConfig'Common'Detector common
 446
 447         newAttenuationPath = overloadAttenuationPath mAttCoef mMaxAtt attenuationPath'
 448         newGeometryPath = overloadGeometryPath mWavelength geometryPath
 449         newImagePath = overloadImagePath detector imagePath
 450         newTimestampPath = overloadTimestampPath msub indexP
 451     in
 452       DataSourcePath'DataFrameQCustom newAttenuationPath newGeometryPath newImagePath newTimestampPath
 453
 454
 455 guess'DataSourcePath'DataFrameQCustom :: BinocularsConfig'Common
 456                                       -> Maybe HklBinocularsQCustomSubProjectionEnum
 457                                       -> ConfigContent
 458                                       -> DataSourcePath DataFrameQCustom
 459 guess'DataSourcePath'DataFrameQCustom common msub cfg =
 460     do
 461       let inputtype = binocularsConfig'Common'InputType common
 462       let mAttenuationCoefficient = binocularsConfig'Common'AttenuationCoefficient common
 463       let detector =  binocularsConfig'Common'Detector common
 464       let mAttenuationMax = binocularsConfig'Common'AttenuationMax common
 465       let mAttenuationShift = binocularsConfig'Common'AttenuationShift common
 466       let mWavelength = binocularsConfig'Common'Wavelength common
 467
 468       -- attenuation
 469       let dataSourcePath'Attenuation'Sixs :: DataSourcePath Attenuation
 470           dataSourcePath'Attenuation'Sixs =
 471             DataSourcePath'Attenuation
 472             (DataSourcePath'Float (hdf5p $ grouppat 0 $ groupp "scan_data" (datasetp "attenuation"
 473                                                                             `H5Or`
 474                                                                             datasetp "attenuation_old")))
 475             (fromMaybe 2 mAttenuationShift) 0 mAttenuationMax
 476
 477       let dataSourcePath'Attenuation'SixsSBS :: DataSourcePath Attenuation
 478           dataSourcePath'Attenuation'SixsSBS =
 479             DataSourcePath'Attenuation
 480             (DataSourcePath'Float (hdf5p (datasetpattr ("long_name", "i14-c-c00/ex/roic/att")
 481                                           `H5Or`
 482                                           datasetpattr ("long_name", "i14-c-c00/ex/roic-s140/att")
 483                                           `H5Or`
 484                                           datasetpattr ("long_name", "i14-c-c00/ex/roic-s140/att_old")
 485                                           `H5Or`
 486                                           datasetpattr ("long_name", "i14-c-c00/ex/roic-s70/att")
 487                                           `H5Or`
 488                                           datasetpattr ("long_name", "i14-c-c00/ex/roic-s70/att_old"))))
 489             (fromMaybe 0 mAttenuationShift) 0 mAttenuationMax
 490
 491       -- timestamp
 492       let mkTimeStamp'Sbs :: Maybe HklBinocularsQCustomSubProjectionEnum -> DataSourcePath Timestamp
 493           mkTimeStamp'Sbs msub'
 494             = overloadTimestampPath msub' (DataSourcePath'Timestamp(hdf5p $ grouppat 0 $ datasetp "scan_data/sensors_timestamps"))
 495
 496       let mkTimeStamp'Fly :: Maybe HklBinocularsQCustomSubProjectionEnum -> DataSourcePath Timestamp
 497           mkTimeStamp'Fly msub'
 498             = overloadTimestampPath msub' (DataSourcePath'Timestamp(hdf5p $ grouppat 0 $ datasetp "scan_data/epoch"))
 499
 500       -- wavelength
 501       let dataSourcePath'WaveLength'Mars :: DataSourcePath Double
 502           dataSourcePath'WaveLength'Mars
 503             = DataSourcePath'Double ( hdf5p $ grouppat 0 $ datasetp "MARS/d03-1-c03__op__mono1-config_#2/lambda" )
 504               `DataSourcePath'Double'Or`
 505               DataSourcePath'Double'Const 1.537591
 506
 507       let dataSourcePath'WaveLength'Sixs ::  DataSourcePath Double
 508           dataSourcePath'WaveLength'Sixs
 509             = DataSourcePath'Double (hdf5p $ grouppat 0 (datasetp "SIXS/Monochromator/wavelength"
 510                                                          `H5Or`
 511                                                          datasetp "SIXS/i14-c-c02-op-mono/lambda"))
 512
 513       -- geometry
 514       let sixs'eix
 515             = DataSourcePath'Double'Ini cfg "geometry.values" "eix"
 516               `DataSourcePath'Double'Or`
 517               DataSourcePath'Double(hdf5p (grouppat 0 $ datasetp "scan_data/eix")
 518                                     `H5Or`
 519                                     hdf5p (grouppat 0 $ groupp "scan_data" $ datasetpattr ("long_name", "i14-c-cx1/dt/tab-mt_tx.1/position"))
 520                                     `H5Or`
 521                                     hdf5p (grouppat 0 $ groupp "scan_data" $ datasetpattr ("long_name", "i14-c-cx2/dt/tab-mt_tx.1/position"))
 522                                     `H5Or`
 523                                     hdf5p (grouppat 0 $ datasetp "SIXS/i14-c-cx1-dt-det_tx.1/position_pre"))
 524       let sixs'eiz
 525             = DataSourcePath'Double'Ini cfg "geometry.values" "eiz"
 526               `DataSourcePath'Double'Or`
 527               DataSourcePath'Double(hdf5p (grouppat 0 $ datasetp "scan_data/eiz")
 528                                     `H5Or`
 529                                     hdf5p (grouppat 0 $ groupp "scan_data" $ datasetpattr ("long_name", "i14-c-cx1/dt/tab-mt_tz.1/position"))
 530                                     `H5Or`
 531                                     hdf5p (grouppat 0 $ groupp "scan_data" $ datasetpattr ("long_name", "i14-c-cx2/dt/tab-mt_tz.1/position"))
 532                                     `H5Or`
 533                                     hdf5p (grouppat 0 $ datasetp "SIXS/i14-c-cx1-dt-det_tz.1/position_pre"))
 534
 535       let sixs'Uhv'Mu
 536             = DataSourcePath'Double'Ini cfg "geometry.values" "mu"
 537               `DataSourcePath'Double'Or`
 538               DataSourcePath'Double(hdf5p $ grouppat 0 $ groupp "scan_data" (datasetp "mu"
 539                                                                              `H5Or`
 540                                                                              datasetpattr ("long_name", "i14-c-cx2/ex/uhv-dif-group/mu")
 541                                                                              `H5Or`
 542                                                                              datasetp "UHV_MU"
 543                                                                              `H5Or`
 544                                                                              datasetp "mu_xps"))
 545       let sixs'Uhv'Omega
 546             = DataSourcePath'Double'Ini cfg "geometry.values" "omega"
 547               `DataSourcePath'Double'Or`
 548               DataSourcePath'Double(hdf5p $ grouppat 0 $ groupp "scan_data" (datasetp "omega"
 549                                                                              `H5Or`
 550                                                                              datasetp "UHV_OMEGA"
 551                                                                              `H5Or`
 552                                                                              datasetpattr ("long_name", "i14-c-cx2/ex/uhv-dif-group/omega")
 553                                                                              `H5Or`
 554                                                                              datasetp "omega_xps"))
 555       let sixs'Uhv'Delta
 556             = DataSourcePath'Double'Ini cfg "geometry.values" "delta"
 557               `DataSourcePath'Double'Or`
 558               DataSourcePath'Double(hdf5p $ grouppat 0 $ groupp "scan_data" (datasetp "delta"
 559                                                                              `H5Or`
 560                                                                              datasetp "UHV_DELTA"
 561                                                                              `H5Or`
 562                                                                              datasetpattr ("long_name", "i14-c-cx2/ex/uhv-dif-group/delta")
 563                                                                              `H5Or`
 564                                                                              datasetp "delta_xps"))
 565
 566       let sixs'Uhv'Gamma
 567             = DataSourcePath'Double'Ini cfg "geometry.values" "gamma"
 568               `DataSourcePath'Double'Or`
 569               DataSourcePath'Double(hdf5p $ grouppat 0 $ groupp "scan_data" (datasetp "gamma"
 570                                                                              `H5Or`
 571                                                                              datasetp "UHV_GAMMA"
 572                                                                              `H5Or`
 573                                                                              datasetpattr ("long_name", "i14-c-cx2/ex/uhv-dif-group/gamma")
 574                                                                              `H5Or`
 575                                                                              datasetp "gamma_xps"))
 576
 577       let dataSourcePath'Geometry'Sixs'Uhv :: DataSourcePath Geometry
 578           dataSourcePath'Geometry'Sixs'Uhv
 579             = DataSourcePath'Geometry
 580               (Geometry'Factory Uhv)
 581               (overloadWaveLength mWavelength dataSourcePath'WaveLength'Sixs)
 582               [sixs'Uhv'Mu, sixs'Uhv'Omega, sixs'Uhv'Delta, sixs'Uhv'Gamma]
 583
 584       let dataSourcePath'Geometry'Sixs'UhvGisaxs :: DataSourcePath Geometry
 585           dataSourcePath'Geometry'Sixs'UhvGisaxs
 586             = DataSourcePath'Geometry
 587               sixsUhvGisaxs
 588               (overloadWaveLength mWavelength dataSourcePath'WaveLength'Sixs)
 589               [ sixs'Uhv'Mu, sixs'Uhv'Omega, sixs'eix, sixs'eiz ]
 590
 591       let sixs'Med'Beta
 592             = DataSourcePath'Double'Ini cfg "geometry.values" "beta"
 593               `DataSourcePath'Double'Or`
 594               DataSourcePath'Double(hdf5p $ grouppat 0 (groupp "scan_data" (datasetp "beta"
 595                                                                             `H5Or`
 596                                                                             datasetpattr ("long_name", "i14-c-cx1/ex/diff-med-tpp/pitch"))
 597                                                         `H5Or`
 598                                                         datasetp "SIXS/i14-c-cx1-ex-diff-med-tpp/TPP/Orientation/pitch"))
 599       let sixs'MedH'Mu
 600             = DataSourcePath'Double'Ini cfg "geometry.values" "mu"
 601               `DataSourcePath'Double'Or`
 602               DataSourcePath'Double(hdf5p $ grouppat 0 $ groupp "scan_data" (datasetp "mu"
 603                                                                              `H5Or`
 604                                                                               datasetpattr ("long_name", "i14-c-cx1/ex/med-h-dif-group.1/mu")))
 605       let sixs'MedV'Mu
 606             = DataSourcePath'Double'Ini cfg "geometry.values" "mu"
 607               `DataSourcePath'Double'Or`
 608               DataSourcePath'Double(hdf5p $ grouppat 0 $ groupp "scan_data" (datasetp "mu"
 609                                                                              `H5Or`
 610                                                                               datasetpattr ("long_name", "i14-c-cx1/ex/med-v-dif-group.1/mu")))
 611       let sixs'MedV'Omega
 612             = DataSourcePath'Double'Ini cfg "geometry.values" "omega"
 613               `DataSourcePath'Double'Or`
 614               DataSourcePath'Double(hdf5p $ grouppat 0 $ groupp "scan_data" (datasetp "omega"
 615                                                                              `H5Or`
 616                                                                              datasetpattr ("long_name", "i14-c-cx1/ex/med-v-dif-group.1/omega")))
 617       let sixs'MedH'Gamma
 618             = DataSourcePath'Double'Ini cfg "geometry.values" "gamma"
 619               `DataSourcePath'Double'Or`
 620               DataSourcePath'Double(hdf5p $ grouppat 0 $ groupp "scan_data" (datasetp "gamma"
 621                                                                              `H5Or`
 622                                                                              datasetpattr ("long_name", "i14-c-cx1/ex/med-h-dif-group.1/gamma")))
 623       let sixs'MedV'Gamma
 624             = DataSourcePath'Double'Ini cfg "geometry.values" "gamma"
 625               `DataSourcePath'Double'Or`
 626               DataSourcePath'Double(hdf5p $ grouppat 0 $ groupp "scan_data" (datasetp "gamma"
 627                                                                              `H5Or`
 628                                                                              datasetpattr ("long_name", "i14-c-cx1/ex/med-v-dif-group.1/gamma")))
 629       let sixs'MedH'Delta
 630             = DataSourcePath'Double'Ini cfg "geometry.values" "delta"
 631               `DataSourcePath'Double'Or`
 632               DataSourcePath'Double(hdf5p $ grouppat 0 $ groupp "scan_data" (datasetp "delta"
 633                                                                              `H5Or`
 634                                                                              datasetpattr ("long_name", "i14-c-cx1/ex/med-h-dif-group.1/delta")))
 635
 636       let sixs'MedV'Delta
 637             = DataSourcePath'Double'Ini cfg "geometry.values" "delta"
 638               `DataSourcePath'Double'Or`
 639               DataSourcePath'Double(hdf5p $ grouppat 0 $ groupp "scan_data" (datasetp "delta"
 640                                                                              `H5Or`
 641                                                                              datasetpattr ("long_name", "i14-c-cx1/ex/med-v-dif-group.1/delta")))
 642
 643       let sixs'MedV'Etaa
 644             = DataSourcePath'Double'Ini cfg "geometry.values" "etaa"
 645               `DataSourcePath'Double'Or`
 646               DataSourcePath'Double(hdf5p $ grouppat 0 $ groupp "scan_data" (datasetp "etaa"
 647                                                                              `H5Or`
 648                                                                              datasetpattr ("long_name", "i14-c-cx1/ex/med-v-dif-group.1/etaa")))
 649
 650
 651       let dataSourcePath'Geometry'Sixs'MedH ::  DataSourcePath Geometry
 652           dataSourcePath'Geometry'Sixs'MedH
 653             = DataSourcePath'Geometry
 654               (Geometry'Factory MedH)
 655               (overloadWaveLength mWavelength dataSourcePath'WaveLength'Sixs)
 656               [ sixs'Med'Beta, sixs'MedH'Mu, sixs'MedH'Gamma, sixs'MedH'Delta ]
 657
 658       let dataSourcePath'Geometry'Sixs'MedHGisaxs ::  DataSourcePath Geometry
 659           dataSourcePath'Geometry'Sixs'MedHGisaxs
 660             = DataSourcePath'Geometry
 661               sixsMedHGisaxs
 662               (overloadWaveLength mWavelength dataSourcePath'WaveLength'Sixs)
 663               [ sixs'Med'Beta, sixs'MedH'Mu, sixs'eix, sixs'eiz ]
 664
 665       let dataSourcePath'Geometry'Sixs'MedV :: DataSourcePath Geometry
 666           dataSourcePath'Geometry'Sixs'MedV
 667             = DataSourcePath'Geometry
 668               (Geometry'Factory MedV)
 669               (overloadWaveLength mWavelength dataSourcePath'WaveLength'Sixs)
 670               [ sixs'Med'Beta, sixs'MedV'Mu, sixs'MedV'Omega, sixs'MedV'Gamma, sixs'MedV'Delta, sixs'MedV'Etaa ]
 671
 672       let dataSourcePath'Geometry'Sixs'MedVGisaxs :: DataSourcePath Geometry
 673           dataSourcePath'Geometry'Sixs'MedVGisaxs
 674             = DataSourcePath'Geometry
 675               sixsMedVGisaxs
 676               (overloadWaveLength mWavelength dataSourcePath'WaveLength'Sixs)
 677               [ sixs'Med'Beta, sixs'MedV'Mu, sixs'MedV'Omega, sixs'eix, sixs'eiz ]
 678
 679       let dataSourcePath'DataFrameQCustom'Sixs'Fly :: DataSourcePath Geometry -> DataSourcePath DataFrameQCustom
 680           dataSourcePath'DataFrameQCustom'Sixs'Fly g
 681             = DataSourcePath'DataFrameQCustom
 682               (mkAttenuation mAttenuationCoefficient dataSourcePath'Attenuation'Sixs)
 683               g
 684               (mkDetector'Sixs'Fly detector)
 685               (mkTimeStamp'Fly msub)
 686
 687       let dataSourcePath'DataFrameQCustom'Sixs'Sbs :: DataSourcePath Geometry -> DataSourcePath DataFrameQCustom
 688           dataSourcePath'DataFrameQCustom'Sixs'Sbs g
 689             = DataSourcePath'DataFrameQCustom
 690               (mkAttenuation mAttenuationCoefficient dataSourcePath'Attenuation'SixsSBS)
 691               g
 692               (mkDetector'Sixs'Sbs detector)
 693               (mkTimeStamp'Sbs msub)
 694
 695       case inputtype of
 696          CristalK6C -> DataSourcePath'DataFrameQCustom
 697                       (mkAttenuation mAttenuationCoefficient  DataSourcePath'NoAttenuation)
 698                       (DataSourcePath'Geometry
 699                         (Geometry'Factory K6c)
 700                         (overloadWaveLength mWavelength (DataSourcePath'Double (hdf5p $ grouppat 0 $ datasetp "CRISTAL/Monochromator/lambda")))
 701                         [ DataSourcePath'Double (hdf5p $ grouppat 0 $ datasetp "CRISTAL/Diffractometer/i06-c-c07-ex-dif-mu/position")
 702                         , DataSourcePath'Double (hdf5p $ grouppat 0 $ datasetp "CRISTAL/Diffractometer/i06-c-c07-ex-dif-komega/position")
 703                         , DataSourcePath'Double (hdf5p $ grouppat 0 $ datasetp "CRISTAL/Diffractometer/i06-c-c07-ex-dif-kappa/position")
 704                         , DataSourcePath'Double (hdf5p $ grouppat 0 $ datasetp "scan_data/actuator_1_1")
 705                         , DataSourcePath'Double (hdf5p $ grouppat 0 $ datasetp "CRISTAL/Diffractometer/i06-c-c07-ex-dif-gamma/position")
 706                         , DataSourcePath'Double (hdf5p $ grouppat 0 $ datasetp "CRISTAL/Diffractometer/i06-c-c07-ex-dif-delta/position")
 707                         ]
 708                       )
 709                       (DataSourcePath'Image
 710                         (hdf5p $ grouppat 0 $ datasetp "scan_data/data_05")
 711                         detector)
 712                       (mkTimeStamp'Sbs msub)
 713          MarsFlyscan -> DataSourcePath'DataFrameQCustom
 714                        (mkAttenuation mAttenuationCoefficient DataSourcePath'NoAttenuation)
 715                        -- (mkAttenuation mAttenuationCoefficient (DataSourcePath'ApplyedAttenuationFactor
 716                        --                                         (DataSourcePath'Float (hdf5p $ grouppat 0 $ datasetp "scan_data/applied_att"))))
 717                        (DataSourcePath'Geometry
 718                          (Geometry'Factory Mars)
 719                          (overloadWaveLength mWavelength dataSourcePath'WaveLength'Mars)
 720                          [ DataSourcePath'Double(hdf5p $ grouppat 0 $ datasetp "scan_data/omega")
 721                          , DataSourcePath'Double(hdf5p $ grouppat 0 $ datasetp "scan_data/chi")
 722                          , DataSourcePath'Double(hdf5p $ grouppat 0 $ datasetp "scan_data/phi")
 723                          , DataSourcePath'Double(hdf5p $ grouppat 0 $ datasetp "scan_data/tth")
 724                          ])
 725                        (DataSourcePath'Image
 726                          (hdf5p $ grouppat 0 (datasetp "scan_data/merlin_image"
 727                                               `H5Or`
 728                                               datasetp "scan_data/merlin_quad_image"))
 729                          detector)
 730                        (mkTimeStamp'Fly msub)
 731          MarsSbs -> DataSourcePath'DataFrameQCustom
 732                    (mkAttenuation mAttenuationCoefficient DataSourcePath'NoAttenuation)
 733                    (DataSourcePath'Geometry
 734                      (Geometry'Factory Mars)
 735                      (overloadWaveLength mWavelength dataSourcePath'WaveLength'Mars)
 736                      [ DataSourcePath'Double(hdf5p $ grouppat 0 $ (datasetp "scan_data/omega"
 737                                                                    `H5Or`
 738                                                                    datasetp "MARS/d03-1-cx2__ex__dif-mt_rx.1_#2/raw_value"))
 739
 740                        `DataSourcePath'Double'Or`
 741                        DataSourcePath'Double'Const 0
 742                      , DataSourcePath'Double(hdf5p $ grouppat 0 $ (datasetp "scan_data/chi"
 743                                                                    `H5Or`
 744                                                                    datasetp "MARS/d03-1-cx2__ex__gonio-mt_rs_#2/raw_value"))
 745                        `DataSourcePath'Double'Or`
 746                        DataSourcePath'Double'Const 0
 747                      , DataSourcePath'Double(hdf5p $ grouppat 0 $ (datasetp "scan_data/phi"
 748                                                                    `H5Or`
 749                                                                    datasetpattr ("long_name", "d03-1-cx2/ex/gonio-mt_rz/position")
 750                                                                    `H5Or`
 751                                                                    datasetp "MARS/d03-1-cx2__ex__gonio-mt_rz_#2/raw_value"))
 752                        `DataSourcePath'Double'Or`
 753                        DataSourcePath'Double'Const 0
 754                      , DataSourcePath'Double(hdf5p $ grouppat 0 $ (datasetp "scan_data/tth"
 755                                                                    `H5Or`
 756                                                                    datasetp "MARS/d03-1-cx2__ex__dif-mt_rx.2_#2/raw_value"))
 757                        `DataSourcePath'Double'Or`
 758                        DataSourcePath'Double'Const 0
 759                      ])
 760                    (DataSourcePath'Image
 761                     (hdf5p $ (datasetpattr ("long_name", "d03-1-c00/dt/merlin-quad/image")
 762                              `H5Or`
 763                              datasetpattr ("interpretation", "image")))
 764                     detector)
 765                    (mkTimeStamp'Sbs msub)
 766          SixsFlyMedH -> dataSourcePath'DataFrameQCustom'Sixs'Fly dataSourcePath'Geometry'Sixs'MedH
 767          SixsFlyMedHGisaxs -> dataSourcePath'DataFrameQCustom'Sixs'Fly dataSourcePath'Geometry'Sixs'MedHGisaxs
 768          SixsFlyMedV -> dataSourcePath'DataFrameQCustom'Sixs'Fly dataSourcePath'Geometry'Sixs'MedV
 769          SixsFlyMedVGisaxs -> dataSourcePath'DataFrameQCustom'Sixs'Fly dataSourcePath'Geometry'Sixs'MedVGisaxs
 770          SixsFlyUhv -> dataSourcePath'DataFrameQCustom'Sixs'Fly dataSourcePath'Geometry'Sixs'Uhv
 771          SixsFlyUhvGisaxs -> dataSourcePath'DataFrameQCustom'Sixs'Fly dataSourcePath'Geometry'Sixs'UhvGisaxs
 772          SixsSbsMedH -> dataSourcePath'DataFrameQCustom'Sixs'Sbs dataSourcePath'Geometry'Sixs'MedH
 773          SixsSbsMedHGisaxs -> dataSourcePath'DataFrameQCustom'Sixs'Sbs dataSourcePath'Geometry'Sixs'MedHGisaxs
 774          SixsSbsMedV -> dataSourcePath'DataFrameQCustom'Sixs'Sbs dataSourcePath'Geometry'Sixs'MedV
 775          SixsSbsMedVGisaxs -> dataSourcePath'DataFrameQCustom'Sixs'Sbs dataSourcePath'Geometry'Sixs'MedVGisaxs
 776          SixsSbsUhv -> dataSourcePath'DataFrameQCustom'Sixs'Sbs dataSourcePath'Geometry'Sixs'Uhv
 777          SixsSbsUhvGisaxs -> dataSourcePath'DataFrameQCustom'Sixs'Sbs dataSourcePath'Geometry'Sixs'UhvGisaxs
 778
 779
 780 {-# INLINE spaceQCustom #-}
 781 spaceQCustom :: Detector a DIM2
 782              -> Array F DIM3 Double
 783              -> Resolutions DIM3
 784              -> Maybe Mask
 785              -> HklBinocularsSurfaceOrientationEnum
 786              -> Maybe (RLimits DIM3)
 787              -> HklBinocularsQCustomSubProjectionEnum
 788              -> Angle Double -> Angle Double -> Angle Double
 789              -> Maybe SampleAxis
 790              -> Bool
 791              -> Space DIM3
 792              -> DataFrameQCustom
 793              -> IO (DataFrameSpace DIM3)
 794 spaceQCustom det pixels rs mmask' surf mlimits subprojection uqx uqy uqz mSampleAxis doPolarizationCorrection space@(Space fSpace) (DataFrameQCustom att g img index) =
 795   withNPixels det $ \nPixels ->
 796   withForeignPtr g $ \geometry ->
 797   withForeignPtr (toForeignPtr pixels) $ \pix ->
 798   withResolutions rs $ \nr r ->
 799   withPixelsDims pixels $ \ndim dims ->
 800   withMaybeMask mmask' $ \ mask'' ->
 801   withMaybeLimits mlimits rs $ \nlimits limits ->
 802   withMaybeSampleAxis mSampleAxis $ \sampleAxis ->
 803   withForeignPtr fSpace $ \pSpace -> do
 804   case img of
 805     (ImageInt32 arr) -> unsafeWith arr $ \i -> do
 806       {-# SCC "hkl_binoculars_space_qcustom_int32_t" #-} c'hkl_binoculars_space_qcustom_int32_t pSpace geometry i nPixels (CDouble . unAttenuation $ att) pix (toEnum ndim) dims r (toEnum nr) mask'' (toEnum $ fromEnum surf) limits (toEnum nlimits) (CDouble . unTimestamp $ index) (toEnum . fromEnum $ subprojection) (CDouble (uqx /~ radian)) (CDouble (uqy /~ radian)) (CDouble (uqz /~ radian)) sampleAxis (toEnum . fromEnum $ doPolarizationCorrection)
 807     (ImageWord16 arr) -> unsafeWith arr $ \i -> do
 808       {-# SCC "hkl_binoculars_space_qcustom_uint16_t" #-} c'hkl_binoculars_space_qcustom_uint16_t pSpace geometry i nPixels (CDouble . unAttenuation $ att) pix (toEnum ndim) dims r (toEnum nr) mask'' (toEnum $ fromEnum surf) limits (toEnum nlimits) (CDouble . unTimestamp $ index) (toEnum . fromEnum $ subprojection) (CDouble (uqx /~ radian)) (CDouble (uqy /~ radian)) (CDouble (uqz /~ radian)) sampleAxis (toEnum . fromEnum $ doPolarizationCorrection)
 809     (ImageWord32 arr) -> unsafeWith arr $ \i -> do
 810       {-# SCC "hkl_binoculars_space_qcustom_uint32_t" #-} c'hkl_binoculars_space_qcustom_uint32_t pSpace geometry i nPixels (CDouble . unAttenuation $ att) pix (toEnum ndim) dims r (toEnum nr) mask'' (toEnum $ fromEnum surf) limits (toEnum nlimits) (CDouble . unTimestamp $ index) (toEnum . fromEnum $ subprojection) (CDouble (uqx /~ radian)) (CDouble (uqy /~ radian)) (CDouble (uqz /~ radian)) sampleAxis (toEnum . fromEnum $ doPolarizationCorrection)
 811
 812   return (DataFrameSpace img space att)
 813
 814 ----------
 815 -- Pipe --
 816 ----------
 817
 818 processQCustomP :: (MonadIO m, MonadLogger m, MonadReader (Config 'QCustomProjection) m, MonadThrow m)
 819                 => m ()
 820 processQCustomP = do
 821   (conf :: Config 'QCustomProjection) <- ask
 822
 823   -- directly from the common config
 824   let common = binocularsConfig'QCustom'Common conf
 825   let overwrite = binocularsConfig'Common'Overwrite common
 826   let det = binocularsConfig'Common'Detector common
 827   let (NCores cap) =  binocularsConfig'Common'NCores common
 828   let destination = binocularsConfig'Common'Destination common
 829   let centralPixel' = binocularsConfig'Common'Centralpixel common
 830   let (Meter sampleDetectorDistance) = binocularsConfig'Common'Sdd common
 831   let (Degree detrot) = binocularsConfig'Common'Detrot common
 832   let mImageSumMax = binocularsConfig'Common'ImageSumMax common
 833   let inputRange = binocularsConfig'Common'InputRange common
 834   let nexusDir = binocularsConfig'Common'Nexusdir common
 835   let tmpl = binocularsConfig'Common'Tmpl common
 836   let maskMatrix = binocularsConfig'Common'Maskmatrix common
 837   let mSkipFirstPoints = binocularsConfig'Common'SkipFirstPoints common
 838   let mSkipLastPoints = binocularsConfig'Common'SkipLastPoints common
 839   let doPolarizationCorrection = binocularsConfig'Common'PolarizationCorrection common
 840
 841   -- directly from the specific config
 842   let mlimits = binocularsConfig'QCustom'ProjectionLimits conf
 843   let res = binocularsConfig'QCustom'ProjectionResolution conf
 844   let surfaceOrientation = binocularsConfig'QCustom'HklBinocularsSurfaceOrientationEnum conf
 845   let datapaths = binocularsConfig'QCustom'DataPath conf
 846   let subprojection = fromJust (binocularsConfig'QCustom'SubProjection conf) -- should not be Maybe
 847   let projectionType = binocularsConfig'QCustom'ProjectionType conf
 848   let (Degree uqx) = binocularsConfig'QCustom'Uqx conf
 849   let (Degree uqy) = binocularsConfig'QCustom'Uqy conf
 850   let (Degree uqz) = binocularsConfig'QCustom'Uqz conf
 851   let mSampleAxis = binocularsConfig'QCustom'SampleAxis conf
 852
 853   -- built from the config
 854   output' <- liftIO $ destination' projectionType (Just subprojection) inputRange mlimits destination overwrite
 855   filenames <- InputFn'List <$> files nexusDir (Just inputRange) tmpl
 856   mask' <- getMask maskMatrix det
 857   pixels <- liftIO $ getPixelsCoordinates det centralPixel' sampleDetectorDistance detrot NoNormalisation
 858
 859   -- compute the jobs
 860
 861   let fns = concatMap (replicate 1) (toList filenames)
 862   chunks <- liftIO $ runSafeT $ toListM $ each fns >-> chunkP mSkipFirstPoints mSkipLastPoints datapaths
 863   let ntot = sum (Prelude.map clength chunks)
 864   let jobs = chunk (quot ntot cap) chunks
 865
 866   -- log parameters
 867
 868   logDebugNSH filenames
 869   logDebugNSH datapaths
 870   logDebugNSH chunks
 871   logDebugNSH ntot
 872   logDebugNSH jobs
 873   logDebugN "start gessing final cube size"
 874
 875   -- guess the final cube dimensions (To optimize, do not create the cube, just extract the shape)
 876
 877   guessed <- liftIO $ withCubeAccumulator EmptyCube $ \c ->
 878     runSafeT $ runEffect $
 879     each chunks
 880     >-> Pipes.Prelude.map (\(Chunk fn f t) -> (fn, [f, quot (f + t) 4, quot (f + t) 4 * 2, quot (f + t) 4 * 3, t]))
 881     >-> framesP datapaths
 882     >-> project det 3 (spaceQCustom det pixels res mask' surfaceOrientation mlimits subprojection uqx uqy uqz mSampleAxis doPolarizationCorrection)
 883     >-> accumulateP c
 884
 885   logDebugN "stop gessing final cube size"
 886
 887   -- do the final projection
 888
 889   logInfoN $ pack $ printf "let's do a QCustom projection of %d %s image(s) on %d core(s)" ntot (show det) cap
 890
 891   liftIO $ withProgressBar ntot $ \pb -> do
 892     r' <- mapConcurrently (\job -> withCubeAccumulator guessed $ \c ->
 893                              runSafeT $ runEffect $
 894                              each job
 895                              >-> Pipes.Prelude.map (\(Chunk fn f t) -> (fn, [f..t]))
 896                              >-> framesP datapaths
 897                              >-> Pipes.Prelude.filter (\(DataFrameQCustom _ _ img _) -> filterSumImage mImageSumMax img)
 898                              >-> project det 3 (spaceQCustom det pixels res mask' surfaceOrientation mlimits subprojection uqx uqy uqz mSampleAxis doPolarizationCorrection)
 899                              >-> tee (accumulateP c)
 900                              >-> progress pb
 901                          ) jobs
 902     saveCube output' (unpack . serializeConfig $ conf) r'
 903
 904
 905 instance ChunkP (DataSourcePath DataFrameQCustom) where
 906     chunkP mSkipFirst mSkipLast (DataSourcePath'DataFrameQCustom ma _ (DataSourcePath'Image i _) _) =
 907       skipMalformed $ forever $ do
 908       fp <- await
 909       withFileP (openFile' fp) $ \f ->
 910         withHdf5PathP f i $ \i' -> do
 911         (_, ss) <- liftIO $ datasetShape i'
 912         case head ss of
 913           (Just n) -> yield $ let (Chunk _ from to) = cclip (fromMaybe 0 mSkipFirst) (fromMaybe 0 mSkipLast) (Chunk fp 0 (fromIntegral n - 1))
 914                              in case ma of
 915                                   DataSourcePath'NoAttenuation -> Chunk fp from to
 916                                   (DataSourcePath'Attenuation _ off _ _) -> Chunk fp from (to - off)
 917                                   (DataSourcePath'ApplyedAttenuationFactor _) -> Chunk fp from to
 918           Nothing  -> error "can not extract length"
 919
 920 instance FramesP (DataSourcePath DataFrameQCustom) DataFrameQCustom where
 921     framesP p =
 922         skipMalformed $ forever $ do
 923           (fn, js) <- await
 924           withFileP (openFile' fn) $ \f ->
 925             withDataSourceP f p $ \ g ->
 926             forM_ js (tryYield . extract1DStreamValue g)
 927
 928 ---------
 929 -- Cmd --
 930 ---------
 931
 932 processQCustom :: (MonadLogger m, MonadThrow m, MonadIO m) => Maybe FilePath -> Maybe ConfigRange -> m ()
 933 processQCustom mf mr = cmd processQCustomP mf (Args'QCustomProjection mr)
 934
 935 newQCustom :: (MonadIO m, MonadLogger m, MonadThrow m)
 936            => Path Abs Dir -> m ()
 937 newQCustom cwd = do
 938   let conf = default'BinocularsConfig'QCustom
 939              { binocularsConfig'QCustom'Common = default'BinocularsConfig'Common
 940                                                  { binocularsConfig'Common'Nexusdir = Just cwd }
 941              }
 942   liftIO $ Data.Text.IO.putStr $ serializeConfig conf
 943
 944 updateQCustom :: (MonadIO m, MonadLogger m, MonadThrow m)
 945               => Maybe FilePath -> Maybe ConfigRange -> m ()
 946 updateQCustom mf mr = cmd (pure ()) mf (Args'QCustomProjection mr)