{-# LANGUAGE OverloadedStrings #-}

-- | Provides primitives for inspecting the interface of a model.
module Process.Minizinc.Inspect
  ( inspect,
    TypeInfo (..),
    TypeDeclarations,
    Method (..),
    Interface (..),
  )
where

import Data.Aeson
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as LByteString
import Data.Map (Map)
import Data.Text (Text)
import qualified Data.Text as Text
import System.Process.ByteString (readProcessWithExitCode)

-- | Name of variables.
type Name = Text

-- | Information regarding one name.
data TypeInfo
  = TypeInfo
      { TypeInfo -> Text
_type :: Text,
        TypeInfo -> Bool
_set :: Bool,
        TypeInfo -> Maybe Int
_dim :: Maybe Int
      }
  deriving (Int -> TypeInfo -> ShowS
[TypeInfo] -> ShowS
TypeInfo -> String
(Int -> TypeInfo -> ShowS)
-> (TypeInfo -> String) -> ([TypeInfo] -> ShowS) -> Show TypeInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeInfo] -> ShowS
$cshowList :: [TypeInfo] -> ShowS
show :: TypeInfo -> String
$cshow :: TypeInfo -> String
showsPrec :: Int -> TypeInfo -> ShowS
$cshowsPrec :: Int -> TypeInfo -> ShowS
Show)

instance FromJSON TypeInfo where
  parseJSON :: Value -> Parser TypeInfo
parseJSON = String -> (Object -> Parser TypeInfo) -> Value -> Parser TypeInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "TypeInfo" ((Object -> Parser TypeInfo) -> Value -> Parser TypeInfo)
-> (Object -> Parser TypeInfo) -> Value -> Parser TypeInfo
forall a b. (a -> b) -> a -> b
$ \v :: Object
v ->
    Text -> Bool -> Maybe Int -> TypeInfo
TypeInfo
      (Text -> Bool -> Maybe Int -> TypeInfo)
-> Parser Text -> Parser (Bool -> Maybe Int -> TypeInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "type"
      Parser (Bool -> Maybe Int -> TypeInfo)
-> Parser Bool -> Parser (Maybe Int -> TypeInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "set" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
      Parser (Maybe Int -> TypeInfo)
-> Parser (Maybe Int) -> Parser TypeInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "dim"

-- | Type declarations of the minizinc model.
type TypeDeclarations = Map Name TypeInfo

-- | Optimization method.
data Method = Minimize | Maximize | Satisfy
  deriving (Int -> Method -> ShowS
[Method] -> ShowS
Method -> String
(Int -> Method -> ShowS)
-> (Method -> String) -> ([Method] -> ShowS) -> Show Method
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Method] -> ShowS
$cshowList :: [Method] -> ShowS
show :: Method -> String
$cshow :: Method -> String
showsPrec :: Int -> Method -> ShowS
$cshowsPrec :: Int -> Method -> ShowS
Show)

instance FromJSON Method where
  parseJSON :: Value -> Parser Method
parseJSON = String -> (Text -> Parser Method) -> Value -> Parser Method
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "Method" ((Text -> Parser Method) -> Value -> Parser Method)
-> (Text -> Parser Method) -> Value -> Parser Method
forall a b. (a -> b) -> a -> b
$ \s :: Text
s -> case Text
s of
    "max" -> Method -> Parser Method
forall (f :: * -> *) a. Applicative f => a -> f a
pure Method
Maximize
    "min" -> Method -> Parser Method
forall (f :: * -> *) a. Applicative f => a -> f a
pure Method
Minimize
    "sat" -> Method -> Parser Method
forall (f :: * -> *) a. Applicative f => a -> f a
pure Method
Satisfy
    v :: Text
v -> String -> Parser Method
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Method) -> String -> Parser Method
forall a b. (a -> b) -> a -> b
$ "unsupported method: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
v

-- | A description of the model input/output.
data Interface
  = Interface
      { Interface -> Method
_method :: Method,
        Interface -> Bool
_has_output_item :: Bool,
        Interface -> TypeDeclarations
_input :: TypeDeclarations,
        Interface -> TypeDeclarations
_output :: TypeDeclarations
      }
  deriving (Int -> Interface -> ShowS
[Interface] -> ShowS
Interface -> String
(Int -> Interface -> ShowS)
-> (Interface -> String)
-> ([Interface] -> ShowS)
-> Show Interface
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Interface] -> ShowS
$cshowList :: [Interface] -> ShowS
show :: Interface -> String
$cshow :: Interface -> String
showsPrec :: Int -> Interface -> ShowS
$cshowsPrec :: Int -> Interface -> ShowS
Show)

instance FromJSON Interface where
  parseJSON :: Value -> Parser Interface
parseJSON = String -> (Object -> Parser Interface) -> Value -> Parser Interface
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "Interface" ((Object -> Parser Interface) -> Value -> Parser Interface)
-> (Object -> Parser Interface) -> Value -> Parser Interface
forall a b. (a -> b) -> a -> b
$ \v :: Object
v ->
    Method -> Bool -> TypeDeclarations -> TypeDeclarations -> Interface
Interface
      (Method
 -> Bool -> TypeDeclarations -> TypeDeclarations -> Interface)
-> Parser Method
-> Parser
     (Bool -> TypeDeclarations -> TypeDeclarations -> Interface)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Method
forall a. FromJSON a => Object -> Text -> Parser a
.: "method"
      Parser (Bool -> TypeDeclarations -> TypeDeclarations -> Interface)
-> Parser Bool
-> Parser (TypeDeclarations -> TypeDeclarations -> Interface)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "has_output_item"
      Parser (TypeDeclarations -> TypeDeclarations -> Interface)
-> Parser TypeDeclarations
-> Parser (TypeDeclarations -> Interface)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser TypeDeclarations
forall a. FromJSON a => Object -> Text -> Parser a
.: "input"
      Parser (TypeDeclarations -> Interface)
-> Parser TypeDeclarations -> Parser Interface
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser TypeDeclarations
forall a. FromJSON a => Object -> Text -> Parser a
.: "output"

-- | Calls the minizinc binary to output the model interface.
inspect :: FilePath -> IO (Maybe Interface)
inspect :: String -> IO (Maybe Interface)
inspect path :: String
path = do
  (_, out :: ByteString
out, err :: ByteString
err) <- String
-> [String] -> ByteString -> IO (ExitCode, ByteString, ByteString)
readProcessWithExitCode "minizinc" [String]
args ""
  Int -> IO (Maybe Interface) -> IO (Maybe Interface)
forall a b. a -> b -> b
seq (ByteString -> Int
ByteString.length ByteString
err) (IO (Maybe Interface) -> IO (Maybe Interface))
-> IO (Maybe Interface) -> IO (Maybe Interface)
forall a b. (a -> b) -> a -> b
$ Maybe Interface -> IO (Maybe Interface)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Interface -> IO (Maybe Interface))
-> Maybe Interface -> IO (Maybe Interface)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Interface
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe Interface) -> ByteString -> Maybe Interface
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LByteString.fromStrict ByteString
out
  where
    args :: [String]
args = ["-c", "--model-interface-only", String
path]