Fusic Developers Weblog

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- hoge.hs
 
import Test.QuickCheck
import Test.QuickCheck.Monadic
 
import Control.Applicative
import Control.Monad.State
import Control.Monad.Writer
 
data Q = Q Int deriving Show
data S = S { fstS :: String, sndS :: String } deriving Show
data W = W { getQ :: Q,  getS :: S } deriving Show
 
instance Arbitrary S where
  arbitrary = S <$> elements ["Mr.", "Ms.", "Mrs."] <*> elements ["Hoge", "Foo", "Bar", "Hage"]
 
newtype AppT w m a = AppT { runQ :: StateT W (WriterT w m) a }
    deriving (Monad, MonadIO, MonadState W, MonadWriter w)
 
exec :: AppT [String] IO Int
exec = do
  w <- get
  let Q(q) = getQ w
      s = getS w
      name str = fstS str ++ " " ++ sndS str
  tell ["No." ++ show q]
  tell [name s]
  return q
 
main' :: S -> Int -> IO [String]
main' s a = main'' (W (Q a) s)
  where
    main'' w = do
      (_, r) <- runWriterT $ runStateT (runQ exec) w
      return r
 
prop_main' :: S -> Int -> Property
prop_main' s a = (a < 100 && a > 0) ==> monadicIO $ do
  res <- run $ main' s a
  assert $ res == ["No." ++ show a, fstS s ++ " " ++ sndS s]
 
main :: IO ()
main = quickCheck prop_main'
 
-- $ runghc hoge.hs