diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,10 @@ ## Unreleased changes +## 0.1.4.0 -- 2020-11-12 + +* Add primitive TemplateHaskell generation of interface types. + ## 0.1.3.0 -- 2020-11-11 * Unify backing code when getting last result and streaming results (better RAM usage for long sequences). diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -80,16 +80,63 @@ # Usage in a project +## MiniZinc model files + 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). +## Serialization and DeSerialization + 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. + +A module named `Process.Minizinc.TH` has TemplateHaskell functions to +generate. As of today, you'll still need to activate some extensions and +import some libraries so that the TemplateHaskell-generated code compiles: as in the following example. + +```haskell +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE TemplateHaskell #-} + +import Data.Aeson +import Data.Hashable +import Process.Minizinc.TH +import GHC.Generics + +genModelData "MyModel" "models/mymodel.mzn" +``` + +```minizinc +int: x; +array[1..2] of int: y; +var int: z; + +... +``` + +Will generate the following haskell codes + +```haskell +data MyModelOutput = MyModelOutput { + z :: Int +} deriving (Show, Eq, Ord, Generic, Hashable, ToJSON, FromJSON) + +data MyModelInput = MyModelInput { + x :: Int, + y :: [[Int]] +} deriving (Show, Eq, Ord, Generic, Hashable, ToJSON, FromJSON) +``` + +See `examples/Main.hs` for an example usage of TemplateHaskell. + + +## Temporary data files 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 diff --git a/minizinc-process.cabal b/minizinc-process.cabal --- a/minizinc-process.cabal +++ b/minizinc-process.cabal @@ -4,7 +4,7 @@ -- http://haskell.org/cabal/users-guide/ name: minizinc-process -version: 0.1.3.0 +version: 0.1.4.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 @@ -28,6 +28,7 @@ exposed-modules: Process.Minizinc Process.Minizinc.Inspect + Process.Minizinc.TH hs-source-dirs: src build-depends: base >=4.8.2 && <4.14 @@ -40,6 +41,7 @@ , process >= 1.6.4.0 , process-extras >= 0.7.4 , text >= 1.2.3.0 + , template-haskell >= 2.15.0.0 default-language: Haskell2010 test-suite minizinc-process-tests-hedghehog @@ -56,3 +58,22 @@ test default-language: Haskell2010 +--executable minizinc-process-examples +-- main-is: Main.hs +-- other-modules: +-- Paths_minizinc_process +-- -- other-extensions: +-- build-depends: base >=4.13 && <4.14 +-- , aeson +-- , minizinc-process +-- , hashable +-- , text +-- hs-source-dirs: +-- examples +-- data-files: +-- models/example001.mzn +-- models/example002.mzn +-- models/example003.mzn +-- models/example003bis.mzn +-- models/example004.mzn +-- default-language: Haskell2010 diff --git a/src/Process/Minizinc/Inspect.hs b/src/Process/Minizinc/Inspect.hs --- a/src/Process/Minizinc/Inspect.hs +++ b/src/Process/Minizinc/Inspect.hs @@ -10,12 +10,15 @@ ) where +import Control.Applicative ((<|>)) import Data.Aeson import qualified Data.ByteString as ByteString import qualified Data.ByteString.Lazy as LByteString -import Data.Map (Map) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map import Data.Text (Text) import qualified Data.Text as Text +import qualified Data.List as List import System.Process.ByteString (readProcessWithExitCode) -- | Name of variables. @@ -28,7 +31,7 @@ _set :: Bool, _dim :: Maybe Int } - deriving (Show) + deriving (Eq, Ord, Show) instance FromJSON TypeInfo where parseJSON = withObject "TypeInfo" $ \v -> @@ -40,6 +43,28 @@ -- | Type declarations of the minizinc model. type TypeDeclarations = Map Name TypeInfo +haskellify :: TypeDeclarations -> Maybe Text +haskellify typedecls = + fmap Text.unlines $ sequence $ fmap property $ pairs + where + pairs :: [(Name, TypeInfo)] + pairs = List.sort $ Map.assocs typedecls + + property :: (Name, TypeInfo) -> Maybe Text + property (name, TypeInfo "int" False Nothing) = Just $ mconcat [ name, "::", "Int" ] + property (name, TypeInfo "float" False Nothing) = Just $ mconcat [ name, "::", "Float" ] + property (name, TypeInfo "bool" False Nothing) = Just $ mconcat [ name, "::", "Bool" ] + property (name, TypeInfo "int" False (Just n)) = Just $ mconcat [ name, "::", wrapAry n "Int" ] + property (name, TypeInfo "float" False (Just n)) = Just $ mconcat [ name, "::", wrapAry n "Float" ] + property (name, TypeInfo "bool" False (Just n)) = Just $ mconcat [ name, "::", wrapAry n "Bool" ] + property _ = Nothing + + wrapAry :: Int -> Text -> Text + wrapAry n str = + let lparens = Text.replicate n "[" + rparens = Text.replicate n "]" + in lparens <> str <> rparens + -- | Optimization method. data Method = Minimize | Maximize | Satisfy deriving (Show) @@ -65,7 +90,7 @@ parseJSON = withObject "Interface" $ \v -> Interface <$> v .: "method" - <*> v .: "has_output_item" + <*> (v .: "has_output_item" <|> v.: "has_outputItem") <*> v .: "input" <*> v .: "output" diff --git a/src/Process/Minizinc/TH.hs b/src/Process/Minizinc/TH.hs new file mode 100644 --- /dev/null +++ b/src/Process/Minizinc/TH.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +-- | Template Haskell splices to generate the model Input/Output +-- datatype with introspection. +module Process.Minizinc.TH where + +import Process.Minizinc.Inspect +import Language.Haskell.TH +import qualified Data.List as List +import qualified Data.Map.Strict as Map +import qualified Data.Text as Text + + +-- | Generates some Input and Ouput data types by inspecting a minizinc file. +-- Supported types are int, bools, float and their nested arrays. +genModelData :: String -> FilePath -> Q [Dec] +genModelData prefix path = do + miface <- runIO $ inspect path + iface <- case miface of + Nothing -> fail "no interface" + Just x -> pure x + sequence [ genFromTypeDecls prefix "Input" (_input iface) + , genFromTypeDecls prefix "Output" (_output iface) + ] + +genFromTypeDecls :: String -> String -> TypeDeclarations -> Q Dec +genFromTypeDecls prefix base typedecls = do + let dataname = prefix <> base + let pairs = List.sort $ Map.assocs typedecls + let derivations = [ DerivClause Nothing [ ConT (mkName "Show") + , ConT (mkName "Eq") + , ConT (mkName "Ord") + , ConT (mkName "Hashable") + , ConT (mkName "Generic") + , ConT (mkName "ToJSON") + , ConT (mkName "FromJSON") + ] + ] + let bang = Bang NoSourceUnpackedness NoSourceStrictness + pure $ DataD [] + (mkName dataname) + [] + Nothing + [RecC (mkName dataname) [ (mkName $ Text.unpack n, bang, typeFor typedecl) | (n,typedecl) <- pairs]] + derivations + where + typeFor (TypeInfo "int" False Nothing) = ConT (mkName "Int") + typeFor (TypeInfo "bool" False Nothing) = ConT (mkName "Bool") + typeFor (TypeInfo "float" False Nothing) = ConT (mkName "Float") + typeFor (TypeInfo "int" False (Just n)) = nestedlist n $ ConT (mkName "Int") + typeFor typedecl = error $ "unsupported type info when generating Haskell code from MiniZinc files: " <> show typedecl + + nestedlist 0 ty = ty + nestedlist n ty = AppT ListT (nestedlist (n-1) ty)