实现“mixins”时GADT，TypeFamilies类型推断失败

Question

I am trying to create complex data structures with composable logic. That is, the data structure has a generic format (essentially, a record with some fields whose type can change) and some generic functions. Specific structures have specific implementation of the generic functions.

There are two approaches I tried. One is to use the type system (with type classes, type families, functional dependencies etc.). The other is creating my own "vtable" and using GADTs. Both methods fail in a similar way - there seems to be something basic I'm missing here. Or, perhaps, there a better more Haskell-ish way to do this?

Here is the failing "typed" code:

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Typed where

import Control.Monad.State
import Data.Lens.Lazy
import Data.Lens.Template

-- Generic Block.
data Block state ports = Block { _blockState :: state, _blockPorts :: ports }

-- For the logic we want to use, we need some state and ports.
data LogicState = LogicState { _field :: Bool }
data LogicPorts incoming outgoing =
  LogicPorts { _input :: incoming, _output :: outgoing }

makeLenses [ ''Block, ''LogicState, ''LogicPorts ]

-- We need to describe how to reach the needed state and ports,
-- and provide a piece of the logic.
class LogicBlock block incoming outgoing | block -> incoming, block -> outgoing where
  logicState :: block ~ Block state ports => Lens state LogicState
  logicPorts :: block ~ Block state ports => Lens ports (LogicPorts incoming outgoing)
  convert :: block ~ Block state ports => incoming -> State block outgoing
  runLogic :: State block outgoing
  runLogic = do
    state <- access $ blockState
    let myField = state ^. logicState ^. field
    if myField
    then do
      ports <- access blockPorts
      let inputMessage = ports ^. logicPorts ^. input
      convert inputMessage
    else
      error "Sorry"

-- My block uses the generic logic, and also maintains additional state
-- and ports.
data MyState = MyState { _myLogicState :: LogicState, _myMoreState :: Bool }
data MyPorts = MyPorts { _myLogicPorts :: LogicPorts Int Bool, _myMorePorts :: Int }

makeLenses [ ''MyState, ''MyPorts ]

type MyBlock = Block MyState MyPorts

instance LogicBlock MyBlock Int Bool where
  logicState = myLogicState
  logicPorts = myLogicPorts
  convert x = return $ x > 0

-- All this work to write:
testMyBlock :: State MyBlock Bool
testMyBlock = runLogic

It results in the following error:

Typed.hs:39:7:
    Could not deduce (block ~ Block state1 ports1)
    from the context (LogicBlock block incoming outgoing)
      bound by the class declaration for `LogicBlock'
      at Typed.hs:(27,1)-(41,19)
      `block' is a rigid type variable bound by
              the class declaration for `LogicBlock' at Typed.hs:26:18
    Expected type: StateT block Data.Functor.Identity.Identity outgoing
      Actual type: State (Block state1 ports1) outgoing
    In the return type of a call of `convert'
    In a stmt of a 'do' block: convert inputMessage

And here is the failing "vtable" code:

{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}

module VTable where

import Control.Monad.State
import Data.Lens.Lazy
import Data.Lens.Template

-- Generic Block.
data Block state ports = Block { _blockState :: state, _blockPorts :: ports }

-- For the logic we want to use, we need some state and ports.
data LogicState = LogicState { _field :: Bool }
data LogicPorts incoming outgoing =
  LogicPorts { _input :: incoming, _output :: outgoing }

makeLenses [ ''Block, ''LogicState, ''LogicPorts ]

-- We need to describe how to reach the needed state and ports,
-- and provide a piece of the logic.
data BlockLogic block incoming outgoing where
  BlockLogic :: { logicState :: Lens state LogicState
                , logicPorts :: Lens ports (LogicPorts incoming outgoing)
                , convert :: incoming -> State block outgoing
                }
             -> BlockLogic (Block state ports) incoming outgoing

-- | The generic piece of logic.
runLogic :: forall block state ports incoming outgoing
          . block ~ Block state ports
         => BlockLogic block incoming outgoing
         -> State block outgoing
runLogic BlockLogic { .. } = do
  state <- access $ blockState
  let myField = state ^. logicState ^. field
  if myField
  then do
    ports <- access blockPorts
    let inputMessage = ports ^. logicPorts ^. input
    convert inputMessage
  else
    error "Sorry"

-- My block uses the generic logic, and also maintains additional state and ports.
data MyState = MyState { _myLogicState :: LogicState, _myMoreState :: Bool }
data MyPorts = MyPorts { _myLogicPorts :: LogicPorts Int Bool, _myMorePorts :: Int }

makeLenses [ ''MyState, ''MyPorts ]

type MyBlock = Block MyState MyPorts

-- All this work to write:
testMyBlock :: State MyBlock Bool
testMyBlock = runLogic $ BlockLogic
                         { logicState = myLogicState
                         , logicPorts = myLogicPorts
                         , convert = \x -> return $ x > 0
                         }

It results in the following error:

VTable.hs:44:5:
    Could not deduce (block1 ~ Block state1 ports1)
    from the context (block ~ Block state ports)
      bound by the type signature for
                 runLogic :: block ~ Block state ports =>
                             BlockLogic block incoming outgoing -> State block outgoing
      at VTable.hs:(37,1)-(46,17)
    or from (block ~ Block state1 ports1)
      bound by a pattern with constructor
                 BlockLogic :: forall incoming outgoing state ports block.
                               Lens state LogicState
                               -> Lens ports (LogicPorts incoming outgoing)
                               -> (incoming -> State block outgoing)
                               -> BlockLogic (Block state ports) incoming outgoing,
               in an equation for `runLogic'
      at VTable.hs:37:10-26
      `block1' is a rigid type variable bound by
               a pattern with constructor
                 BlockLogic :: forall incoming outgoing state ports block.
                               Lens state LogicState
                               -> Lens ports (LogicPorts incoming outgoing)
                               -> (incoming -> State block outgoing)
                               -> BlockLogic (Block state ports) incoming outgoing,
               in an equation for `runLogic'
               at VTable.hs:37:10
    Expected type: block1
      Actual type: block
    Expected type: StateT
                     block1 Data.Functor.Identity.Identity outgoing
      Actual type: State block outgoing
    In the return type of a call of `convert'
    In a stmt of a 'do' block: convert inputMessage

I don't get why GHC is going for "block1" when the whole thing is explicitly under ScopedTypeVariables and "forall block".

Edit #1: Added functional dependencies, thanks to Chris Kuklewicz for pointing this out. The problem remains though.

Edit #2: As Chris pointed out, in the VTable solution, getting rid of all the "block ~ Block state ports" and instead writing "Block state ports" everywhere solves the problem.

Edit #3: Ok, so the problem seems to be that for each and every separate function, GHC requires sufficient type information in the parameters to deduce all the types, even for types that aren't used at all. So in the case of (for example) logicState above, the parameters only give us the state, which isn't enough to know what the ports and incoming and outgoing types are. Never mind it doesn't really matter to the logicState function; GHC wants to know, and can't, so compilation fails. If this is indeed the core reason, it would have been better if GHC complained directly when compiling the logicState decleration - it seems it has enough information to detect a problem there; if I had seen a problem saying "ports type is not used/determined" at that location, it would have been much clearer.

Edit #4: It still isn't clear to me why (block ~ Block state ports) doesn't work; I guess I'm using it for an unintended purpose? It seems like it should have worked. I agree with Chris that using CPP to work around it is an abomination; but writing "B trpe" (in my real code that has more paraneters) isn't a good solution either.

Answer 1

I have a one line fix for your VTable code:

            , convert :: incoming -> State block outgoing

becomes

            , convert :: incoming -> State (Block state ports) outgoing

Then you should simplify the type of runLogic to

runLogic :: BlockLogic (Block state ports) incoming outgoing
         -> State (Block state ports) outgoing

PS: More detail to answer comments below.

Eliminating "block ~" was not part of the fix. Usually "~" is only needed in instance a~b => ... where situations.

Previously if I give a function a xxx :: BlockLogic (Block state ports) incoming outgoing then it can unpack convert xxx :: State block outgoing . But the new block is not at all related to (Block state ports) , it is a new unknowable type. The compiler append a digit to the end of the name to make block1 which then appears in the error messages.

The original code (both versions) have problems with what types the compiler can infer from a given context.

As for verbosity, try type . Do not use CPP and DEFINE.

type B s p = BlockLogic (Block s p)

runLogic :: B s p i o -> State (Block s p) o

PPS: Further explanation of problems with class version. If I substitute (Block sp) for block and add the functional dependencies you mentioned:

class LogicBlock state ports incoming outgoing | state ports -> incoming outgoing where
  logicState :: Lens state LogicState
  logicPorts :: Lens ports (LogicPorts incoming outgoing)
  convert :: incoming -> State (Block state ports) outgoing

Using logicState nails down state but leaves ports unknown, making ports#

Using logicPorts nails down ports but leaves state unknown, making ports#

Compiling runLogic runs into lots of type mismatch errors between ports, ports0, ports1 and state, state0, state1.

These operations do not seem to fit together into the same type class. You could break them out into separate type classes, or perhaps add ", state->ports, ports->state" functional dependencies to the class declaration.