[Haskell-cafe] Is there a way to make this code compose generic ?

[Li-yao Xia]

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)