minizinc-process 0.1.4.1 → 0.1.5.0
raw patch · 3 files changed
+153/−146 lines, 3 filesdep +attoparsec-aesondep ~aesondep ~attoparsecdep ~bytestring
Dependencies added: attoparsec-aeson
Dependency ranges changed: aeson, attoparsec, bytestring, containers, directory, hashable, process, process-extras, template-haskell, text
Files
- CHANGELOG.md +4/−2
- minizinc-process.cabal +15/−13
- src/Process/Minizinc.hs +134/−131
CHANGELOG.md view
@@ -2,9 +2,11 @@ ## Unreleased changes -## 0.1.4.1 -- 2020-11-12- * Improve TemplateHaskell to arrays of floats and arrays of bools.++## 0.1.5.0 -- 2024-04-02++* Upgrade to aeson-2.x. ## 0.1.4.0 -- 2020-11-12
minizinc-process.cabal view
@@ -4,7 +4,7 @@ -- http://haskell.org/cabal/users-guide/ name: minizinc-process-version: 0.1.4.1+version: 0.1.5.0 synopsis: A set of helpers to call minizinc models. description: MiniZinc is a language and a toolchain to solve discrete optimization problems. This package provides simple wrappers around the MiniZinc executable to pass inputs and read outputs. homepage: https://github.com/lucasdicioccio/minizinc-process#readme@@ -31,23 +31,25 @@ Process.Minizinc.TH hs-source-dirs: src- build-depends: base >=4.8.2 && <4.14- , aeson >= 1.4- , attoparsec >= 0.13.2.2- , bytestring >= 0.10.4.0- , containers >= 0.5.5.1- , directory >= 1.3.1.0- , hashable >= 1.2.7.0- , process >= 1.6.4.0- , process-extras >= 0.7.4- , text >= 1.2.3.0- , template-haskell >= 2.15.0.0+ build-depends: base >=4.8.2 && <5,+ aeson >= 2.2.1 && < 2.3,+ template-haskell >= 2.19.0 && < 2.20,+ containers >= 0.6.6 && < 0.7,+ bytestring >= 0.12.1 && < 0.13,+ hashable >= 1.4.3 && < 1.5,+ text >= 2.1.1 && < 2.2,+ attoparsec >= 0.14.4 && < 0.15,+ attoparsec-aeson >= 2.2.0 && < 2.3,+ directory >= 1.3.8 && < 1.4,+ process >= 1.6.18 && < 1.7,+ process-extras >= 0.7.4 && < 0.8+ default-language: Haskell2010 test-suite minizinc-process-tests-hedghehog main-is: Test.hs type: exitcode-stdio-1.0- build-depends: base >=4.10 && <4.14+ build-depends: base >=4.10 && <5 , aeson , minizinc-process , hashable
src/Process/Minizinc.hs view
@@ -1,44 +1,46 @@+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE DeriveFunctor #-} --- | A set of types and functions to help calling Minizinc as an external binary.------ Current strategy is to use JSON encode/decoding for passing in inputs and--- reading outputs.--- At this time, only a primitive output parser is supported.-module Process.Minizinc- ( MiniZinc (..),+{- | A set of types and functions to help calling Minizinc as an external binary.++Current strategy is to use JSON encode/decoding for passing in inputs and+reading outputs.+At this time, only a primitive output parser is supported.+-}+module Process.Minizinc (+ MiniZinc (..), simpleMiniZinc, withArgs, Solver (..), SolverName, MilliSeconds,- SearchState(..),+ SearchState (..), result,- ResultHandler(..),+ ResultHandler (..), runMinizincJSON, collectResults, keepLast, runLastMinizincJSON, cleanTmpFile,- )+) where import Control.Applicative ((<|>)) import Control.Exception (bracket)-import Data.Attoparsec.ByteString (Parser, parse, IResult(..))-import Data.Attoparsec.Combinator (try)-import Data.Aeson (FromJSON, fromJSON, ToJSON, encode, Value, Result(..))+import Data.Aeson (FromJSON, Result (..), ToJSON, Value, encode, fromJSON) import Data.Aeson.Parser.Internal (json')+import Data.Attoparsec.ByteString (IResult (..), Parser, parse)+import Data.Attoparsec.Combinator (try) import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Char8 as C8 import qualified Data.ByteString.Lazy as LByteString import Data.Hashable (Hashable, hash)-import System.Directory (removeFile)-import System.Process (createProcess, proc, StdStream(CreatePipe), std_out, cleanupProcess) import GHC.IO.Handle (Handle, hIsEOF)+import System.Directory (removeFile)+import System.Process (StdStream (CreatePipe), cleanupProcess, createProcess, proc, std_out) -- | Type alias asking for milliseconds. type MilliSeconds a = Int@@ -48,22 +50,22 @@ -- | Supported solvers or 'Other'. data Solver = Chuffed | COIN_BC | CPLEX | Gecode | Gurobi | SCIP | Xpress | Other SolverName- deriving (Show)+ deriving (Show) -- | An object helping to run MiniZinc. data MiniZinc input answer- = MiniZinc- { -- | a file path to a model- model :: FilePath,- -- | a file path to hold, must be writable and readable- mkTmpDataPath :: input -> FilePath,- -- | a timelimit in seconds (an Int)- mkTimeLimit :: input -> MilliSeconds Int,- -- | the solver to use (see `minizinc --solvers`)- mkSolver :: input -> Solver,- -- | other arguments that get appended before the path to the model and data paths- mkExtraArgs :: input -> [String]- }+ = MiniZinc+ { model :: FilePath+ -- ^ a file path to a model+ , mkTmpDataPath :: input -> FilePath+ -- ^ a file path to hold, must be writable and readable+ , mkTimeLimit :: input -> MilliSeconds Int+ -- ^ a timelimit in seconds (an Int)+ , mkSolver :: input -> Solver+ -- ^ the solver to use (see `minizinc --solvers`)+ , mkExtraArgs :: input -> [String]+ -- ^ other arguments that get appended before the path to the model and data paths+ } -- | Removes the temporary data file created as input before running minizinc. cleanTmpFile :: MiniZinc input a -> input -> IO ()@@ -71,68 +73,69 @@ -- | A constructor for MiniZinc object for simple situations. simpleMiniZinc ::- Hashable input =>- FilePath ->- MilliSeconds Int ->- Solver ->- MiniZinc input answer+ (Hashable input) =>+ FilePath ->+ MilliSeconds Int ->+ Solver ->+ MiniZinc input answer simpleMiniZinc path timeout solver =- MiniZinc- path- (\obj -> "minizinc-process-" ++ show (hash obj) ++ ".json")- (const timeout)- (const solver)- (const [])+ MiniZinc+ path+ (\obj -> "minizinc-process-" ++ show (hash obj) ++ ".json")+ (const timeout)+ (const solver)+ (const []) -- | Helper to set arguments. withArgs :: [String] -> MiniZinc input answer -> MiniZinc input answer-withArgs args mzn = mzn { mkExtraArgs = const args }+withArgs args mzn = mzn{mkExtraArgs = const args} -- | Runs MiniZinc on the input and parses output for the last answer. runLastMinizincJSON ::- (ToJSON input, FromJSON answer) =>- MiniZinc input answer ->- input ->- IO (Maybe answer)+ (ToJSON input, FromJSON answer) =>+ MiniZinc input answer ->+ input ->+ IO (Maybe answer) runLastMinizincJSON minizinc obj = do- fmap adapt $ runMinizincJSON minizinc obj Nothing keepLast+ fmap adapt $ runMinizincJSON minizinc obj Nothing keepLast where adapt :: Maybe (SearchState a) -> Maybe a adapt x = x >>= result data SearchState a- = Exhausted a- | Incomplete a- | Unsatisfiable- | InternalError String- deriving (Show, Eq, Ord, Functor)+ = Exhausted a+ | Incomplete a+ | Unsatisfiable+ | InternalError String+ deriving (Show, Eq, Ord, Functor) result :: SearchState a -> Maybe a result (Incomplete a) = Just a result (Exhausted a) = Just a result _ = Nothing -reduce :: FromJSON a => SearchState Value -> SearchState a+reduce :: (FromJSON a) => SearchState Value -> SearchState a reduce Unsatisfiable = Unsatisfiable reduce (InternalError s) = InternalError s reduce (Exhausted val) = case fromJSON val of- Success obj -> Exhausted obj- Error err -> InternalError err+ Success obj -> Exhausted obj+ Error err -> InternalError err reduce (Incomplete val) = case fromJSON val of- Success obj -> Incomplete obj- Error err -> InternalError err+ Success obj -> Incomplete obj+ Error err -> InternalError err data ResultHandler obj b- = ResultHandler- { handleNext :: b -> SearchState obj -> IO (b, Maybe (ResultHandler obj b))- }+ = ResultHandler+ { handleNext :: b -> SearchState obj -> IO (b, Maybe (ResultHandler obj b))+ } --- | Collect all results in memory.--- The resulting list is in reverse order (best are first elements in case of optimizations).+{- | Collect all results in memory.+The resulting list is in reverse order (best are first elements in case of optimizations).+-} collectResults :: ResultHandler obj [SearchState obj] collectResults = ResultHandler go where- go xs x = seq x $ pure (x:xs, Just $ collectResults)+ go xs x = seq x $ pure (x : xs, Just $ collectResults) -- | Keep only the latest result in memory. keepLast :: ResultHandler obj (Maybe (SearchState obj))@@ -140,53 +143,53 @@ where go _ x = seq x $ pure (Just x, Just $ keepLast) - runMinizincJSON ::- forall input answer b.- (ToJSON input, FromJSON answer) =>- MiniZinc input answer ->- input ->- b ->- ResultHandler answer b ->- IO b+ forall input answer b.+ (ToJSON input, FromJSON answer) =>+ MiniZinc input answer ->+ input ->+ b ->+ ResultHandler answer b ->+ IO b runMinizincJSON minizinc obj v0 resultHandler = do- LByteString.writeFile fullPath $ encode obj- let start = createProcess (proc "minizinc" args){ std_out = CreatePipe }- bracket- start- cleanupProcess- (\(_, Just out, _, _) -> go out (parse oneResult) "" v0 resultHandler)+ LByteString.writeFile fullPath $ encode obj+ let start = createProcess (proc "minizinc" args){std_out = CreatePipe}+ bracket+ start+ cleanupProcess+ (\(_, Just out, _, _) -> go out (parse oneResult) "" v0 resultHandler) where- go :: Handle- -> (ByteString -> IResult ByteString (SearchState Value))- -> ByteString- -> b- -> ResultHandler answer b- -> IO b+ go ::+ Handle ->+ (ByteString -> IResult ByteString (SearchState Value)) ->+ ByteString ->+ b ->+ ResultHandler answer b ->+ IO b go out parsebuf buf v1 handler = do- case parsebuf buf of- Done remainderBuf stateVal -> do- (v2, nextHandler) <- (handleNext handler) v1 (reduce stateVal)- case nextHandler of- Nothing -> userFinished v2- Just resultHandler -> go out (parse oneResult) remainderBuf v2 resultHandler- Fail _ _ err -> do- (v2,_) <- (handleNext handler) v1 (InternalError err)- finalizeFailure v2- Partial f -> do- -- NOTE: on End-Of-File we attempt to feed an empty byte to- -- conclude the parse.- -- Thus the real "final marked" is when the Handle is at EOF and- -- the input chunk is empty.- -- A more explicit final-result marker could benefit the- -- implementation of ResultHandler.- eof <- hIsEOF out- case (eof, ByteString.null buf) of- (True, True) -> inputFinished v1- (True, False) -> go out f "" v1 handler- _ -> do- dat <- ByteString.hGetLine out- go out f dat v1 handler+ case parsebuf buf of+ Done remainderBuf stateVal -> do+ (v2, nextHandler) <- (handleNext handler) v1 (reduce stateVal)+ case nextHandler of+ Nothing -> userFinished v2+ Just resultHandler -> go out (parse oneResult) remainderBuf v2 resultHandler+ Fail _ _ err -> do+ (v2, _) <- (handleNext handler) v1 (InternalError err)+ finalizeFailure v2+ Partial f -> do+ -- NOTE: on End-Of-File we attempt to feed an empty byte to+ -- conclude the parse.+ -- Thus the real "final marked" is when the Handle is at EOF and+ -- the input chunk is empty.+ -- A more explicit final-result marker could benefit the+ -- implementation of ResultHandler.+ eof <- hIsEOF out+ case (eof, ByteString.null buf) of+ (True, True) -> inputFinished v1+ (True, False) -> go out f "" v1 handler+ _ -> do+ dat <- C8.hGetLine out+ go out f dat v1 handler inputFinished = pure userFinished = pure@@ -196,45 +199,45 @@ fullPath = mkTmpDataPath minizinc obj args :: [String] args =- [ "--time-limit",- show (mkTimeLimit minizinc obj),- "--solver",- showSolver (mkSolver minizinc obj),- "--output-mode",- "json"- ]- ++ (mkExtraArgs minizinc obj)- ++ [ model minizinc,- fullPath- ]+ [ "--time-limit"+ , show (mkTimeLimit minizinc obj)+ , "--solver"+ , showSolver (mkSolver minizinc obj)+ , "--output-mode"+ , "json"+ ]+ ++ (mkExtraArgs minizinc obj)+ ++ [ model minizinc+ , fullPath+ ] showSolver :: Solver -> String showSolver = \case- Chuffed -> "Chuffed"- COIN_BC -> "COIN-BC"- CPLEX -> "CPLEX"- Gecode -> "Gecode"- Gurobi -> "Gurobi"- SCIP -> "SCIP"- Xpress -> "Xpress"- Other n -> n-+ Chuffed -> "Chuffed"+ COIN_BC -> "COIN-BC"+ CPLEX -> "CPLEX"+ Gecode -> "Gecode"+ Gurobi -> "Gurobi"+ SCIP -> "SCIP"+ Xpress -> "Xpress"+ Other n -> n --- | NOTE: the parser is fed with hGetLine (stripping EOL markers)--- this assumption simplifies the grammar below+{- | NOTE: the parser is fed with hGetLine (stripping EOL markers)+this assumption simplifies the grammar below+-} oneResult :: Parser (SearchState Value) oneResult = try unsat- <|> sat+ <|> sat where- unsat = unsatMark *> pure Unsatisfiable+ unsat = unsatMark *> pure Unsatisfiable sat = reverseAp <$> json' <*> searchstate reverseAp val constructor = constructor val searchstate =- try (resultMark *> exhaustiveMark *> pure Exhausted)- <|> try (resultMark *> pure Incomplete)+ try (resultMark *> exhaustiveMark *> pure Exhausted)+ <|> try (resultMark *> pure Incomplete) resultMark = "----------" exhaustiveMark = "=========="