generic-service-proof.hs

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeOperators #-}

module PrototypeGenericService where

import Data.Kind
import Data.List qualified as List

data Method1
data Method2

data Method21
data Method22

type MyServiceMethods1 = '[ Method1, Method2 ]


type MyServiceMethods2 = '[ Method21, Method22 ]

class (Monad m) => HandleMethod m a where
    handle :: m ()

type family AllHandlers m (xs :: [Type]) :: Constraint where
    AllHandlers m '[]       = ()
    AllHandlers m (x ': xs) = (HandleMethod m x, AllHandlers m xs)


data SomeHandler m = forall a . HandleMethod m a => SomeHandler (  m () )

class EnumAll (xs :: [Type]) m where
    enumMethods :: Int -> [(Int, SomeHandler m)]

instance (Monad m, HandleMethod m ()) => EnumAll '[] m where
    enumMethods n = [(n, SomeHandler @m @() (pure ())) ]

instance (Monad m, EnumAll xs m, HandleMethod m x) => EnumAll (x ': xs) m where
  enumMethods n = (n, wtf) : enumMethods @xs (succ n)
    where
      wtf = SomeHandler @m @x (handle @m @x)

instance Monad m => HandleMethod m () where
  handle = pure ()

instance HandleMethod IO Method1 where
  handle = putStrLn "SERVICE1. METHOD1"

instance HandleMethod IO Method2 where
  handle = putStrLn "SERVICE1. METHOD2"


instance HandleMethod IO Method21 where
  handle = putStrLn "SERVICE2. METHOD1"

instance HandleMethod IO Method22 where
  handle = putStrLn "SERVICE2. METHOD2"

dispatch :: (Applicative f, Eq a) => a -> [(a, SomeHandler f)] -> f ()
dispatch n xs = maybe (pure ()) (\(SomeHandler fn) -> fn) (List.lookup n xs)

-- Тестовая функция
protoGenericService :: IO ()
protoGenericService = do
  let jopa1 = enumMethods @MyServiceMethods1 0
  let jopa2 = enumMethods @MyServiceMethods2 0

  dispatch 0 jopa1
  dispatch 1 jopa1

  dispatch 0 jopa2
  dispatch 1 jopa2