[Haskell-cafe] Is there a way to make this code compose generic ?
Li-yao Xia
lysxia at gmail.com
Thu Apr 24 20:41:47 UTC 2025
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
More information about the Haskell-Cafe
mailing list