pseudo-boolean 0.1.3.0 → 0.1.4.0

raw patch · 4 files changed

+333/−11 lines, 4 filesdep +megaparsecdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: megaparsec

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +4/−0
• pseudo-boolean.cabal +3/−1
• src/Data/PseudoBoolean/Megaparsec.hs +273/−0
• test/TestPBFile.hs +53/−10

@@ -1,3 +1,7 @@+0.1.4.0+-------+* add Megaparsec-based parsers+ 0.1.3.0 ------- * relax the grammer of OPB/WBO files to allow ommitng spaces at the end of weighted terms.

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                pseudo-boolean-version:             0.1.3.0+version:             0.1.4.0 synopsis:            Reading/Writing OPB/WBO files used in pseudo boolean competition description:         Reading\/Writing OPB\/WBO files used in pseudo boolean competition homepage:            https://github.com/msakai/pseudo-boolean@@ -32,6 +32,7 @@      Data.PseudoBoolean.Builder      Data.PseudoBoolean.ByteStringBuilder      Data.PseudoBoolean.Parsec+     Data.PseudoBoolean.Megaparsec      Data.PseudoBoolean.Attoparsec      Data.PseudoBoolean.Internal.TextUtil   other-modules:@@ -47,6 +48,7 @@      base >=4.6.0.1 && <4.9,      containers >=0.4.2.1,      parsec >=3.1.2 && <4,+     megaparsec >=4 && <5,      bytestring >=0.9.2.1 && <0.11,      bytestring-builder,      dlist >=0.7.0 && <0.8.0,

@@ -0,0 +1,273 @@+{-# LANGUAGE BangPatterns, FlexibleContexts #-}+{-# OPTIONS_GHC -Wall #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.PseudoBoolean.Megaparsec+-- Copyright   :  (c) Masahiro Sakai 2011-2016+-- License     :  BSD-style+-- +-- Maintainer  :  masahiro.sakai@gmail.com+-- Portability :  non-portable (BangPatterns, FlexibleContexts)+--+-- A parser library for OPB file and WBO files used in pseudo boolean competition.+-- +-- References:+--+-- * Input/Output Format and Solver Requirements for the Competitions of+--   Pseudo-Boolean Solvers+--   <http://www.cril.univ-artois.fr/PB11/format.pdf>+--+-----------------------------------------------------------------------------++module Data.PseudoBoolean.Megaparsec+  (+  -- * Parsing OPB files+    opbParser+  , parseOPBString+  , parseOPBByteString+  , parseOPBFile++  -- * Parsing WBO files+  , wboParser+  , parseWBOString+  , parseWBOByteString+  , parseWBOFile+  ) where++import Prelude hiding (sum)+import Control.Applicative ((<*))+import Control.Monad+import Data.ByteString.Lazy (ByteString)+import Data.Maybe+import Text.Megaparsec+import Data.PseudoBoolean.Types+import Data.PseudoBoolean.Internal.TextUtil++-- | Parser for OPB files+opbParser :: Stream s Char => ParsecT s m Formula+opbParser = formula++-- | Parser for WBO files+wboParser :: Stream s Char => ParsecT s m SoftFormula+wboParser = softformula++-- <formula>::= <sequence_of_comments> [<objective>] <sequence_of_comments_or_constraints>+formula :: Stream s Char => ParsecT s m Formula+formula = do+  h <- optional hint+  sequence_of_comments+  obj <- optional objective+  cs <- sequence_of_comments_or_constraints+  return $+    Formula+    { pbObjectiveFunction = obj+    , pbConstraints = cs+    , pbNumVars = fromMaybe (pbComputeNumVars obj cs) (fmap fst h)+    , pbNumConstraints = fromMaybe (length cs) (fmap snd h)+    }++hint :: Stream s Char => ParsecT s m (Int,Int)+hint = try $ do+  _ <- char '*'+  zeroOrMoreSpace+  _ <- string "#variable="+  zeroOrMoreSpace+  nv <- unsigned_integer+  oneOrMoreSpace  +  _ <- string "#constraint="+  zeroOrMoreSpace+  nc <- unsigned_integer+  _ <- manyTill anyChar eol+  return (fromIntegral nv, fromIntegral nc)++-- <sequence_of_comments>::= <comment> [<sequence_of_comments>]+sequence_of_comments :: Stream s Char => ParsecT s m ()+sequence_of_comments = skipMany comment -- XXX: we allow empty sequence++-- <comment>::= "*" <any_sequence_of_characters_other_than_EOL> <EOL>+comment :: Stream s Char => ParsecT s m ()+comment = do+  _ <- char '*' +  _ <- manyTill anyChar eol+  space -- We relax the grammer and allow spaces in the beggining of next component.+  return ()++-- <sequence_of_comments_or_constraints>::= <comment_or_constraint> [<sequence_of_comments_or_constraints>]+sequence_of_comments_or_constraints :: Stream s Char => ParsecT s m [Constraint]+sequence_of_comments_or_constraints = do+  xs <- many comment_or_constraint -- We relax the grammer and allow spaces in the beginning of next component.+  return $ catMaybes xs++-- <comment_or_constraint>::= <comment>|<constraint>+comment_or_constraint :: Stream s Char => ParsecT s m (Maybe Constraint)+comment_or_constraint =+  (comment >> return Nothing) <|> (liftM Just constraint)++-- <objective>::= "min:" <zeroOrMoreSpace> <sum> ";"+objective :: Stream s Char => ParsecT s m Sum+objective = do+  _ <- string "min:"+  zeroOrMoreSpace+  obj <- sum+  semi+  return obj++-- <constraint>::= <sum> <relational_operator> <zeroOrMoreSpace> <integer> <zeroOrMoreSpace> ";"+constraint :: Stream s Char => ParsecT s m Constraint+constraint = do+  lhs <- sum+  op <- relational_operator+  zeroOrMoreSpace+  rhs <- integer+  zeroOrMoreSpace+  semi+  return (lhs, op, rhs)++-- <sum>::= <weightedterm> | <weightedterm> <sum>+sum :: Stream s Char => ParsecT s m Sum+sum = some weightedterm++-- <weightedterm>::= <integer> <oneOrMoreSpace> <term> <oneOrMoreSpace>+weightedterm :: Stream s Char => ParsecT s m WeightedTerm+weightedterm = do+  w <- integer+  oneOrMoreSpace+  t <- term+  zeroOrMoreSpace -- we relax the grammar to allow omitting spaces at the end of <sum>.+  return (w,t)++-- <integer>::= <unsigned_integer> | "+" <unsigned_integer> | "-" <unsigned_integer>+integer :: Stream s Char => ParsecT s m Integer+integer = msum+  [ unsigned_integer+  , char '+' >> unsigned_integer+  , char '-' >> liftM negate unsigned_integer+  ]++-- <unsigned_integer>::= <digit> | <digit><unsigned_integer>+unsigned_integer :: Stream s Char => ParsecT s m Integer+unsigned_integer = do+  ds <- some digitChar+  return $! readUnsignedInteger ds++-- <relational_operator>::= ">=" | "="+relational_operator :: Stream s Char => ParsecT s m Op+relational_operator = (string ">=" >> return Ge) <|> (string "=" >> return Eq)++-- <variablename>::= "x" <unsigned_integer>+variablename :: Stream s Char => ParsecT s m Var+variablename = do+  _ <- char 'x'+  i <- unsigned_integer+  return $! fromIntegral i++-- <oneOrMoreSpace>::= " " [<oneOrMoreSpace>]+oneOrMoreSpace :: Stream s Char => ParsecT s m ()+oneOrMoreSpace  = skipSome (char ' ')++-- <zeroOrMoreSpace>::= [" " <zeroOrMoreSpace>]+zeroOrMoreSpace :: Stream s Char => ParsecT s m ()+-- zeroOrMoreSpace = skipMany (char ' ')+zeroOrMoreSpace = space+-- We relax the grammer and allow more type of spacing++semi :: Stream s Char => ParsecT s m ()+semi = char ';' >> space+-- We relax the grammer and allow spaces in the beginning of next component.++{-+For linear pseudo-Boolean instances, <term> is defined as+<term>::=<variablename>++For non-linear instances, <term> is defined as+<term>::= <oneOrMoreLiterals>+-}+term :: Stream s Char => ParsecT s m Term+term = oneOrMoreLiterals++-- <oneOrMoreLiterals>::= <literal> | <literal> <oneOrMoreSpace> <oneOrMoreLiterals>+oneOrMoreLiterals :: Stream s Char => ParsecT s m [Lit]+oneOrMoreLiterals = do+  l <- literal+  mplus (try $ oneOrMoreSpace >> liftM (l:) (oneOrMoreLiterals)) (return [l])+-- Note that we cannot use sepBy1.+-- In "p `sepBy1` q", p should success whenever q success.+-- But it's not the case here.++-- <literal>::= <variablename> | "~"<variablename>+literal :: Stream s Char => ParsecT s m Lit+literal = variablename <|> (char '~' >> liftM negate variablename)++-- | Parse a OPB format string containing pseudo boolean problem.+parseOPBString :: String -> String -> Either ParseError Formula+parseOPBString = parse (formula <* eof)++-- | Parse a OPB format lazy bytestring containing pseudo boolean problem.+parseOPBByteString :: String -> ByteString -> Either ParseError Formula+parseOPBByteString = parse (formula <* eof)++-- | Parse a OPB file containing pseudo boolean problem.+parseOPBFile :: FilePath -> IO (Either ParseError Formula)+parseOPBFile = parseFromFile ((formula <* eof) :: Parsec ByteString Formula)+++-- <softformula>::= <sequence_of_comments> <softheader> <sequence_of_comments_or_constraints>+softformula :: Stream s Char => ParsecT s m SoftFormula+softformula = do+  h <- optional hint+  sequence_of_comments+  top <- softheader+  cs <- wbo_sequence_of_comments_or_constraints+  return $+    SoftFormula+    { wboTopCost = top+    , wboConstraints = cs+    , wboNumVars = fromMaybe (wboComputeNumVars cs) (fmap fst h)+    , wboNumConstraints = fromMaybe (length cs) (fmap snd h)+    }++-- <softheader>::= "soft:" [<unsigned_integer>] ";"+softheader :: Stream s Char => ParsecT s m (Maybe Integer)+softheader = do+  _ <- string "soft:"+  zeroOrMoreSpace -- XXX+  top <- optional unsigned_integer+  zeroOrMoreSpace -- XXX+  semi+  return top++-- <sequence_of_comments_or_constraints>::= <comment_or_constraint> [<sequence_of_comments_or_constraints>]+wbo_sequence_of_comments_or_constraints :: Stream s Char => ParsecT s m [SoftConstraint]+wbo_sequence_of_comments_or_constraints = do+  xs <- many wbo_comment_or_constraint -- XXX: we relax the grammer to allow empty sequence+  return $ catMaybes xs++-- <comment_or_constraint>::= <comment>|<constraint>|<softconstraint>+wbo_comment_or_constraint :: Stream s Char => ParsecT s m (Maybe SoftConstraint)+wbo_comment_or_constraint = (comment >> return Nothing) <|> m+  where+    m = liftM Just $ (constraint >>= \c -> return (Nothing, c)) <|> softconstraint++-- <softconstraint>::= "[" <zeroOrMoreSpace> <unsigned_integer> <zeroOrMoreSpace> "]" <constraint>+softconstraint :: Stream s Char => ParsecT s m SoftConstraint+softconstraint = do+  _ <- char '['+  zeroOrMoreSpace+  cost <- unsigned_integer+  zeroOrMoreSpace+  _ <- char ']'+  zeroOrMoreSpace -- XXX+  c <- constraint+  return (Just cost, c)++-- | Parse a WBO format string containing weighted boolean optimization problem.+parseWBOString :: String -> String -> Either ParseError SoftFormula+parseWBOString = parse (softformula <* eof)++-- | Parse a WBO format lazy bytestring containing pseudo boolean problem.+parseWBOByteString :: String -> ByteString -> Either ParseError SoftFormula+parseWBOByteString = parse (softformula <* eof)++-- | Parse a WBO file containing weighted boolean optimization problem.+parseWBOFile :: FilePath -> IO (Either ParseError SoftFormula)+parseWBOFile = parseFromFile ((softformula <* eof) :: Parsec ByteString SoftFormula)

@@ -12,6 +12,7 @@ import Test.Tasty.TH import Data.PseudoBoolean import qualified Data.PseudoBoolean.Attoparsec as A+import qualified Data.PseudoBoolean.Megaparsec as M import Data.PseudoBoolean.Internal.TextUtil  case_exampleLIN  = checkOPBString "exampleLIN"  exampleLIN@@ -42,7 +43,9 @@  case_trailing_junk = do   isError (parseOPBString "" trailingJunk) @?= True+  isError (M.parseOPBString "" trailingJunk) @?= True   isError (parseOPBByteString "" (BSChar8.pack trailingJunk)) @?= True+  isError (M.parseOPBByteString "" (BSChar8.pack trailingJunk)) @?= True   isError (A.parseOPBByteString (BSChar8.pack trailingJunk)) @?= True   where     -- isLeft is available only on base >=4.7.0.0.@@ -66,7 +69,9 @@  case_min_eol = do   isOk (parseOPBString "" opb) @?= True+  isOk (M.parseOPBString "" opb) @?= True   isOk (parseOPBByteString "" (BSChar8.pack opb)) @?= True+  isOk (M.parseOPBByteString "" (BSChar8.pack opb)) @?= True   isOk (A.parseOPBByteString (BSChar8.pack opb)) @?= True   where     -- isLeft is available only on base >=4.7.0.0.@@ -90,7 +95,9 @@  case_empty_constraints = do   isOk (parseOPBString "" opb) @?= True+  isOk (M.parseOPBString "" opb) @?= True   isOk (parseOPBByteString "" (BSChar8.pack opb)) @?= True+  isOk (M.parseOPBByteString "" (BSChar8.pack opb)) @?= True   isOk (A.parseOPBByteString (BSChar8.pack opb)) @?= True   where     -- isRight is available only on base >=4.7.0.0.@@ -105,7 +112,9 @@  case_wbo_empty_constraints = do   isOk (parseWBOString "" wbo) @?= True+  isOk (M.parseWBOString "" wbo) @?= True   isOk (parseWBOByteString "" (BSChar8.pack wbo)) @?= True+  isOk (M.parseWBOByteString "" (BSChar8.pack wbo)) @?= True   isOk (A.parseWBOByteString (BSChar8.pack wbo)) @?= True   where     -- isRight is available only on base >=4.7.0.0.@@ -120,7 +129,9 @@  case_trailing_spaces_before_eol = do   isOk (parseOPBString "" opb) @?= True+  isOk (M.parseOPBString "" opb) @?= True   isOk (parseOPBByteString "" (BSChar8.pack opb)) @?= True+  isOk (M.parseOPBByteString "" (BSChar8.pack opb)) @?= True   isOk (A.parseOPBByteString (BSChar8.pack opb)) @?= True   where     -- isRight is available only on base >=4.7.0.0.@@ -143,7 +154,9 @@  case_trailing_spaces_before_eof = do   isOk (parseOPBString "" opb) @?= True+  isOk (M.parseOPBString "" opb) @?= True   isOk (parseOPBByteString "" (BSChar8.pack opb)) @?= True+  isOk (M.parseOPBByteString "" (BSChar8.pack opb)) @?= True   isOk (A.parseOPBByteString (BSChar8.pack opb)) @?= True   where     -- isRight is available only on base >=4.7.0.0.@@ -167,7 +180,9 @@  case_leading_spaces = do   isOk (parseOPBString "" opb) @?= True+  isOk (M.parseOPBString "" opb) @?= True   isOk (parseOPBByteString "" (BSChar8.pack opb)) @?= True+  isOk (M.parseOPBByteString "" (BSChar8.pack opb)) @?= True   isOk (A.parseOPBByteString (BSChar8.pack opb)) @?= True   where     -- isRight is available only on base >=4.7.0.0.@@ -284,17 +299,22 @@   case r of     Left err -> assertFailure $ show err     Right opb -> do-      r2 <- A.parseOPBFile fname+      r2 <- M.parseOPBFile fname       case r2 of         Left err2 -> assertFailure $ show err2         Right opb2 -> opb2 @?= opb+      r3 <- A.parseOPBFile fname+      case r3 of+        Left err2 -> assertFailure $ show err2+        Right opb2 -> opb2 @?= opb+       withSystemTempFile "TestPBFile.opb" $ \tmppath h -> do         hClose h         writeOPBFile tmppath opb-        r3 <- parseOPBFile tmppath-        case r3 of-          Left err3 -> assertFailure $ show err3-          Right opb3 -> opb3 @?= opb+        r4 <- parseOPBFile tmppath+        case r4 of+          Left err2 -> assertFailure $ show err2+          Right opb2 -> opb2 @?= opb  checkOPBString :: String -> String -> IO () checkOPBString name str = do@@ -304,12 +324,21 @@       let s = toOPBString opb           bs = toOPBByteString opb       BSChar8.unpack bs @?= s+       case parseOPBString name s of         Left err -> assertFailure $ show err         Right opb2 -> opb2 @?= opb       case parseOPBByteString name bs of         Left err -> assertFailure $ show err         Right opb2 -> opb2 @?= opb++      case M.parseOPBString name s of+        Left err -> assertFailure $ show err+        Right opb2 -> opb2 @?= opb+      case M.parseOPBByteString name bs of+        Left err -> assertFailure $ show err+        Right opb2 -> opb2 @?= opb+       case A.parseOPBByteString bs of         Left err -> assertFailure err         Right opb2 -> opb2 @?= opb@@ -320,17 +349,22 @@   case r of     Left err -> assertFailure $ show err     Right wbo -> do-      r2 <- A.parseWBOFile fname+      r2 <- M.parseWBOFile fname       case r2 of         Left err2 -> assertFailure $ show err2         Right wbo2 -> wbo2 @?= wbo+      r3 <- A.parseWBOFile fname+      case r3 of+        Left err2 -> assertFailure $ show err2+        Right wbo2 -> wbo2 @?= wbo+       withSystemTempFile "TestPBFile.wbo" $ \tmppath h -> do         hClose h         writeWBOFile tmppath wbo-        r3 <- parseWBOFile tmppath-        case r3 of-          Left err3 -> assertFailure $ show err3-          Right wbo3 -> wbo3 @?= wbo+        r4 <- parseWBOFile tmppath+        case r4 of+          Left err2 -> assertFailure $ show err2+          Right wbo2 -> wbo2 @?= wbo  checkWBOString :: String -> String -> IO () checkWBOString name str = do@@ -340,12 +374,21 @@       let s = toWBOString wbo           bs = toWBOByteString wbo       BSChar8.unpack bs @?= s+       case parseWBOString name s of         Left err -> assertFailure $ show err         Right wbo2 -> wbo2 @?= wbo       case parseWBOByteString name bs of         Left err -> assertFailure $ show err         Right wbo2 -> wbo2 @?= wbo++      case M.parseWBOString name s of+        Left err -> assertFailure $ show err+        Right wbo2 -> wbo2 @?= wbo+      case M.parseWBOByteString name bs of+        Left err -> assertFailure $ show err+        Right wbo2 -> wbo2 @?= wbo+       case A.parseWBOByteString bs of         Left err -> assertFailure err         Right wbo2 -> wbo2 @?= wbo