OO Interface translation to Haskell

问题:

My specific problem is actually not about the general translation of an OO interface to Haskell. This is just the best title I could come up with. Yet, I'm sure that my problem originates from a still poor understanding of modeling code with Haskell and a mindset still located in the land of OO paradigms (still a haskell beginner, you see).

I'm writing a Mastermind (variation) simulation to test the fitness of several Mastermind strategies. As a matter of fact, I already did that in Java and Lua and thus this Haskell version is just an exercise for me to learn to program in Haskell. You can check out the readme of the Lua/Java version if you are interested in what I'm trying to achieve in the end.

But now for my concrete problem (in short and in OO terms): I want to provide an interface for strategies so that I can interchangeably put a strategy that adheres to that interface into the simulation recursion (loop) and after it's done receive some data about the strategy's performance. Additionally, I want to allow the strategy to keep arbitrary state around and I don't want to care about what kind of state each strategy keeps around. But exactly this decision - which is actually essential - complicated everything. Another requirement, which concretely led to the problem describe below, is that a strategy name can be provided as a command line argument and then the simulation runs with that specific strategy.

At first I deemed a type class appropriate for these requirements but after not having come up with a real idea how to model the code this way I abandoned the idea. Then I decided for an ADT, used it ever since and came relatively far with the code - until now.

---

So, the superficial question is how to resolve the problem I provide below. The deeper question is how to better model my requirements for an interface with arbitrary state in Haskell.

Here is a reduced and adapted excerpt from my code:

-- reduced & simplified example
import Control.Monad.State

type Code = [Int]

data Answer = Answer { 
    blacks :: Int, 
    whites :: Int 
    } deriving (Eq, Show)

-- As you can see I decided for a type variable a that
-- represents the arbitrary state a strategy might carry
-- around. I wonder if this is the right way to do it.
-- | This is the interface for a strategy. A strategy must provide a method 
-- that, given a mastermind answer, returns the next guess, an initial state 
-- and the very first guess.
data Strategy a = Strategy {
    firstGuess :: Int -> Code,
    initialize :: Int -> a, -- a "constructor" in disguise
    guess      :: Answer -> State a Code
    }

dummy = Strategy {
    firstGuess   = firstGuess',
    initialize   = initialize', 
    guess        = guess'
    }

-- | The very first guess is always T0,T1,...,Tx, where x is the code length.
firstGuess' :: Int -> Code
firstGuess' length = [0..length-1]

-- | Memorize the code length
initialize' :: Int -> Int
initialize' = id

-- | Always return the same guess
guess' :: Answer -> State Int Code
guess' = const $ liftM firstGuess' get

-- HERE IS THE PROBLEM
-- I need this function since I'll get the name of a strategy
-- as a string from the command line and need to dispatch the
-- correct strategy to the simulation. Note, that there would
-- be of course more pattern matches for different strategies
-- with different accompanying states a.
nameToStrategy :: String -> Strategy a
nameToStrategy "dummy" = dummy

Executing the file yields the following error message:

Prelude> :l Problem.hs
[1 of 1] Compiling Main             ( Problem.hs, interpreted )

Problem.hs:37:25:
    Couldn't match expected type `a' against inferred type `Int'
      `a' is a rigid type variable bound by
          the type signature for `nameToStrategy' at Problem.hs:36:37
      Expected type: Strategy a
      Inferred type: Strategy Int
    In the expression: dummy
    In the definition of `nameToStrategy':
        nameToStrategy "dummy" = dummy
Failed, modules loaded: none.

I kind of can intuitively comprehend the problem. The problem seems to be that nameToStrategy cannot just return a Strategy with some state a. The type variable must be concrete, since if I change the type of nameToStrategy to String -> Strategy Int everything's fine. But that is not a solution to my problem.

I figured I need to relax the type. However, I don't really know how to do it. I heard about Data.Dynamic and existential types and those might help me. Still, I feel that with a better modeling of my code I would not need those.

---

Edit: I managed to incorporate sclv's suggestions into the code after all and it is much better now. The code for the strategies is clearer since I don't need the special case for the first guess anymore and I can use guards to better distinguish between the case of a correct and an incorrect guess. The main simulation handling is not as elegant as sclv's version since I put stepState (and the functions using stepState) into the IO Monad to measure computation time and thus have some "monadic syntax noise". The ability to easily simulate a couple of simulation steps (which wasn't actually possible before) helped me in finding a mutual recursive infinite loop (that bug was weird to understand). All in all, the code feels more discrete now. Needless to say, I don't need the unsafeCoerce hack anymore to dispatch names to strategies (or better "packed strategies"). I hope the functional way of thinking someday will come naturally to me, too.

回答1:

Ok let's start from scratch. A pure strategy is a function that given a state of knowledge yields a guess. state -> Guess. For any given state, there's some way to add new knowledge to it -- Answer -> state -> state. Rather than an initial guess, we now just need an initial state.

data Strategy state = Strategy {
                 initialState :: state,
                 extractGuess :: state -> Guess,
                 updateState  :: Answer -> state -> state
         }

So now lets see what happns when we compose these functions.

type Oracle = Guess -> Maybe Answer -- we'll encode success as Nothing

stepState :: Oracle -> Strategy state -> state -> Maybe state
stepState oracle str state = fmap (\ans -> updateState str ans state) $ 
                                      oracle (extractGuess str state)

stepMany :: Strategy state -> Oracle -> [state]
stepMany str oracle = go (initialState str)
      where go state = case stepState oracle str state of
               Nothing -> []
               Just newState -> newState : go newState

So stepMany is 90% of what we want, but its still polymorphic in that pesky state param. That's easy enough to work around -- after all we want the number of steps, not the intermediate states of the steps themselves.

type packedStrategy = Oracle -> Int

packStrategy :: Strategy state -> PackedStrategy
packStrategy str oracle = length $ stepMany str oracle

And now you can write [packStrategy stratOne, packStrategy stratTwo] etc. And along the way, we've discovered something important -- what you care about from your strategy is just that it is a function from some problem (represented by an oracle) to the steps it takes to solve the problem. And one way (not the only way) to produce such stratgies is to provide a way to ask for new knowledge (to guess) and a way to update our knowledge (update state).

This is not the only answer, and maybe not ideal for your purposes, but it should help to move you towards thinking with functions and types rather than objects and capabilities.

回答2:

You can do exactly what you want using GADTs (Generalized Algebraic Data Types) and existentials (the "forall a." below). The type "Strategy" hides the internal type "a" which is an implementation detail. Pattern matching in the call to "go" brings all the pieces of Strategy into scope. Note that I used GHC's RecordWildCards "{..}" to save my fingers. This compiles because "go" does not return anything that exposes the internal type "a".

Much more detail exists in the GHC User Manual.

{-# LANGUAGE GADTs, RankNTypes, RecordWildCards #-}
import Control.Monad.State

type Code = [Int]

data Answer = Answer { blacks :: Int, whites :: Int } 
  deriving (Eq, Show)

data Strategy where
    Strategy :: forall a. { strategyName :: String
                          , firstGuess   :: Int -> Code
                          , initialize   :: Int -> a
                          , guess        :: Answer -> State a Code
                          } 
             -> Strategy

dummy = Strategy { strategyName = "dummy"
                 , firstGuess   = firstGuess'
                 , initialize   = initialize'
                 , guess        = guess'
                 }

-- | The very first guess is always T0,T1,...,Tx, where x is the code length.
firstGuess' :: Int -> Code
firstGuess' length = [0..length-1]

-- | Memorize the code length
initialize' :: Int -> Int
initialize' = id

-- | Always return the same guess
guess' :: Answer -> State Int Code
guess' = const $ liftM firstGuess' get

-- Take size and strategy and compute number of steps to win
-- modified to create local type variable 'a' to write type for 'step'
go :: Code -> Strategy -> (String,Int)
go secretCode (Strategy {initialize=initialize::Int->a,..}) =
  let size = length secretCode
      nextAnswer :: Code -> Maybe Answer
      nextAnswer _ = undefined {- compare with secretCode -}

      step :: Code -> Int -> State a (String,Int)
      step code n = case nextAnswer code of
                      Nothing -> return (strategyName,n)
                      Just answer -> do
                        code' <- guess answer
                        step code' $! (succ n)

  in evalState (step (firstGuess size) 0) (initialize size)

And by using a WriterT I could add a log of the guesses:

-- Take size and strategy and compute number of steps to win
goW :: Code -> Strategy -> ((String,Int),[(Code,Answer)])
goW secretCode (Strategy {..}) =
  let size = length secretCode
      nextAnswer :: Code -> Maybe Answer
      nextAnswer _ = undefined {- compare with secretCode -}

      step code n = case nextAnswer code of
                      Nothing -> return (strategyName,n)
                      Just answer -> do
                        code' <- lift (guess answer)
                        tell [(code,answer)]
                        step code' $! (succ n)

  in evalState (runWriterT (step (firstGuess size) 0)) (initialize size)