在生产代码中找到了假 IO 类型类的实例，但在测试中未找到

Question

我有很多基于

IO

的操作，最简单的操作之一如下：

-- Loop.hs
module Loop where
import System.Console.ANSI (setCursorPosition)
type Pos = (Int, Int)
setCursorPosition' :: Pos -> IO ()
setCursorPosition' = uncurry setCursorPosition

此时，从上面的开始，我决定根据

IO

实现的类型约束来编写这些函数，而不是像

这个答案

所建议的那样硬编码IO。

所以我所做的包括

• 定义

  FakeIO

  类型

  class

  及其对

  IO

  的简单实现：

  -- Interfaces.hs
  module Interfaces where
  import qualified System.Console.ANSI as ANSI (setCursorPosition)
  
  class FakeIO m where
    setCursorPosition :: Int -> Int -> m ()
  
  instance FakeIO IO where
    setCursorPosition = ANSI.setCursorPosition
  

• 更改了

  setCursorPosition'

  以使用此界面：

  -- Loop.hs
  module Loop where
  import Interfaces
  type Pos = (Int, Int)
  setCursorPosition' :: FakeIO m => Pos -> m ()
  setCursorPosition' = uncurry setCursorPosition
  

这导致程序仍然可以正常工作（通过

cabal run

），证明“重构”是正确的。

但是当我尝试利用这种重构进行测试时，我陷入了困境。我所做的是编写以下测试：

-- test/Main.hs
module Main where

import Control.Monad (unless)
import System.Exit (exitFailure)
import MTLPrelude (State, execState, modify')
import Test.QuickCheck

import Loop
import Interfaces

data MockTerminal = MockTerminal {
  pos :: (Int, Int)
} deriving Eq

instance FakeIO (State MockTerminal) where
  setCursorPosition y x = modify' $ \m -> MockTerminal { pos = (y, x) }

main :: IO ()
main = do
  result <- quickCheckResult tCenter
  unless (isSuccess result) exitFailure

tCenter :: Bool
tCenter = (setCursorPosition' (1,1))
          `execState` MockTerminal { pos = (0,0)}
          == MockTerminal { pos = (1,1) }

无法编译（通过

cabal test

）因为

error: [GHC-39999]
    • No instance for ‘snakegame-0.1.0.0:Loop:Interfaces.FakeIO
                         (StateT MockTerminal Identity)’
        arising from a use of ‘setCursorPosition'’
    • In the first argument of ‘execState’, namely
        ‘(setCursorPosition' (1, 1))’
      In the first argument of ‘(==)’, namely
        ‘(setCursorPosition' (1, 1))
           `execState` MockTerminal {pos = (0, 0)}’
      In the expression:
        (setCursorPosition' (1, 1)) `execState` MockTerminal {pos = (0, 0)}
          == MockTerminal {pos = (1, 1)}
   |
41 | tCenter = (setCursorPosition' (1,1))
   |            ^^^^^^^^^^^^^^^^^^

我不明白，因为

instance FakeIO (State MockTerminal)

应该正是编译器声称不存在的

snakegame-0.1.0.0:Loop:Interfaces.FakeIO (StateT MockTerminal Identity)

实例。

此外，如果我将测试更改为使用

setCursorPosition 1 1

而不是

setCursorPosition' (1,1)

，它会编译并通过，表明

instance

确实正在发挥作用。

所以

instance

与

setCursorPosition'

的定义的整合一定有问题。

---

我已将示例缩小为以下 4 个文件：

$ tree !(dist-newstyle)
cabal.project  [error opening dir]
LICENSE  [error opening dir]
Session.vim  [error opening dir]
snakegame.cabal  [error opening dir]
src
├── Interfaces.hs
├── Loop.hs
└── Main.hs
test
└── Main.hs

2 directories, 8 files

其中：

-- src/Main.hs
module Main where

import Loop

main :: IO ()
main = setCursorPosition' (1,1)

-- src/Loop.hs
module Loop (setCursorPosition') where

import Interfaces
type Pos = (Int, Int)

setCursorPosition' :: FakeIO m => Pos -> m ()
setCursorPosition' = uncurry setCursorPosition

-- test/Main.hs
module Main where

import Control.Monad (unless)
import System.Exit (exitFailure)
import MTLPrelude (State, execState, modify')
import Test.QuickCheck

import Loop
import Interfaces

data MockTerminal = MockTerminal {
  pos :: (Int, Int)
} deriving Eq

instance FakeIO (State MockTerminal) where
  setCursorPosition y x = modify' $ \m -> MockTerminal { pos = (y, x) }
  putChar _ = modify' id

main :: IO ()
main = do
  result <- quickCheckResult tCenter
  unless (isSuccess result) exitFailure

tCenter :: Bool
tCenter = (setCursorPosition' (1,1))
          `execState` MockTerminal { pos = (0,0)}
          == MockTerminal { pos = (1,1)}

cabal-version: 3.0
name: snakegame
version: 0.1.0.0

common common
    default-language: GHC2024
    build-depends: base >= 4.19.1.0
                 , ansi-terminal
                 , mtl-prelude

common warnings
    ghc-options: -Wall

executable snakegame
    import: warnings, common
    main-is: Main.hs
    other-modules: Loop
                 , Interfaces
    hs-source-dirs: src

library Loop
    import: warnings, common
    exposed-modules: Loop
    hs-source-dirs: src

library Interfaces
    import: warnings, common
    exposed-modules: Interfaces
    hs-source-dirs: src

test-suite Test
    import: warnings, common
    type: exitcode-stdio-1.0
    main-is: Main.hs
    build-depends: QuickCheck
                 , Interfaces
                 , Loop
    hs-source-dirs: test

packages: .

with-compiler: ghc-9.10.1

Answer 1

你的 Haskell 源代码一切都很好。你遇到的问题来自 Cabal。要解决此问题，请执行以下操作：

1. 创建一个名为

   app

的目录
2. 将

   Main.hs

   从

   src/

   移至

   app/

3. 将

   snakegame.cabal

   的内容替换为以下内容：

cabal-version: 3.0
name: snakegame
version: 0.1.0.0

common common
    default-language: GHC2024
    build-depends: base >= 4.19.1.0
                 , ansi-terminal
                 , mtl-prelude

common warnings
    ghc-options: -Wall

executable snakegame
    import: warnings, common
    main-is: Main.hs
    build-depends: snakegame
    hs-source-dirs: app

library
    import: warnings, common
    exposed-modules: Loop
                   , Interfaces
    hs-source-dirs: src

test-suite Test
    import: warnings, common
    type: exitcode-stdio-1.0
    main-is: Main.hs
    build-depends: QuickCheck
                 , snakegame
    hs-source-dirs: test

问题是，您说

Loop

和

Interfaces

各自属于多个库，因此您最终会得到它们的多个副本，而您声明

FakeIO

的

instance

并不是与

setCursorPosition'

中的约束中的副本相同。