Fix warnings

misc/build_artifacts.hs

@@ -6,6 +6,9 @@
 import Turtle
 import qualified Control.Foldl as L
 import Control.Monad
+#if MIN_VERSION_turtle(1,6,0)
+import qualified Data.Text as T
+#endif
 import Distribution.Package
 import Distribution.PackageDescription
 import Distribution.PackageDescription.Parsec
@@ -58,12 +61,20 @@ main = sh $ do
   when b $ rmtree pkg
 
   mktree (pkg </> "bin")
+#if MIN_VERSION_turtle(1,6,0)
+  let binDir = T.unpack (lineToText local_install_root) </> "bin"
+#else
   let binDir = fromText (lineToText local_install_root) </> "bin"
+#endif
   forM exe_files $ \name -> do
     cp (binDir </> addExeSuffix name) (pkg </> "bin" </> addExeSuffix name)
 
   mktree (pkg </> "lib")
+#if MIN_VERSION_turtle(1,6,0)
+  let libDir = T.unpack (lineToText local_install_root) </> "lib"
+#else
   let libDir = fromText (lineToText local_install_root) </> "lib"
+#endif
   when (Info.os == "mingw32") $ do
     cp (libDir </> "toysat-ipasir.dll") (pkg </> "bin" </> "toysat-ipasir.dll")
     proc "stack"

src/ToySolver/Graph/ShortestPath.hs

@@ -68,7 +68,6 @@ import Control.Monad
 import Control.Monad.ST
 import Control.Monad.Trans
 import Control.Monad.Trans.Except
-import Data.Hashable
 import qualified Data.HashTable.Class as H
 import qualified Data.HashTable.ST.Cuckoo as C
 import Data.IntMap.Strict (IntMap)

test/Test/Converter.hs

@@ -1,5 +1,6 @@
 {-# OPTIONS_GHC -Wall #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
 module Test.Converter (converterTestGroup) where
@@ -824,15 +825,10 @@ prop_pb2ip_backward =
   forAll arbitraryPBFormula $ \pb ->
     let ret@(mip, info) = pb2ip pb
      in counterexample (show ret) $
-        forAll (arbitraryAssignments mip) $ \sol ->
+        forAll (arbitraryAssignmentBinaryIP mip) $ \sol ->
           SAT.evalPBFormula (transformBackward info sol) pb
           ===
           fmap (transformObjValueBackward info) (evalMIP sol (fmap fromIntegral mip))
-  where
-    arbitraryAssignments mip = liftM Map.fromList $ do
-      forM (Map.keys (MIP.varType mip)) $ \v -> do
-        val <- choose (0, 1)
-        pure (v, fromInteger val)
 
 prop_pb2ip_json :: Property
 prop_pb2ip_json =
@@ -859,18 +855,13 @@ prop_wbo2ip_backward =
   forAll arbitrary $ \b ->
     let ret@(mip, info) = wbo2ip b wbo
      in counterexample (show ret) $
-        forAll (arbitraryAssignments mip) $ \sol ->
+        forAll (arbitraryAssignmentBinaryIP mip) $ \sol ->
           case evalMIP sol (fmap fromIntegral mip) of
             Nothing -> True
             Just val2 ->
               case SAT.evalPBSoftFormula (transformBackward info sol) wbo of
                 Nothing -> False
                 Just val1 -> val1 <= transformObjValueBackward info val2
-  where
-    arbitraryAssignments mip = liftM Map.fromList $ do
-      forM (Map.keys (MIP.varType mip)) $ \v -> do
-        val <- choose (0, 1)
-        pure (v, fromInteger val)
 
 prop_wbo2ip_json :: Property
 prop_wbo2ip_json =
@@ -888,15 +879,10 @@ prop_mip2pb_forward =
       Left err -> counterexample err $ property False
       Right ret@(pb, info) ->
         counterexample (show ret) $
-          forAll (arbitraryAssignment ip) $ \sol ->
+          forAll (arbitraryAssignmentBoundedIP ip) $ \sol ->
             fmap (transformObjValueForward info) (evalMIP sol ip)
             ===
             SAT.evalPBFormula (transformForward info sol) pb
-  where
-    arbitraryAssignment mip = liftM Map.fromList $ do
-      forM (Map.toList (MIP.varBounds mip)) $ \(v, (MIP.Finite lb, MIP.Finite ub))  -> do
-        val <- choose (ceiling lb, floor ub)
-        pure (v, fromInteger val)
 
 prop_mip2pb_backward :: Property
 prop_mip2pb_backward =
@@ -920,8 +906,8 @@ prop_mip2pb_backward' =
           QM.monadicIO $ do
             solver <- arbitrarySolver
             -- Using optimizePBFormula is too slow for using in QuickCheck
-            ret <- QM.run $ solvePBFormula solver pb
-            case ret of
+            ret2 <- QM.run $ solvePBFormula solver pb
+            case ret2 of
               Nothing -> return ()
               Just m -> QM.assert $ isJust $ evalMIP (transformBackward info m) ip
 
@@ -1013,6 +999,20 @@ arbitraryMIPExpr vs = do
     c <- arbitrary
     return $ MIP.Term c ls
 
+arbitraryAssignmentBinaryIP :: MIP.Problem a -> Gen (Map MIP.Var Rational)
+arbitraryAssignmentBinaryIP mip = liftM Map.fromList $ do
+  forM (Map.keys (MIP.varType mip)) $ \v -> do
+    val <- choose (0, 1)
+    pure (v, fromInteger val)
+
+arbitraryAssignmentBoundedIP :: RealFrac a => MIP.Problem a -> Gen (Map MIP.Var Rational)
+arbitraryAssignmentBoundedIP mip = liftM Map.fromList $ do
+  forM (Map.toList (MIP.varBounds mip)) $ \case
+    (v, (MIP.Finite lb, MIP.Finite ub))  -> do
+      val <- choose (ceiling lb, floor ub)
+      pure (v, fromInteger val)
+    _ -> error "should not happen"
+
 evalMIP :: Map MIP.Var Rational -> MIP.Problem Rational -> Maybe Rational
 evalMIP sol prob = do
   forM_ (MIP.constraints prob) $ \constr -> do

test/Test/SAT.hs

@@ -148,8 +148,8 @@ case_incremental_solving = do
   ret @?= True
 
   SAT.addClause solver [-x1, x2]  -- not x1 or x2
-  ret <- SAT.solve solver -- unsat
-  ret @?= False
+  ret2 <- SAT.solve solver -- unsat
+  ret2 @?= False
 
 -- 制約なし
 case_empty_constraint :: Assertion
@@ -209,8 +209,8 @@ case_instantiateAtLeast = do
   ret @?= True
 
   SAT.addAtLeast solver [-x1,-x2,-x3,-x4] 2
-  ret <- SAT.solve solver
-  ret @?= True
+  ret2 <- SAT.solve solver
+  ret2 @?= True
 
 case_inconsistent_AtLeast :: Assertion
 case_inconsistent_AtLeast = do
@@ -223,19 +223,20 @@ case_inconsistent_AtLeast = do
 
 case_trivial_AtLeast :: Assertion
 case_trivial_AtLeast = do
-  solver <- SAT.newSolver
-  x1 <- SAT.newVar solver
-  x2 <- SAT.newVar solver
-  SAT.addAtLeast solver [x1,x2] 0
-  ret <- SAT.solve solver
-  ret @?= True
-
-  solver <- SAT.newSolver
-  x1 <- SAT.newVar solver
-  x2 <- SAT.newVar solver
-  SAT.addAtLeast solver [x1,x2] (-1)
-  ret <- SAT.solve solver
-  ret @?= True
+  do
+    solver <- SAT.newSolver
+    x1 <- SAT.newVar solver
+    x2 <- SAT.newVar solver
+    SAT.addAtLeast solver [x1,x2] 0
+    ret <- SAT.solve solver
+    ret @?= True
+  do
+    solver <- SAT.newSolver
+    x1 <- SAT.newVar solver
+    x2 <- SAT.newVar solver
+    SAT.addAtLeast solver [x1,x2] (-1)
+    ret <- SAT.solve solver
+    ret @?= True
 
 case_AtLeast_1 :: Assertion
 case_AtLeast_1 = do
@@ -340,14 +341,14 @@ case_solveWith_1 = do
   SAT.addClause solver [-x1, -x2]     -- not x1 or not x2
   SAT.addClause solver [-x3, -x1, x2] -- not x3 or not x1 or x2
 
-  ret <- SAT.solve solver -- sat
-  ret @?= True
+  ret2 <- SAT.solve solver -- sat
+  ret2 @?= True
 
-  ret <- SAT.solveWith solver [x3] -- unsat
-  ret @?= False
+  ret3 <- SAT.solveWith solver [x3] -- unsat
+  ret3 @?= False
 
-  ret <- SAT.solve solver -- sat
-  ret @?= True
+  ret4 <- SAT.solve solver -- sat
+  ret4 @?= True
 
 case_solveWith_2 :: Assertion
 case_solveWith_2 = do
@@ -360,8 +361,8 @@ case_solveWith_2 = do
   ret <- SAT.solveWith solver [x2]
   ret @?= True
 
-  ret <- SAT.solveWith solver [-x2]
-  ret @?= False
+  ret2 <- SAT.solveWith solver [-x2]
+  ret2 @?= False
 
 case_getVarFixed :: Assertion
 case_getVarFixed = do
@@ -375,14 +376,14 @@ case_getVarFixed = do
 
   SAT.addClause solver [-x1]
 
-  ret <- SAT.getVarFixed solver x1
-  ret @?= lFalse
+  ret2 <- SAT.getVarFixed solver x1
+  ret2 @?= lFalse
 
-  ret <- SAT.getLitFixed solver (-x1)
-  ret @?= lTrue
+  ret3 <- SAT.getLitFixed solver (-x1)
+  ret3 @?= lTrue
 
-  ret <- SAT.getLitFixed solver x2
-  ret @?= lTrue
+  ret4 <- SAT.getLitFixed solver x2
+  ret4 @?= lTrue
 
 case_getAssumptionsImplications_case1 :: Assertion
 case_getAssumptionsImplications_case1 = do