Hello Li-yao thanks a lot for you explanations, it helps me a lot. I end up with this error (beware the long error message...) src/Hkl/Binoculars/Projections/Config/Sample.hs:68:14: error: [GHC-39999] • Could not deduce ‘Hkl.DataSource.GDataSourceAcq (GHC.Generics.C1 (GHC.Generics.MetaCons "DataSourceT'Sample" GHC.Generics.PrefixI False) (((GHC.Generics.S1 (GHC.Generics.MetaSel Nothing GHC.Generics.NoSourceUnpackedness GHC.Generics.NoSourceStrictness GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 (DataSourceT DSAcq Double)) GHC.Generics.:*: GHC.Generics.S1 (GHC.Generics.MetaSel Nothing GHC.Generics.NoSourceUnpackedness GHC.Generics.NoSourceStrictness GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 (DataSourceT DSAcq Double))) GHC.Generics.:*: (GHC.Generics.S1 (GHC.Generics.MetaSel Nothing GHC.Generics.NoSourceUnpackedness GHC.Generics.NoSourceStrictness GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 (DataSourceT DSAcq Double)) GHC.Generics.:*: GHC.Generics.S1 (GHC.Generics.MetaSel Nothing GHC.Generics.NoSourceUnpackedness GHC.Generics.NoSourceStrictness GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 (DataSourceT DSAcq Degree)))) GHC.Generics.:*: ((GHC.Generics.S1 (GHC.Generics.MetaSel Nothing GHC.Generics.NoSourceUnpackedness GHC.Generics.NoSourceStrictness GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 (DataSourceT DSAcq Degree)) GHC.Generics.:*: GHC.Generics.S1 (GHC.Generics.MetaSel Nothing GHC.Generics.NoSourceUnpackedness GHC.Generics.NoSourceStrictness GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 (DataSourceT DSAcq Degree))) GHC.Generics.:*: (GHC.Generics.S1 (GHC.Generics.MetaSel Nothing GHC.Generics.NoSourceUnpackedness GHC.Generics.NoSourceStrictness GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 (DataSourceT DSAcq Degree)) GHC.Generics.:*: (GHC.Generics.S1 (GHC.Generics.MetaSel GHC.Generics.NoSourceUnpackedness GHC.Generics.NoSourceStrictness GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 (DataSourceT DSAcq Degree)) GHC.Generics.:*: GHC.Generics.S1 (GHC.Generics.MetaSel Nothing GHC.Generics.NoSourceUnpackedness GHC.Generics.NoSourceStrictness GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 (DataSourceT DSAcq Degree)))))) GHC.Generics.:+: GHC.Generics.C1 (GHC.Generics.MetaCons "DataSourceT'Sample'Or" GHC.Generics.PrefixI False) (GHC.Generics.S1 (GHC.Generics.MetaSel Nothing GHC.Generics.NoSourceUnpackedness GHC.Generics.NoSourceStrictness GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 (DataSourceT DSAcq Sample)) GHC.Generics.:*: GHC.Generics.S1 (GHC.Generics.MetaSel Nothing GHC.Generics.NoSourceUnpackedness GHC.Generics.NoSourceStrictness GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 (DataSourceT DSAcq Sample))))’ Nothing arising from a use of ‘generic'ds'Shape’ from the context: Pipes.Safe.MonadSafe m bound by the type signature for: ds'Shape :: forall (m :: * -> *). Pipes.Safe.MonadSafe m => DataSourceT DSAcq Sample -> m DataSourceShape at src/Hkl/Binoculars/Projections/Config/Sample.hs:68:3-10 • In the expression: generic'ds'Shape In an equation for ‘ds'Shape’: ds'Shape = generic'ds'Shape In the instance declaration for ‘DataSource Sample’ | 68 | ds'Shape = generic'ds'Shape | ^^^^^^^^^^^^^^^^ It works great if I have this type. instance DataSource Sample where data DataSourceT k Sample = DataSourceT'Sample (DataSourceT k Double) -- a (DataSourceT k Double) -- b (DataSourceT k Double) -- c (DataSourceT k Degree) -- alpha (DataSourceT k Degree) -- beta (DataSourceT k Degree) -- gamma (DataSourceT k Degree) -- ux (DataSourceT k Degree) -- uy (DataSourceT k Degree) -- uz deriving (Generic) ds'Shape = generic'ds'Shape but not If I need to add this other constructor | DataSourceT'Sample'Or (DataSourceT k Sample) (DataSourceT k Sample) is it connected to this ? GHC.Generics.:+: GHC.Generics.C1 There is no instance for :+: in your proposition. These `Or` Constructor are usefull with the default withDatasourcePOr of the cladd DataSource , it is a sort of fallback. try the first and if something goes wrong try the second one. withDataSourcePOr ∷ (Location l, MonadSafe m) ⇒ ScanFile l → DataSourceT DSPath a → DataSourceT DSPath a → (DataSourceT DSAcq a → m r) → m r withDataSourcePOr f l r g = withDataSourceP f l g `catch` λexl → withDataSourceP f r g `catch` λexr → throwM $ CanNotOpenDataSource'Or exl exr This is how I define the fallback when declaring the instance from this Or constructor withDataSourceP f (DataSourcePath'Sample'Or l r) g = withDataSourcePOr f l r g I don ot know if this is the right design... thanks Fred

The DataSourceT type is already HKDified. You can make it the parameter of the class directly: class DataSource d where   ds'Shape :: MonadSafe m => d Acq -> m DataSourceShape   withDataSourceP :: MonadSafe m => ... -> d Path -> (d Acq -> m r) -> m r data Sample k = MkSample   (DataSourceDouble k) -- define a wrapper for each base type which will be the new argument for the corresponding DataSource instance   (Degree k)   -- (...) instance DataSource Sample where   -- (...) For your issue with sums, it doesn't seem right to encode alternative "data paths" as extra constructors. Correct me if you had a different idea in mind. To start, given the DataSource method: withDataSourceP :: MonadSafe m => ... -> d Path -> (d Acq -> m r) -> m r you can implement: withDataSourcesP :: (DataSource d, MonadSafe m) => ... -> [d Path] -> (d Acq -> m r) -> m r by trying `withDataSourceP` with each element in the list. Now I'm guessing that the reason you wanted an `Or` constructor was so that you could list alternatives to populate individual components of your struct. For example, maybe there are N possible sources for some data alpha, and M possible sources for some data beta, and you don't want to turn that into a flat list of N*M ways to get (alpha, beta). The goal is for `Sample k` to look like this when `k = Path`: data Sample Path = MkSample   [DataSourceDouble Path]   [Degree Path]   -- (...) but stay like this when `k = Acq`: data Sample Acq = MkSample   (DataSourceDouble Acq)   (Degree Acq) That is possible by creating a field wrapper parameterized by `k`: data Sample k = MkSample   (Wrap k (DataSourceDouble k))   (Wrap k (Degree k)) So that Wrap Path t = [t] and Wrap Acq t = t. type family Wrap (k :: DSKind) t where   Wrap Path t = [t]   Wrap Acq t = t Below is a compilable example, modified from my previous email with the changes described above. On the generic side, the main change is that some (DataSourceT Path a) become [a Path] (with the list type!) and some calls to withDataSourceP become withDataSourcesP that I introduced above. Cheers, Li-yao --- {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} module G where import GHC.Generics import Data.Kind (Type) -- * Interface data DataSourceShape   = DummyDSS Int combine'Shape :: DataSourceShape -> DataSourceShape -> DataSourceShape combine'Shape (DummyDSS x) (DummyDSS y) = DummyDSS (x + y) -- simplified variants of catch and throw for the sake of example class MonadCatch m where   throw_ :: m a   catch_ :: m a -> m a -> m a data DSKind = Acq | Path type family DSWrap (k :: DSKind) (t :: Type) :: Type where   DSWrap Acq t = t   DSWrap Path t = [t] type DSWrap_ f k = DSWrap k (f k) class DataSource d where   ds'Shape :: Monad m => d Acq -> m DataSourceShape   withDataSourceP :: MonadCatch m => String -> d Path -> (d Acq -> m r) -> m r withDataSourcesP :: (DataSource d, MonadCatch m) => String -> [d Path] -> (d Acq -> m r) -> m r withDataSourcesP file [] _ = throw_ withDataSourcesP file (s : ss) k = withDataSourceP file s k `catch_` withDataSourcesP file ss k -- | Generic 'ds'Shape' generic'ds'Shape :: (Monad m, Generic (d Acq), GDataSourceAcq (Rep (d Acq))) => d Acq -> m DataSourceShape generic'ds'Shape = g'ds'Shape . from -- | Generic 'withDataSourceP' generic'withDataSourceP ::   (Generic (d Path), Generic (d Acq), GDataSourcePath (Rep (d Path)) (Rep (d Acq)), MonadCatch m) =>   String -> d Path -> (d Acq -> m r) -> m r generic'withDataSourceP file src gg = g'withDataSourceP file (from src) (gg . to) -- ** Base instance data family BaseData (k :: DSKind) newtype instance BaseData Acq = BaseDataAcq String newtype instance BaseData Path = BaseDataPath [String] instance DataSource BaseData where   ds'Shape _ = pure (DummyDSS 1)   withDataSourceP _ _ k = k (BaseDataAcq "source") -- * Generic example usage data ExampleData (k :: DSKind)   = ExampleData       (DSWrap_ BaseData k)       (DSWrap_ BaseData k)       (DSWrap_ BaseData k)       (DSWrap_ BaseData k)       (DSWrap_ BaseData k)   deriving Generic instance DataSource ExampleData where   ds'Shape = generic'ds'Shape   withDataSourceP = generic'withDataSourceP -- * Generic implementation class GDataSourceAcq dataAcq where   g'ds'Shape :: Monad m => dataAcq x -> m DataSourceShape class GDataSourcePath dataPath dataAcq where   g'withDataSourceP :: MonadCatch m => String -> dataPath x -> (dataAcq x -> m r) -> m r instance GDataSourceAcq f => GDataSourceAcq (M1 i c f) where   g'ds'Shape (M1 f) = g'ds'Shape f instance GDataSourcePath f g => GDataSourcePath (M1 i c f) (M1 i c' g) where   g'withDataSourceP f (M1 d) gg = g'withDataSourceP f d (gg . M1) instance (GDataSourceAcq f, GDataSourceAcq f') => GDataSourceAcq (f :*: f') where   g'ds'Shape (f :*: f') = liftA2 combine'Shape (g'ds'Shape f) (g'ds'Shape f') instance (GDataSourcePath f g, GDataSourcePath f' g') => GDataSourcePath (f :*: f') (g :*: g') where   g'withDataSourceP file (f :*: f') gg =     g'withDataSourceP file f $ \g ->     g'withDataSourceP file f' $ \g' ->       gg (g :*: g') instance DataSource a => GDataSourceAcq (K1 i (a Acq)) where   g'ds'Shape (K1 acq) = ds'Shape acq instance DataSource a => GDataSourcePath (K1 i [a Path]) (K1 i (a Acq)) where   g'withDataSourceP file (K1 acq) gg =     withDataSourcesP file acq $ \dat ->       gg (K1 dat)

You can delegate to another class that has a default implementation instance GDSAK1 a => GDataSourceAcq (K1 i a) where   g'ds'Shape (K1 a) = g'ds'Shape'K1 a class GDSAK1 a where   g'ds'Shape'K1 :: ...   g'ds'Shape'K1 _ = pure shape1 instance GDSAK1 (a DSAcq) where   g'ds'Shape'K1 = ... instance GDSAK1 Degree instance GDSAK1 Double ... You can also use an overlappable instance to not list all the instances, but the downside is you don't get an error if you forget to override it. instance {-# OVERLAPPABLE #-} GDSAK1 a Cheers, Li-yao On 2025-04-24 3:54 PM, PICCA Frederic-Emmanuel wrote:

Hello,

I am back to work :)

I started to implement a bunch of DataSources.

Which are like this

data family DSDegree (k ∷ DSKind) data instance DSDegree DSPath = DataSourcePath'Degree'Hdf5 (DSWrap_ (DSDataset Z Double) DSPath) | DataSourcePath'Degree'Const Degree deriving (Generic, Show, FromJSON, ToJSON)

data instance DSDegree DSAcq = DataSourceAcq'Degree'Hdf5 (DSWrap_ (DSDataset Z Double) DSAcq) | DataSourceAcq'Degree'Const Degree deriving Generic

instance DataSource DSDegree where withDataSourceP f (DataSourcePath'Degree'Hdf5 p) g = withDataSourcesP f p $ λp' → g (DataSourceAcq'Degree'Hdf5 p') withDataSourceP _ (DataSourcePath'Degree'Const d) g = g (DataSourceAcq'Degree'Const d)

In order to use the generic implementation of ds'Shape, I need to add plenty of

instance GDataSourceAcq (K1 R Degree) where g'ds'Shape _ = pure shape1

Is it possible to says, the default implementation of the generic method is pure shape1 So I just need to implement the non shape1 methodes.

Thanks

Fred

generic'ds'Shape ∷ ( MonadSafe m , Generic (d DSAcq) , GDataSourceAcq (Rep (d DSAcq)) ) ⇒ d DSAcq → m DataSourceShape generic'ds'Shape = g'ds'Shape ∘ from

class GDataSourceAcq dataAcq where g'ds'Shape ∷ MonadSafe m ⇒ dataAcq x → m DataSourceShape

instance GDataSourceAcq f ⇒ GDataSourceAcq (M1 i c f) where g'ds'Shape (M1 f) = g'ds'Shape f

instance (GDataSourceAcq f, GDataSourceAcq f') ⇒ GDataSourceAcq (f :*: f') where g'ds'Shape (f :*: f') = liftA2 combine'Shape (g'ds'Shape f) (g'ds'Shape f')

instance (GDataSourceAcq f, GDataSourceAcq f') ⇒ GDataSourceAcq (f :+: f') where g'ds'Shape (L1 f) = g'ds'Shape f g'ds'Shape (R1 f') = g'ds'Shape f'

instance DataSource a ⇒ GDataSourceAcq (K1 i (a DSAcq)) where g'ds'Shape (K1 acq) = ds'Shape acq

instance GDataSourceAcq (K1 i Dataset) where g'ds'Shape (K1 ds) = liftIO $ ds'Shape'Dataset ds

instance GDataSourceAcq (K1 R Degree) where g'ds'Shape _ = pure shape1

instance GDataSourceAcq (K1 R Double) where g'ds'Shape _ = pure shape1

instance GDataSourceAcq (K1 R Geometry) where g'ds'Shape _ = pure shape1

instance GDataSourceAcq (K1 R (Text → Scannumber → Int → FilePath)) where g'ds'Shape _ = pure shape1

instance GDataSourceAcq (K1 R (Detector Hkl DIM2)) where g'ds'Shape _ = pure shape1

instance GDataSourceAcq (K1 R (IOVector a)) where g'ds'Shape _ = pure shape1

instance GDataSourceAcq (K1 R Text) where g'ds'Shape _ = pure shape1

instance GDataSourceAcq (K1 R Scannumber) where g'ds'Shape _ = pure shape1

Do you know if there is some performance issue to use a new class for this ?

How can I be sure that all the method are statically resolve at the compile time ?

In principle there shouldn't be any impact on performance. Type classes are resolved at compile time, and you only use the generic implementations at known types. All of the relevant dictionaries are known at compile-time, so with enough inlining and simplification the generic constructors and other indirections should be eliminated. In practice, inlining is still very heuristic, so you have to look at the generated code and maybe add INLINEABLE annotations and tweak other things to make sure it happens. The inspection-testing library (https://hackage.haskell.org/package/inspection-testing) enables automated tests that make sure that the code optimized by the compiler doesn't contain certain constructs that indicate missed inlining opportunities. Cheers, Li-yao

Hello, I played with the inspection library, - where I tryed to find typeclass dictionnay (no one :) - but it can find '[] contructor. -> I need some help to understand the error message and if this is an issue ...sorry - No generic code found , it is nice but surprising for me... Cheers Fred ./test/BinocularsSpec.hs:225:25: pro does not contain dictionary values passed. ./test/BinocularsSpec.hs:226:25: pro `hasNoType` GHC.Types.List failed: pro :: LoggingT IO () [LclIdX, Arity=2, Str=<L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}] pro = pro_sjFg `cast` ( LogSource -> LogLevel -> LogStr -> IO ()>_R %<'Many>_N ->_R Sym (N:IO[0] <()>_R) ; Sym (N:LoggingT[0] <IO>_R <()>_N) :: Coercible ((Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> State# RealWorld -> (# State# RealWorld, () #)) (LoggingT IO ())) a1 :: Int [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] a1 = src I# 120# b :: Int [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] b = src I# 453# a1 :: Int [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] a1 = src I# 123# pro_skPp :: Addr# [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] pro_skPp = src "toto"# pro_sjFa :: [Char] [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=True, WorkFree=False, Expandable=True, Guidance=IF_ARGS [] 20 0}] pro_sjFa = src unpackCString# pro_skPp pro_sjFb :: Maybe FilePath [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] pro_sjFb = src Just @FilePath pro_sjFa pro_sjIE :: Interval Int [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] pro_sjIE = src I @Int (src a1) (src a1) pro_skPq :: Interval Int [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] pro_skPq = src I @Int (src a1) (src b) pro_sjFd :: [InputRange] [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] pro_sjFd = src : @InputRange (pro_skPq `cast` (Sym (N:InputRange[0]) :: Coercible (Interval Int) InputRange)) ([] @InputRange) pro_sjFe :: NonEmpty InputRange [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] pro_sjFe = src :| @InputRange (pro_sjIE `cast` (Sym (N:InputRange[0]) :: Coercible (Interval Int) InputRange)) pro_sjFd pro_sjFf :: Maybe ConfigRange [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] pro_sjFf = src Just @ConfigRange (pro_sjFe `cast` (Sym (N:ConfigRange[0]) :: Coercible (NonEmpty InputRange) ConfigRange)) pro_sjFg [Dmd=LC(S,C(1,L))] :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> State# RealWorld -> (# State# RealWorld, () #) [LclId, Arity=2, Str=<L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 60}] pro_sjFg = src process1 pro_sjFb pro_sjFf ./test/BinocularsSpec.hs:227:25: pro mentions none of GHC.Generics.V1, GHC.Generics.U1, GHC.Generics.M1, GHC.Generics.K1, GHC.Generics.:+:, GHC.Generics.:*:, GHC.Generics.:.:, GHC.Generics.Rec1, GHC.Generics.Par1 passed. display inspection information of binoculars-ng [✘]