Test.hs

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables        #-}

module Test where

import ClassyPrelude
import Data.Data

data Foo
  = Bar
  | Baz
  deriving (Generic, Data)

class HasNamespace a where
  getNamespace :: Text

class Event a where
  eventType :: a -> Text
  eventTypes :: [Text]

  default eventType :: (HasNamespace a, Data a) => a -> Text
  eventType = (getNamespace @a <>) . fromString . showConstr . toConstr

  default eventTypes :: (HasNamespace a, Data a) => [Text]
  eventTypes = fmap (x (getNamespace @a)) (dataTypeConstrs $ dataTypeOf (undefined :: a))

x :: Text -> Constr -> Text
x ns ctor = ns <> "." <> fromString (showConstr ctor)

instance HasNamespace Foo where
  getNamespace = "Some.V1"

instance Event Foo

baz :: [Text]
baz = eventTypes @Foo