Is there a way to make this code compose generic ?
Hello, I have this data DataSourceShape = DataSourceShape ([HSize], [Maybe HSize]) | DataSourceShape'Range !DIM1 !DIM1 a function which combine 2 DataSourceShape and produce an new one (monoid operation ?) combine'Shape ∷ DataSourceShape → DataSourceShape → DataSourceShape I use this in this class with familly types. class DataSource a where data DataSourcePath a ∷ Type data DataSourceAcq a ∷ Type ds'Shape ∷ MonadSafe m ⇒ DataSourceAcq a → m DataSourceShape withDataSourceP ∷ (Location l, MonadSafe m) ⇒ ScanFile l → DataSourcePath a → (DataSourceAcq a → m r) → m r and here an instance for one of my type DataFrameQCustom (I have plenty of them). they are all constructed the same way. data DataSourceAcq DataFrameQCustom = DataSourceAcq'DataFrameQCustom (DataSourceAcq Attenuation) (DataSourceAcq Geometry) (DataSourceAcq Image) (DataSourceAcq Mask) (DataSourceAcq Timestamp) (DataSourceAcq Timescan0) (DataSourceAcq Scannumber) ds'Shape(DataSourceAcq'DataFrameQCustom a g i m idx t0 s) = do sa ← ds'Shape a sg ← ds'Shape g si ← ds'Shape i sm ← ds'Shape m sidx ← ds'Shape idx st0 ← ds'Shape t0 ss ← ds'Shape s pure $ foldl1 combine'Shape [sa, sg, si, sm, sidx, st0, ss] withDataSourceP f (DataSourcePath'DataFrameQCustom a g i m idx t0 s) gg = withDataSourceP f a $ λa' → withDataSourceP f g $ λg' → withDataSourceP f i $ λi' → withDataSourceP f m $ λm' → withDataSourceP f idx $ λidx' → withDataSourceP f s $ λs' → withDataSourceP f t0 $ λt0' → gg (DataSourceAcq'DataFrameQCustom a' g' i' m' idx' t0' s') My question is, how should avoid writting by hand all these ds'Shape / withDatasourceP implementations, which seems quite mechanical. thanks for your help Frederic
Hi Frederic, Below is a generic implementation of your class based on your example, that should get you started. Two changes are worth calling out: - I assumed that the binary operation `combine'Shape` is associative. It takes a bit more effort to associate the exact same as `foldl1`. - To avoid duplicating code between `DataSourcePath` and `DataSourceAcq`, I merged them as a single type indexed by a type-level flag. For more information, several tutorials on Haskell generics are findable on search engines. 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) data DSKind = Path | Acq class DataSource a where data DataSourceT (k :: DSKind) a :: Type ds'Shape :: Monad m => DataSourceT Acq a -> m DataSourceShape withDataSourceP :: String -> DataSourceT Path a -> (DataSourceT Acq a -> m r) -> m r -- | Generic 'ds'Shape' generic'ds'Shape :: (Monad m, Generic (DataSourceT Acq a), GDataSourceAcq (Rep (DataSourceT Acq a))) => DataSourceT Acq a -> m DataSourceShape generic'ds'Shape = g'ds'Shape . from -- | Generic 'withDataSourceP' generic'withDataSourceP :: (Generic (DataSourceT Path a), Generic (DataSourceT Acq a), GDataSourcePath (Rep (DataSourceT Path a)) (Rep (DataSourceT Acq a))) => String -> DataSourceT Path a -> (DataSourceT Acq a -> m r) -> m r generic'withDataSourceP file src gg = g'withDataSourceP file (from src) (gg . to) -- ** Base instance type family DataSourceBase (k :: DSKind) :: Type where DataSourceBase Acq = String DataSourceBase Path = [String] data BaseData instance DataSource BaseData where newtype DataSourceT k BaseData = DataSource'BaseData (DataSourceBase k) ds'Shape _ = pure (DummyDSS 1) withDataSourceP _ _ k = k (DataSource'BaseData "source") -- * Generic example usage data ExampleData instance DataSource ExampleData where data DataSourceT k ExampleData = DataSource'ExampleData (DataSourceT k BaseData) (DataSourceT k BaseData) (DataSourceT k BaseData) (DataSourceT k BaseData) (DataSourceT k BaseData) deriving Generic 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 :: 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 (DataSourceT Acq a)) where g'ds'Shape (K1 acq) = ds'Shape acq instance DataSource a => GDataSourcePath (K1 i (DataSourceT Path a)) (K1 i (DataSourceT Acq a)) where g'withDataSourceP file (K1 acq) gg = withDataSourceP file acq $ \dat -> gg (K1 dat)
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
Another question related to this one
data ExampleData
instance DataSource ExampleData where data DataSourceT k ExampleData = DataSource'ExampleData (DataSourceT k BaseData) (DataSourceT k BaseData) (DataSourceT k BaseData) (DataSourceT k BaseData) (DataSourceT k BaseData) deriving Generic ds'Shape = generic'ds'Shape withDataSourceP = generic'withDataSourceP
Do you think that it is possible to derive the DataSourceT Acq and Path from the ExampleData type data ExampleData = ExampleData A B it seems mechanical to me data DataSourceT k ExampleDAta = DataSource'ExampleData (DataSourceT k A) (DataSourceT k B) I tryed with HKD like this -- "Higher-Kinded Data" type family HKD f a where HKD Identity a = a HKD f a = f a data ExampleData' f = ExampleData (HKD f A) (HKD f B) where but then I do not know howto define the type family for DataSourceT with this ExampleData' f Cheers 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)
participants (2)
-
Li-yao Xia -
PICCA Frederic-Emmanuel