Haskell-pipes:如何使用drawAll测试具有MonadSafe约束的生产者?

时间:2015-11-06 20:34:57

标签: haskell haskell-pipes haskell-pipes-safe

我有一个生产者,在给定路径的情况下,遍历文件系统,产生Haskell文件的路径。它建立在管道文件之上:

import Pipes
import Pipes.Files
import Pipes.Safe
import qualified Pipes.Prelude as P
import Data.Monoid ((<>))
import Data.List (isSuffixOf)
import System.Directory (doesFileExist)


-- | Starting from a path, generate a sequence of paths corresponding
--   to Haskell files. The fileystem is traversed depth-first.
allFiles :: (MonadIO m, MonadSafe m) => FilePath -> IO (Producer FilePath m ())
allFiles path = do
    isFile <- doesFileExist path
    if isFile then return $ each [path] >-> P.filter (".hs" `isSuffixOf`)
              else return $ find path (glob "*.hs" <> regular)

现在我想用Hspec测试它,但我发现很难将生产者转换成列表。它会更简单,如果不是MonadSafe m约束导致很多类型错误。这是我写的:

import Pipes
import Pipes.Safe
import Pipes.Parse
import Test.Hspec


shouldReturnP :: (MonadIO m, MonadSafe m)
              => IO (Producer FilePath m ()) -> [FilePath] -> Expectation
shouldReturnP action res = do
    prod <- action
    let paths = runSafeT $ evalStateT drawAll prod
    paths `shouldBe` res

这是应该如何使用的:

spec :: Spec
spec = do
    describe "allFiles" $
        it "traverses the filesystem depth-first returning only hs files" $
            allFiles ("test" </> "tree") `shouldReturnP`
                [ "test" </> "tree" </> "a.hs"
                , "test" </> "tree" </> "sub"  </> "b.hs"
                , "test" </> "tree" </> "sub"  </> "c.hs"
                , "test" </> "tree" </> "sub2" </> "a.hs"
                , "test" </> "tree" </> "sub2" </> "e.hs"
                ]

编译测试会出现以下错误:

test/Spec.hs:57:47:
    Couldn't match type ‘m’ with ‘Pipes.Safe.SafeT []’
      ‘m’ is a rigid type variable bound by
          the type signature for
            shouldReturnP :: (MonadIO m, MonadSafe m) =>
                             IO (Producer FilePath m ()) -> [FilePath] -> Expectation
          at test/Spec.hs:53:18
    Expected type: Producer FilePath (Pipes.Safe.SafeT []) ()
      Actual type: Producer FilePath m ()
    Relevant bindings include
      prod :: Producer FilePath m () (bound at test/Spec.hs:56:5)
      action :: IO (Producer FilePath m ())
        (bound at test/Spec.hs:55:15)
      shouldReturnP :: IO (Producer FilePath m ())
                       -> [FilePath] -> Expectation
        (bound at test/Spec.hs:55:1)
    In the second argument of ‘evalStateT’, namely ‘prod’
    In the second argument of ‘($)’, namely ‘evalStateT drawAll prod’

test/Spec.hs:58:22:
    Couldn't match type ‘Char’ with ‘[Char]’
    Expected type: [[FilePath]]
      Actual type: [FilePath]
    In the second argument of ‘shouldBe’, namely ‘res’
    In a stmt of a 'do' block: paths  res

1 个答案:

答案 0 :(得分:2)

如何使用Pipes.Prelude中的toListM

...
import qualified Pipes.Prelude as P
...

files1 :: (MonadIO m, MonadSafe m) => Producer FilePath m ()
files1 = find "." (glob "*.hs" <> regular)

test1 = do
  got <- runSafeT $ runEffect $ P.toListM files1
  shouldBe got ["a.hs", "b.hs", "c.hs"]

-- using `allFiles`:

test2 = do
  prod <- allFiles "."
  got <- runSafeT $ runEffect $ P.toListM prod
  shouldBe got ["a.hs", "b.hs"]

要编写shouldReturnP函数,请从以下开始:

shouldReturnP1 prod expected = do
  let _ = expected :: [FilePath]
  got <- runSafeT $ P.toListM prod
  shouldBe got expected

并让ghc告诉你类型是什么,这是:

shouldReturnP1
  :: (Eq a, Show a) => Producer a (SafeT IO) () -> [a] -> IO ()

您可以使用以下方法进行测试:

testP1 = shouldReturnP1 files1 ["a.hs", "b.hs", "c.hs"]

对于IO动作版本,请写:

shouldReturnP2 action expected = do
  let _ = expected :: [FilePath]
  prod <- action
  paths <- runSafeT $ runEffect $ P.toListM prod
  paths `shouldBe` expected

和ghc告诉你类型是:

shouldReturnP2
  :: IO (Producer FilePath (SafeT IO) ()) -> [FilePath] -> IO ()

和测试:

testP2 = shouldReturnP2 (allfiles ".") ["a1.hs"]

<强>更新

根据关于将doesFileExist检查放入管道的评论中的讨论:

allfiles2 :: MonadSafe m => FilePath -> Producer FilePath m ()
allfiles2 path = do
  exists <- liftIO $ doesFileExist path
  if exists
    then each [path] >-> P.filter (".hs" `isSuffixOf`)
    else find path (glob "*.hs" <> regular)