packages feed

minizinc-process 0.1.0.0 → 0.1.1.0

raw patch · 4 files changed

+150/−14 lines, 4 filesdep +attoparsecdep +process

Dependencies added: attoparsec, process

Files

CHANGELOG.md view
@@ -1,5 +1,12 @@ # Revision history for minizinc-process +## Unreleased changes++## 0.1.1.0 -- 2020-11-07++* Add streaming results API.+* Add helper to set extra arguments.+ ## 0.1.0.0 -- YYYY-mm-dd  * Initial version.
README.md view
@@ -71,6 +71,23 @@ (in our example, this type application is the only indication needed to tell the compiler to deserialize `Output` objects). +# Usage in a project++In a typical project, you will have fixed models and varying inputs.+That is, you would like to carry the models along with the code (e.g., a web+application or gRPC server using minizinc in the background) in a same+repository as your Haskell code. One option is to leverage the support of cabal+[data-files](https://www.haskell.org/cabal/users-guide/developing-packages.html#accessing-data-files-from-package-code).++You will still need some mapping functions to translate between domain objects+like `User` into the JSON values that MiniZinc requires: objects do not map+well with relations. We may consider compile-time helpers like TemplateHaskell,+but at this time it would not be immediately feasible. Be at peace with this.++For now, the implementation leverages file-system to pass the JSON object to+MiniZinc, this design means you should pay attention to disk usage and maybe+clean the clutter.+ # Misc.  The author of this package is not affiliated with MiniZinc.
minizinc-process.cabal view
@@ -4,7 +4,7 @@ -- http://haskell.org/cabal/users-guide/  name:                minizinc-process-version:             0.1.0.0+version:             0.1.1.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@@ -32,22 +32,13 @@     src   build-depends:       base >=4.13 && <4.14                      , aeson+                     , attoparsec                      , bytestring                      , containers                      , directory                      , hashable+                     , process                      , process-extras                      , stringsearch                      , text   default-language:    Haskell2010----executable minizinc-process-exe---  main-is:             Main.hs---  -- other-modules:---  -- other-extensions:---  build-depends:       base >=4.13 && <4.14---                     , minizinc-process-lib---                     , aeson---                     , hashable---                     , text---  -- hs-source-dirs:
src/Process/Minizinc.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveFunctor #-}  -- | A set of types and functions to help calling Minizinc as an external binary. --@@ -9,15 +11,23 @@ module Process.Minizinc   ( MiniZinc (..),     simpleMiniZinc,+    withArgs,     Solver (..),     SolverName,     MilliSeconds,     runLastMinizincJSON,+    SearchState(..),+    ResultHandler(..),+    runMinizincJSON,   ) where -import Control.Monad ((>=>))-import Data.Aeson (FromJSON, ToJSON, decode, encode)+import Control.Monad ((>=>), void)+import Control.Applicative ((<|>))+import Data.Attoparsec.ByteString (Parser, parse, IResult(..))+import Data.Attoparsec.Combinator (try)+import Data.Aeson (FromJSON, fromJSON, ToJSON, decode, encode, Value, Result(..))+import Data.Aeson.Parser.Internal (json') import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString import qualified Data.ByteString.Lazy as LByteString@@ -26,6 +36,8 @@ import Data.Hashable (Hashable, hash) import qualified Data.List as List import System.Process.ByteString (readProcessWithExitCode)+import System.Process (createProcess, proc, StdStream(CreatePipe), std_out)+import GHC.IO.Handle (Handle, hClose, hIsEOF)  -- | Type alias asking for milliseconds. type MilliSeconds a = Int@@ -66,6 +78,10 @@     (const solver)     (const []) +-- | Helper to set arguments.+withArgs :: [String] -> MiniZinc input answer -> MiniZinc input answer+withArgs args mzn = mzn { mkExtraArgs = const args }+ -- | Runs MiniZinc on the input and parses output for the last answer. -- -- The parser for now is primitive and all the parsing occurs after processing@@ -99,6 +115,90 @@              fullPath            ] +data SearchState a+  = Exhausted a+  | Incomplete a+  | Unsatisfiable+  | InternalError String+  deriving (Show, Eq, Ord, Functor)++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+reduce (Incomplete val) = case fromJSON val of+  Success obj -> Incomplete obj+  Error err -> InternalError err++data ResultHandler obj b+  = ResultHandler+  { handleNext :: b -> SearchState Value -> IO (b, Maybe (ResultHandler obj b))+  }++runMinizincJSON ::+  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+  (_, Just out, _, _) <- createProcess (proc "minizinc" args){ std_out = CreatePipe }+  vRet <- go out (parse oneResult) "" v0 resultHandler+  hClose out+  pure vRet+  where+    go :: Handle+       -> (ByteString -> IResult ByteString (SearchState Value))+       -> ByteString+       -> b+       -> ResultHandler answer b+       -> IO b+    go out parsebuf buf v1 handler+      | ByteString.null buf = do+           eof <- hIsEOF out+           if eof+           then+             inputFinished v1+           else do+             dat <- ByteString.hGetLine out+             go out parsebuf dat v1 handler+      | otherwise = 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 -> go out f "" v1 handler++    inputFinished = pure+    userFinished = pure+    finalizeFailure = pure++    fullPath :: FilePath+    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+           ]+ showSolver :: Solver -> String showSolver = \case   Chuffed -> "Chuffed"@@ -121,3 +221,24 @@     safehead xs = Just $ head xs     resultSeparator = "\n----------\n"     openCurlybrace = "{"+++-- | NOTE: the parser is fed with hGetLine (stripping EOL markers)+-- this assumption simplifies the grammar below+oneResult :: Parser (SearchState Value)+oneResult =+    try unsat+    <|> sat+  where+    unsat =  unsatMark *> pure Unsatisfiable++    sat = reverseAp <$> json' <*> searchstate+    reverseAp val constructor = constructor val++    searchstate =+      try (resultMark *> exhaustiveMark *> pure Exhausted)+      <|> try (resultMark *> pure Incomplete)++    resultMark = "----------"+    exhaustiveMark = "=========="+    unsatMark = "=====UNSATISFIABLE====="