damnpacket-0.6.0: tests/render.hs

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

import Control.Applicative  ((<*>), (<$>))
import Control.Monad        (unless)
import Data.Map             (fromList, toList)
import Data.Text            (Text, pack, unpack)
import System.Exit
import Test.QuickCheck
import Test.QuickCheck.Test (isSuccess)
import Text.Damn.Packet

instance Arbitrary Text where
        arbitrary = pack <$> vectorOf 10 (elements ['a'..'Z'])
        shrink m = pack <$> shrink (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)