在云haskell节点上运行提示评估程序,在quickCheck上运行奇怪的行为

时间:2015-01-03 09:30:13

标签: haskell

我正在尝试关注cloud haskell here上的教程。为了我的目的,我想评估不同奴隶的quickcheck属性。所以我添加了一个Hint评估器,它接受一个模块名称加载,以及一个表达式,用于在该模块的上下文中进行评估。

现在,我的问题是,当我在编译之后尝试运行它时,我会在评估之前获得所有消息,并且该过程似乎退出。

./dist/build/d-mucheck/d-mucheck
Sat Jan  3 09:16:34 UTC 2015 pid://127.0.0.1:10501:0:10: send mymodule
Sat Jan  3 09:16:34 UTC 2015 pid://127.0.0.1:10501:0:11: Got mymodule and test:quickCheckResult revProp

但是,如果我从main运行cabal repl,我会得到预期的输出。所以我的问题是,我做错了吗?如何让它在命令行中产生预期的输出?

我的代码

{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable, TypeSynonymInstances #-}

module Main where
import Control.Concurrent (threadDelay)
import Control.Monad (forever)
import Control.Distributed.Process
import Control.Distributed.Process.Node (forkProcess, newLocalNode, initRemoteTable)
import Network.Transport.TCP (createTransport, defaultTCPParameters)
import qualified Language.Haskell.Interpreter as I
import qualified Test.QuickCheck.Test as Qc

import Data.Typeable
deriving instance Typeable Qc.Result

type InterpreterOutput = Either I.InterpreterError Qc.Result

localHost, localPort :: String
localHost = "127.0.0.1"
localPort = "10501"

evaluator :: String -> String -> IO InterpreterOutput
evaluator mymodule myexpr = I.runInterpreter evM
  where evM = do I.loadModules [mymodule]
                 ms <- I.getLoadedModules
                 I.setTopLevelModules ms
                 result <- I.interpret myexpr (I.as :: (Typeable a => IO a)) >>= liftIO
                 return result

muServer :: (ProcessId, String, String) -> Process ()
muServer (sender, mymodule, myexpr) = do
  say $ "Got mymodule and test:" ++ myexpr
  iResult <- liftIO (evaluator mymodule myexpr)
  val <- case iResult of
        Left err -> do say $ "error " ++ (show err)
                       return (show err)
        Right out -> do say $ "success " ++ (show out)
                        return (show out)
  say $ "Got mymodule and test:" ++ myexpr
  send sender (show val)

main :: IO ()
main = do
  Right t <- createTransport localHost localPort defaultTCPParameters
  node <- newLocalNode t initRemoteTable
  _ <- forkProcess node $ do
    myPid <- spawnLocal $ forever $ do
      receiveWait [match muServer]

    self <- getSelfPid
    say $ "send mymodule"
    send myPid (self, "Examples/QuickCheckTest.hs", "quickCheckResult revProp")

    m <- expectTimeout 1000000
    case m of
      Nothing  -> die "at worker: nothing came back!"
      (Just s) -> do say $ "at worker: got " ++ s ++ " back!"
    return ()

  liftIO $ threadDelay (1*1000000)
  return ()

具有快速检查属性的样本模块

module Examples.QuickCheckTest where
import Test.QuickCheck
import Data.List

qsort :: [Int] -> [Int]
qsort [] = []
qsort (x:xs) = qsort l ++ [x] ++ qsort r
    where l = filter (< x) xs
          r = filter (>= x) xs

idEmpProp xs = qsort xs == qsort (qsort xs)
revProp xs = qsort xs == qsort (reverse xs)
modelProp xs = qsort xs == sort xs

如果我只使用一个简单的模块,

module Test where
mytest :: IO String
mytest = return "Hello from module Test"

然后使用mytest作为评估字符串(用字符串替换Qc.Result),我得到了奴隶的预期输出。

0 个答案:

没有答案