Added tests for choiceMultiple

jaspervdj · Oct 31, 2016 · c3c0f5f · c3c0f5f
1 parent 26e6ce5
commit c3c0f5f
Show file tree

Hide file tree

Showing 2 changed files with 44 additions and 26 deletions.
diff --git a/digestive-functors/tests/Text/Digestive/Tests/Fixtures.hs b/digestive-functors/tests/Text/Digestive/Tests/Fixtures.hs
@@ -59,21 +59,32 @@ runTrainerM = flip runReader 20
 
 
 --------------------------------------------------------------------------------
-data Type = Water | Fire | Leaf
+data Type = Water | Fire | Leaf | Rock
     deriving (Eq, Show)
 
 
+--------------------------------------------------------------------------------
+typeChoices :: [(Type, Text)]
+typeChoices = [(Water, "Water"), (Fire, "Fire"), (Leaf, "Leaf"), (Rock, "Rock")]
+
+
 --------------------------------------------------------------------------------
 typeForm :: Monad m => Form Text m Type
-typeForm = choice [(Water, "Water"), (Fire, "Fire"), (Leaf, "Leaf")] Nothing
+typeForm = choice typeChoices Nothing
+
+
+--------------------------------------------------------------------------------
+weaknessForm :: Monad m => Form Text m [Type]
+weaknessForm = choiceMultiple typeChoices Nothing
 
 
 --------------------------------------------------------------------------------
 data Pokemon = Pokemon
-    { pokemonName  :: Text
-    , pokemonLevel :: Maybe Int
-    , pokemonType  :: Type
-    , pokemonRare  :: Bool
+    { pokemonName     :: Text
+    , pokemonLevel    :: Maybe Int
+    , pokemonType     :: Type
+    , pokemonWeakness :: [Type]
+    , pokemonRare     :: Bool
     } deriving (Eq, Show)
 
 
@@ -93,10 +104,11 @@ levelForm =
 --------------------------------------------------------------------------------
 pokemonForm :: Form Text TrainerM Pokemon
 pokemonForm = Pokemon
-    <$> "name"  .: validate isPokemon (text Nothing)
-    <*> "level" .: levelForm
-    <*> "type"  .: typeForm
-    <*> "rare"  .: bool Nothing
+    <$> "name"     .: validate isPokemon (text Nothing)
+    <*> "level"    .: levelForm
+    <*> "type"     .: typeForm
+    <*> "weakness" .: weaknessForm
+    <*> "rare"     .: bool Nothing
   where
     definitelyNoPokemon = ["dog", "cat"]
     isPokemon name
@@ -176,9 +188,9 @@ catchForm = check "You need a better ball" canCatch $ Catch
 
 --------------------------------------------------------------------------------
 canCatch :: Catch -> Bool
-canCatch (Catch (Pokemon _ _ _ False) _)      = True
-canCatch (Catch (Pokemon _ _ _ True)  Ultra)  = True
-canCatch (Catch (Pokemon _ _ _ True)  Master) = True
+canCatch (Catch (Pokemon _ _ _ _ False) _)      = True
+canCatch (Catch (Pokemon _ _ _ _ True)  Ultra)  = True
+canCatch (Catch (Pokemon _ _ _ _ True)  Master) = True
 canCatch _                                    = False
 
 

diff --git a/digestive-functors/tests/Text/Digestive/View/Tests.hs b/digestive-functors/tests/Text/Digestive/View/Tests.hs
@@ -28,23 +28,27 @@ assertError :: Show a => a -> H.Assertion
 assertError x = handle (\(_ :: SomeException) -> H.assert True) $
     x `seq` H.assertFailure $ "Should throw an error but gave: " ++ show x
 
-
+-- typeChoices = [(Water, "Water"), (Fire, "Fire"), (Leaf, "Leaf"), (Rock, "Rock")]
 --------------------------------------------------------------------------------
 tests :: Test
 tests = testGroup "Text.Digestive.View.Tests"
     [ testCase "Simple postForm" $ (@=?)
-        (Just (Pokemon "charmander" (Just 5) Fire False)) $
+        (Just (Pokemon "charmander" (Just 5) Fire [Water, Rock] False)) $
         snd $ runTrainerM $ postForm "f" pokemonForm $ testEnv
-            [ ("f.name",  "charmander")
-            , ("f.level", "5")
-            , ("f.type",  "type.1")
+            [ ("f.name",     "charmander")
+            , ("f.level",    "5")
+            , ("f.type",     "type.1")
+            , ("f.weakness", "weakness.0")
+            , ("f.weakness", "weakness.3")
             ]
 
     , testCase "optional unspecified" $ (@=?)
-        (Just (Pokemon "magmar" Nothing Fire False)) $
+        (Just (Pokemon "magmar" Nothing Fire [Water, Rock] False)) $
         snd $ runTrainerM $ postForm "f" pokemonForm $ testEnv
-            [ ("f.name",  "magmar")
-            , ("f.type",  "type.1")
+            [ ("f.name",     "magmar")
+            , ("f.type",     "type.1")
+            , ("f.weakness", "weakness.0")
+            , ("f.weakness", "weakness.3")
             ]
 
     , testCase "stringRead float" $ (@=?)
@@ -91,12 +95,14 @@ tests = testGroup "Text.Digestive.View.Tests"
             postForm "f" pokemonForm $ testEnv [("f.type",  "type.2")]
 
     , testCase "Nested postForm" $ (@=?)
-        (Just (Catch (Pokemon "charmander" (Just 5) Fire False) Ultra)) $
+        (Just (Catch (Pokemon "charmander" (Just 5) Fire [Water, Rock] False) Ultra)) $
         snd $ runTrainerM $ postForm "f" catchForm $ testEnv
-            [ ("f.pokemon.name",  "charmander")
-            , ("f.pokemon.level", "5")
-            , ("f.pokemon.type",  "type.1")
-            , ("f.ball",          "ball.2")
+            [ ("f.pokemon.name",     "charmander")
+            , ("f.pokemon.level",    "5")
+            , ("f.pokemon.type",     "type.1")
+            , ("f.pokemon.weakness", "weakness.0")
+            , ("f.pokemon.weakness", "weakness.3")
+            , ("f.ball",             "ball.2")
             ]
 
     , testCase "subView errors" $ (@=?)