Browse files

Add quickcheck properties for `Chunk`.

  • Loading branch information...
1 parent 81bed91 commit 0598d425c324c7972869aef0f3a1cec8e29270c9 @pcapriotti committed Oct 18, 2013
Showing with 53 additions and 8 deletions.
  1. +4 −4 Options/Applicative/Help/Chunk.hs
  2. +3 −1 optparse-applicative.cabal
  3. +46 −3 tests/Tests.hs
View
8 Options/Applicative/Help/Chunk.hs
@@ -27,6 +27,7 @@ mappendWith s x y = mconcat [x, s, y]
-- | The free monoid on a semigroup 'a'.
newtype Chunk a = Chunk
{ unChunk :: Maybe a }
+ deriving (Eq, Show)
instance Functor Chunk where
fmap f = Chunk . fmap f . unChunk
@@ -105,8 +106,8 @@ isEmpty = isNothing . unChunk
-- | Convert a 'String' into a 'Chunk'. This satisfies:
--
--- extractChunk (stringChunk s) = s
--- isEmpty (stringChunk s) = null s
+-- isEmpty . stringChunk = null
+-- extractChunk . stringChunk = string
stringChunk :: String -> Chunk Doc
stringChunk "" = mempty
stringChunk s = pure (string s)
@@ -117,8 +118,7 @@ stringChunk s = pure (string s)
--
-- This satisfies:
--
--- extractChunk (paragraph s) = unwords . filter (not . null) . words
--- isEmpty (paragraph s) = null (words s)
+-- isEmpty . paragraph = null . words
paragraph :: String -> Chunk Doc
paragraph = foldr (chunked (</>)) mempty
. map stringChunk
View
4 optparse-applicative.cabal
@@ -110,10 +110,12 @@ test-suite tests
type: exitcode-stdio-1.0
hs-source-dirs: tests
main-is: Tests.hs
- ghc-options: -Wall
+ ghc-options: -Wall -fno-warn-orphans
build-depends: base == 4.*,
HUnit == 1.2.*,
optparse-applicative,
+ QuickCheck == 2.6.*,
test-framework >= 0.6 && < 0.9,
test-framework-hunit >= 0.2 && < 0.4,
+ test-framework-quickcheck2 == 0.3.*,
test-framework-th-prime == 0.0.*
View
49 tests/Tests.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE TemplateHaskell, CPP #-}
+{-# LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving,
+ TemplateHaskell, CPP #-}
module Main where
import qualified Examples.Hello as Hello
@@ -8,12 +9,20 @@ import qualified Examples.Alternatives as Alternatives
import qualified Examples.Formatting as Formatting
import Control.Monad
-import Data.List
-import Options.Applicative
+import Data.List hiding (group)
+import Data.Monoid
import System.Exit
import Test.HUnit
import Test.Framework.Providers.HUnit
+import Test.Framework.Providers.QuickCheck2 (testProperty)
import Test.Framework.TH.Prime
+import Test.QuickCheck (Positive (..))
+import Test.QuickCheck.Arbitrary
+
+import Options.Applicative
+import Options.Applicative.Help.Pretty (Doc, SimpleDoc(..))
+import qualified Options.Applicative.Help.Pretty as Doc
+import Options.Applicative.Help.Chunk
#if __GLASGOW_HASKELL__ <= 702
import Data.Monoid
@@ -375,5 +384,39 @@ case_intersperse_2 = do
assertResult result1 $ \args -> ["-x", "foo"] @=? args
assertError result2 $ \_ -> return ()
+---
+
+deriving instance Arbitrary a => Arbitrary (Chunk a)
+deriving instance Eq SimpleDoc
+
+equalDocs :: Float -> Int -> Doc -> Doc -> Bool
+equalDocs f w d1 d2 = Doc.renderPretty f w d1
+ == Doc.renderPretty f w d2
+
+prop_listToChunk_1 :: [String] -> Bool
+prop_listToChunk_1 xs = isEmpty (listToChunk xs) == null xs
+
+prop_listToChunk_2 :: [String] -> Bool
+prop_listToChunk_2 xs = listToChunk xs == mconcat (fmap pure xs)
+
+prop_extractChunk_1 :: String -> Bool
+prop_extractChunk_1 x = extractChunk (pure x) == x
+
+prop_extractChunk_2 :: Chunk String -> Bool
+prop_extractChunk_2 x = extractChunk (fmap pure x) == x
+
+prop_stringChunk_1 :: Positive Float -> Positive Int -> String -> Bool
+prop_stringChunk_1 (Positive f) (Positive w) s =
+ equalDocs f w (extractChunk (stringChunk s))
+ (Doc.string s)
+
+prop_stringChunk_2 :: String -> Bool
+prop_stringChunk_2 s = isEmpty (stringChunk s) == null s
+
+prop_paragraph :: String -> Bool
+prop_paragraph s = isEmpty (paragraph s) == null (words s)
+
+---
+
main :: IO ()
main = $(defaultMainGenerator)

0 comments on commit 0598d42

Please sign in to comment.