Iterate over list of Symbol at type level

Viewed 43

proto-lens library generates this code for an example protobuf service based on types defined here

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"

I want to get all methods defined on Service s like this

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

which for getMethods ExampleService should return ["Method1", "Method2"]

How can I implement getMethods function?

2 Answers

You can do this with Data.Typeable.

First, use a type level computation to get the list of method names from the service:

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 '[] = '[]

Then, use Data.Typeable to get the TypeRep for MethodNames s for your chosen service s. The method names can be extracted from the TypeRep. After a bit of trial and error, the following seemed to work.

{-# 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"]

You can also use Forall type class from membership library which means that all elements in a type-level list implement a certain class.

{-# 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))

Here, MethodNames is the same as K. A. Buhr's.

Related