Перебирать список символов на уровне типа

Question

proto-lens библиотека генерирует этот код для примера службы protobuf на основе типов, определенных здесь

data ExampleService = ExampleService {}
instance Data.ProtoLens.Service.Types.Service ExampleService where
  type ServiceName ExampleService = "ExampleService"
  type ServiceMethods ExampleService = '["method1", "method2"]

instance Data.ProtoLens.Service.Types.HasMethodImpl ExampleService "method1" where
  type MethodName ExampleService "method1" = "Method1"

instance Data.ProtoLens.Service.Types.HasMethodImpl ExampleService "method2" where
  type MethodName ExampleService "method2" = "Method2"

Я хочу получить все методы, определенные для Service s вот так

getMethods :: (Service s) -> s -> [String]

который для getMethods ExampleService должен вернуть ["Method1", "Method2"]

Как мне реализовать функцию getMethods?

Answer 1

Вы можете сделать это с помощью Data.Typeable.

Сначала используйте вычисления уровня типа, чтобы получить список имен методов из службы:

type MethodNames s = MapNames s (ServiceMethods s)
type family MapNames s (ms :: [Symbol]) :: [Symbol] where
  MapNames s (m ': ms) = MethodName s m ': MapNames s ms
  MapNames s '[] = '[]

Затем используйте Data.Typeable чтобы получить TypeRep за MethodNames s за выбранную вами услугу s. Имена методов могут быть извлечены из TypeRep. После небольшой проб и ошибок, похоже, сработало следующее.

{-# LANGUAGE DataKinds, FlexibleContexts, KindSignatures, MultiParamTypeClasses,
             ScopedTypeVariables, TypeFamilies, TypeOperators #-}

import GHC.TypeLits
import Data.Typeable

data ExampleService = ExampleService {}

class Service s where
  type ServiceMethods s :: [Symbol]
class HasMethodImpl s (m :: Symbol) where
  type MethodName s m :: Symbol

instance Service ExampleService where
  type ServiceMethods ExampleService = '["method1", "method2"]
instance HasMethodImpl ExampleService "method1" where
  type MethodName ExampleService "method1" = "Method1"
instance HasMethodImpl ExampleService "method2" where
  type MethodName ExampleService "method2" = "Method2"

type MethodNames s = MapNames s (ServiceMethods s)
type family MapNames s (ms :: [Symbol]) :: [Symbol] where
  MapNames s (m ': ms) = MethodName s m ': MapNames s ms
  MapNames s '[] = '[]

getMethods :: forall s. (Service s, Typeable (MethodNames s)) => s -> [String]
getMethods _ = methods (typeRep (Proxy :: Proxy (MethodNames s)))
  where methods :: TypeRep -> [String]
        methods rep = case typeRepArgs rep of
          [x,xs] -> read (tyConName (typeRepTyCon x)) : methods xs
          []   -> []

main = do
  print $ getMethods ExampleService
  -- output: ["Method1","Method2"]

Answer 2

Вы также можете использовать Forall класс типов из членства библиотеки, что означает, что все элементы в списке уровня типов реализуют определенный класс.

{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE TypeApplications      #-}

import           GHC.TypeLits
import           Type.Membership

symbolVals :: Forall KnownSymbol xs => Proxy xs -> [String]
symbolVals p = henumerateFor (Proxy @KnownSymbol) p (\x -> (symbolVal x:)) []

getMethods :: forall s. (Service s, Forall KnownSymbol (MethodNames s))
           => s -> [String]
getMethods _ = symbolVals (Proxy @(MethodNames s))

Здесь MethodNames - это то же, что К.А. Бур.