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

[Li-yao Xia]

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)