Comparing templates with typeclass instances in a Haskell function

Question

I am trying to write a data processing module in Haskell that accepts changesetsvarious schemas and passes them through a series of rules that do not necessarily perform data-based actions. (This is basically an academic exercise to better understand Haskell)

To better explain what I'm doing, here is a working example in Scala

// We have an open type allowing us to define arbitrary 'Schemas' 
// in other packages.
trait Schema[T]

// Represents a changeset in response to user action - i.e. inserting some records into a database.
sealed trait Changeset[T]
case class Insert[T]( schema:Schema[T], records:Seq[T]) extends Changeset[T]
case class Update[T]( schema:Schema[T], records:Seq[T]) extends Changeset[T]
case class Delete[T]( schema:Schema[T], records:Seq[T]) extends Changeset[T]


// Define a 'contacts' module containing a custom schema. 
package contacts {
    object Contacts extends Schema[Contact]
    case class Contact( firstName:String, lastName:String )   
}

// And an 'accounts' module
package accounts {
    object Accounts extends Schema[Account]
    case class Account( name:String )
}


// We now define an arbitrary number of rules that each
// changeset will be checked against
trait Rule {
    def process( changeset: Changeset[_] ):Unit
}

// As a contrived example, this rule keeps track of the 
// number of contacts on an account
object UpdateContactCount extends Rule {
    // To keep it simple let pretend we're doing IO directly here
    def process( changeset: Changeset[_] ):Unit = changeset match {

        // Type inference correctly infers the type of `xs` here.
        case Insert( Contacts, xs ) => ??? // Increment the count
        case Delete( Contacts, xs ) => ??? // Decrement the count
        case Insert( Accounts, xs ) => ??? // Initialize to zero
        case _ => () // Don't worry about other cases 
    }
}

val rules = [UpdateContactCount, AnotherRule, SomethingElse]

The important thing is that both Schema and Rule are open for expansion, and this part deliberately throws a little curved ball into my attempt to do this in Haskell.

That I'm still in Haskell,

{-# LANGUAGE GADTs #-}

-- In this example, Schema is not open for extension.
-- I'd like it to be    
data Schema t where
    Accounts :: Schema Account
    Contacts :: Schema Contact

data Account = Account { name :: String } deriving Show
data Contact = Contact { firstName :: String, lastName :: String } deriving Show

data Changeset t = Insert (Schema t) [t]                             
                 | Update (Schema t) [t]
                 | Delete (Schema t) [t]



-- Whenever a contact is inserted or deleted, update the counter
-- on the account. (Or, for new accounts, set to zero)
-- For simplicity let pretend we're doing IO directly here.
updateContactCount :: Changeset t -> IO ()
updateContactCount (Insert Contacts contacts) = ???
updateContactCount (Delete Contacts contacts) = ???
updateContactCount (Insert Accounts accounts) = ???
updateContactCount other = return ()

, , Schema (.. ), . updateContactCount , [Rule]. - .

type Rule = Changeset -> IO ()
rules = [rule1, rule2, rule3]

Schema , Haskell - . , .

.

• , , Scala?

• Haskell?

Answer 1

Haskell Data.Typeable. Haskell, , XY [1], Scala.

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Data.Typeable (Typeable, gcast)
import Control.Applicative ((<|>), empty, Alternative)
import Data.Maybe (fromMaybe)

-- The Schema typeclass doesn't require any functionality above and
-- beyond Typeable, but we probably want users to be required to
-- implement for explicitness.
class Typeable a => Schema a where

-- A changeset contains an existentially quantified list, i.e. a [t]
-- for some t in the Schema typeclass
data Changeset = forall t. Schema t => Insert [t]
               | forall t. Schema t => Update [t]
               | forall t. Schema t => Delete [t]

data Contact = Contact  { firstName :: String
                        , lastName  :: String }
               deriving Typeable
instance Schema Contact where

data Account = Account { name :: String }
               deriving Typeable
instance Schema Account where

-- We somehow have to let the type inferer know the type of the match,
-- either with an explicit type signature (which here requires
-- ScopedTypeVariables) or by using the value of the match in a way
-- which fixes the type.
--
-- You can fill your desired body here.
updateContactCount :: Changeset -> IO ()
updateContactCount c = choiceIO $ case c of
  Insert xs -> [ match xs (\(_ :: [Contact]) ->
                                putStrLn "It was an insert contacts")
               , match xs (\(_ :: [Account]) ->
                                putStrLn "It was an insert accounts") ]
  Delete xs -> [ match xs (\(_ :: [Contact]) ->
                                putStrLn "It was a delete contacts") ]
  _         -> []

main :: IO ()
main = mapM_ updateContactCount [ Insert [Contact "Foo" "Bar"]
                                , Insert [Account "Baz"]
                                , Delete [Contact "Quux" "Norf"]
                                , Delete [Account "This one ignored"]
                                ]

.

choice :: Alternative f => [f a] -> f a
choice = foldr (<|>) empty

maybeIO :: Maybe (IO ()) -> IO ()
maybeIO = fromMaybe (return ()) 

choiceIO :: [Maybe (IO ())] -> IO ()
choiceIO = maybeIO . choice

match :: (Typeable a1, Typeable a) => [a1] -> ([a] -> b) -> Maybe b
match xs = flip fmap (gcast xs)

ghci> main
It was an insert contacts
It was an insert accounts
It was a delete contacts

[1] . Scala " " , , . , .