Merge pull request #18 from ju1m/fix-14

Fix invalid input due to back-propagation, fixes #14

Author: Tom Harding

examples/Issue14.hs

@@ -0,0 +1,35 @@
+{-# Language BlockArguments #-}
+{-# Language FlexibleContexts #-}
+{-# Language PartialTypeSignatures #-}
+{-# Language TypeApplications #-}
+{-# Options_GHC -Wno-partial-type-signatures #-}
+module Issue14 where
+
+import Control.Monad.Watson (whenever, Watson)
+import Data.Holmes hiding (whenever)
+import Test.Hspec
+import Data.Word (Word8)
+import Data.Typeable (Typeable)
+
+issue14 ::
+  AbsR (jsl int) =>
+  Enum (Raw (jsl int)) =>
+  EqC jsl int =>
+  EqR jsl =>
+  Input (jsl int) =>
+  Num (Raw (jsl int)) =>
+  Num (jsl int) =>
+  SumR (jsl int) =>
+  Typeable int =>
+  [ [jsl int] ]
+issue14 = do
+  let guesses = 2 `from` [1 .. 3] :: Config (Watson _) _
+  guesses `whenever` \[a, b] ->
+    (a .+ b) .== 5
+
+spec_issue14 :: Spec
+spec_issue14 = do
+  it "handles constraints from the output when refining Defined inputs" do
+    issue14 @Defined @Int `shouldBe` [ [2,3], [3,2] ]
+  it "handles constraints from the output when refining Intersect inputs" do
+    issue14 @Intersect @Word8 `shouldBe` [ [2,3], [3,2] ]

holmes.cabal

@@ -38,7 +38,7 @@ library
                , Data.JoinSemilattice.Class.Zipping
                , Data.CDCL
 
-  build-depends: base >= 4.12 && < 4.15
+  build-depends: base >= 4.12 && < 4.16
                , containers >= 0.6 && < 0.7
                , hashable >= 1.3 && < 1.4
                , hedgehog >= 1.0 && < 1.1
@@ -62,15 +62,16 @@ test-suite examples
   build-depends: base
                , hashable >= 1.3 && < 1.4
                , holmes
-               , hspec >= 2.7 && < 2.8
+               , hspec >= 2.7 && < 2.9
                , split >= 0.2 && < 0.3
                , unordered-containers >= 0.2 && < 0.3
-               , relude >= 0.6 && < 0.8
+               , relude >= 0.6 && < 1.1
                , tasty >= 1.2 && < 1.5
                , tasty-discover
                , tasty-hspec
 
   other-modules: Futoshiki
+               , Issue14
                , WaveFunctionCollapse
 
   ghc-options: -Wall -Wextra -threaded
@@ -125,7 +126,7 @@ test-suite readme
   build-depends: base
                , hashable >= 1.3 && < 1.4
                , holmes
-               , hspec >= 2.7 && < 2.8
+               , hspec >= 2.7 && < 2.9
   main-is:             README.lhs
   type:                exitcode-stdio-1.0
   default-language:    Haskell2010

src/Data/JoinSemilattice/Defined.hs

@@ -93,10 +93,12 @@ instance Fractional x => Fractional (Defined x) where
   fromRational = pure . fromRational
   recip        = fmap recip
 
-instance Input (Defined content) where
+instance Eq content => Input (Defined content) where
   type Raw (Defined content) = content
 
   from count options = Config (replicate count Unknown) do
     pure . \case
       Unknown -> map Exactly options
-      decided -> [ decided ]
+      Exactly a | a `elem` options -> [Exactly a]
+                | otherwise -> [Conflict]
+      Conflict -> [Conflict]