fix arbitrary P_Population

AmpersandTarski · Sep 18, 2023 · a079534 · a079534
1 parent 1edda1e
commit a079534
Showing 1 changed file with 8 additions and 5 deletions.
diff --git a/src/Ampersand/Test/Parser/ArbitraryTree.hs b/src/Ampersand/Test/Parser/ArbitraryTree.hs
@@ -336,9 +336,6 @@ instance Arbitrary TermPrim where
         Pfull <$> arbitrary <*> arbitrary `suchThat` noLabel <*> arbitrary `suchThat` noLabel,
         PNamedR <$> arbitrary
       ]
-    where
-      noMaybeLabel :: Maybe P_Concept -> Bool
-      noMaybeLabel = maybe True noLabel
 
 instance Arbitrary (PairView (Term TermPrim)) where
   arbitrary = PairView <$> arbitrary
@@ -427,8 +424,8 @@ instance Arbitrary P_Population where
   arbitrary =
     oneof
       [ P_RelPopu
-          <$> arbitrary `suchThat` noOne
-          <*> arbitrary `suchThat` noOne
+          <$> arbitrary `suchThat` notMaybeIsOneAndNoLabel
+          <*> arbitrary `suchThat` notMaybeIsOneAndNoLabel
           <*> arbitrary
           <*> arbitrary
           <*> arbitrary,
@@ -585,6 +582,12 @@ notIsOneAndnoLabel cpt = case cpt of
   PCpt _ lbl -> isNothing lbl
   P_ONE -> False
 
+noMaybeLabel :: Maybe P_Concept -> Bool
+noMaybeLabel = maybe True noLabel
+
+notMaybeIsOneAndNoLabel :: Maybe P_Concept -> Bool
+notMaybeIsOneAndNoLabel = maybe False notIsOneAndnoLabel
+
 safePlainName :: Gen Text1
 safePlainName =
   oneof