Querying an event store with types

func_deps.hs

{-# LANGUAGE DefaultSignatures      #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses  #-}

module Test2 where

import           Data.Aeson
import           Data.Maybe   (catMaybes)

data Event
type EventStore = [(String, Value)]

class (Show t) => TypedEvent ev t | t -> ev, ev -> t where
  getEvTypes :: [t]

  default getEvTypes :: (Bounded t, Enum t) => [t]
  getEvTypes = [minBound..maxBound]

  getEvType :: ev -> t

loadEvents :: TypedEvent ev t => EventStore -> [ev]
loadEvents es = findEventsByType es getEvTypes

findEventsByType :: TypedEvent ev t => EventStore -> [t] -> [ev]
findEventsByType es ts =
  catMaybes $
  fmap (somehowParseValue . snd) $
  filter (\e -> fst e `elem` tsStrings) es

  where
    tsStrings = show <$> ts

somehowParseValue :: Value -> Maybe a
somehowParseValue = undefined

-- Example for usage

data MyEvent = SomeEvent Int
             | SomeOtherEvent String
             deriving (Show)

-- instance FromJSON MyEvent ...

data MyEventType
  = SomeEventT
  | SomeOtherEventT
  deriving (Bounded, Enum, Show)

instance TypedEvent MyEvent MyEventType where
  getEvType (SomeEvent _)      = SomeEventT
  getEvType (SomeOtherEvent _) = SomeOtherEventT

loadMyEvents :: EventStore -> [MyEvent]
loadMyEvents = loadEvents

type_families.hs

{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE TypeFamilies      #-}

module Test where

import           Data.Aeson
import           Data.Maybe (catMaybes)

data Event
type EventStore = [(String, Value)]

class Show (Type ev) => TypedEvent ev where
  data Type ev :: *

  getEvTypes :: [Type ev]

  default getEvTypes :: (Bounded (Type ev), Enum (Type ev)) => [Type ev]
  getEvTypes = [minBound..maxBound]

  getEvType :: ev -> Type ev

loadEvents :: TypedEvent ev => EventStore -> [ev]
loadEvents es = findEventsByType es getEvTypes

findEventsByType :: TypedEvent ev => EventStore -> [Type ev] -> [ev]
findEventsByType es ts =
  catMaybes $
  fmap (somehowParseValue . snd) $
  filter (\e -> fst e `elem` tsStrings) es

  where
    tsStrings = show <$> ts

somehowParseValue :: Value -> Maybe a
somehowParseValue = undefined

-- Example for usage

data MyEvent = SomeEvent Int
             | SomeOtherEvent String
             deriving (Show)

-- instance FromJSON MyEvent ...

instance TypedEvent MyEvent where
  data Type MyEvent = SomeEventT
                    | SomeOtherEventT
                    deriving (Bounded, Enum, Show)

  getEvType (SomeEvent _)      = SomeEventT
  getEvType (SomeOtherEvent _) = SomeOtherEventT

loadMyEvents :: EventStore -> [MyEvent]
loadMyEvents = loadEvents