damnpacket-0.3.0: tests/render.hs

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

import Control.Applicative  ((<*>), (<$>))
import Control.Monad        (unless)
import qualified Data.ByteString as B
import Data.Map             (fromList, toList)
import qualified Data.Text as T
import System.Exit
import Test.QuickCheck
import Test.QuickCheck.Test (isSuccess)
import Text.Damn.Packet

instance Arbitrary B.ByteString where
        arbitrary = B.pack <$> vectorOf 10 (elements [97..122])
        shrink m = B.pack <$> shrink (B.unpack m)

instance Arbitrary T.Text where
        arbitrary = T.pack <$> vectorOf 10 (elements ['a'..'z'])
        shrink m = T.pack <$> shrink (T.unpack m)

instance Arbitrary Packet where
    arbitrary = do
       cmd <- arbitrary
       prm <- arbitrary
       args <- fromList <$> arbitrary
       b <- arbitrary
       return $ Packet cmd prm args b
    shrink (Packet a b c d) = Packet <$> shrink a
                                     <*> shrink b
                                     <*> (fromList <$> shrink (toList c))
                                     <*> shrink d

quickCheckExit :: Testable prop => prop -> IO ()
quickCheckExit prop = do
    res <- quickCheckResult prop
    unless (isSuccess res) exitFailure

main :: IO ()
main = quickCheckExit (\pk -> parse' (render pk) == Just pk)