{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}

module Foreign.MathLink.Types ( 
                              -- * Data marshaling
                                Expressible(..)
                              , Dimensional(..)
                              , Expression(..)
                              -- * Execution
                              , ML(..)
                              , Config(..)
                              , Function(..)
                              , State(..)
                              , runML
                              -- * /MathLink/ internal types
                              , Link(..)
                              , Environment(..)
                              , Type(..)
                              , mkType
                              , Message(..)
                              , mkMessage
                              , Error(..)
                              , mkError
                              , Packet(..)
                              , mkPacket
                              ) where

import Foreign
import Foreign.C
import Data.Ix
import Data.Data
import Data.IntMap
import qualified Control.Monad.State as St
import qualified Control.Monad.Reader as Rd
import qualified Control.Monad.Error as Er
import Control.Monad.Trans


-- | Instances of 'Expressible' are precisely the data types that can
-- be marshaled to and from /Mathematica/.
class Expressible a where
    -- | Send a value to /Mathematica/.
    put :: a -> ML ()
    -- | Receive a value from /Mathematica/.
    get :: ML a

-- | Arrays to be marshaled to and from /Mathematica/ require indices
--   that are instances of 'Dimensional'.
class Ix ix => Dimensional ix where
    -- | The number of dimensions.
    --
    -- Shouldn't examine its argument.
    rank :: ix -> Int
    -- | The dimensions
    dimensions :: (ix,ix) -> [Int]
    -- | The array bounds implied by a list of dimensions
    --
    -- NB: a (very) partial function! Fails if the length of the
    -- given list is different from the result of 'rank'.
    fromDimensions :: [Int] -> (ix,ix)

-- | Represents a general /Mathematica/ expression.
data Expression = -- | An atomic value of integer type
                  ExInt Int
                  -- | An atomic value of floating point type
                | ExReal Double
                  -- | An atomic value of string type
                | ExString String
                  -- | An atomic value of symbol type
                | ExSymbol String
                  -- | A non-atomic value, with a head of type symbol
                  --   and a list of arguments
                | ExFunction String [Expression]
                  deriving (Eq,Ord,Read,Show,Data,Typeable)

-- | Encapsulates the read/write state associated with the 'ML' monad.
data State = State { abort :: Bool
                   , done :: Bool
                   }

-- | Encapsulates the readable state associated with the 'ML' monad.
data Config = Config { environment :: Environment
                     , link :: Link
                     , functionTable :: IntMap Function
                     }

-- | The monad in which functions exposed to /Mathematica/ execute.
newtype ML a = ML {
    runMLMonad :: Er.ErrorT String (St.StateT State (Rd.ReaderT Config IO)) a
  } deriving ( Monad
             , MonadIO
             , St.MonadState State
             , Rd.MonadReader Config
             , Er.MonadError String
             )

-- | Runs the given 'ML' computation with the given state and configuration.
runML :: ML a -> State -> Config -> IO (Either String a)
runML ac s c = Rd.runReaderT (St.evalStateT (Er.runErrorT (runMLMonad ac)) s) c

-- | Encapsulates a description of a function callable from /Mathematica/
data Function = 
    Function { -- | A string representing the /Mathematica/ pattern
               -- whose match should result in a function call to 
               -- the specified Haskell function. Analogous to the 
               -- @:Pattern:@ directive in an input to 
               -- /Mathematica/'s @mprep@ utility.
               callPattern :: String
               -- | A string representing the /Mathematica/ pattern
               -- for the argument that will be marshaled from
               -- /Mathematica/ to Haskell. Pattern variables
               -- appearing here are bound in the 'callPattern'
               -- match. Analogous to the @:Arguments:@ directive
               -- in an input to /Mathematica/'s @mprep@ utility.
             , argumentPattern :: String
               -- | The Haskell function to be invoked.
             , function :: ML ()
             }

instance Show Function where
    show fn = "Function { callPattern = " ++ 
              (show $ callPattern fn) ++ 
              ", argumentPattern = " ++
              (show $ argumentPattern fn) ++ " }"

-- | A wrapped pointer to the /MathLink/ link.
newtype Link = Link (Ptr ()) deriving (Eq)

-- | A wrapped pointer to the /MathLink/ environment.
newtype Environment = Environment (Ptr ()) deriving (Eq)

-- | An enumeration of some error codes defined in @mathlink.h@.
data Error = NoError
           | DeadLnkError
           | GetInconsistentError
           | GetOutOfSeqError
           | PutBadTokError
           | PutOutOfSeqError
           | PutTooBigError
           | MachineOverflowError
           | OutOfMemoryError
           | SocketUnacceptedError
           | UnconnectedError
           | PutEndPacketError
           | NextIncompleteCurrentPacketError
           | NextUnknownPacketError
           | GetEndPacketError
           | AbortError
           | ClosedError
           | InitError
           | ArgvError
           | ProtocolError
           | ModeError
           | LaunchError
           | RelaunchError
           | LaunchSpaceError
           | NoParentError
           | NameTakenError
           | NoListenError
           | BadNameError
           | BadHostError
           | LaunchFailedError
           | LaunchNameError
           | PutConvertError
           | GetConvertError
           | PutBadEncodingError
           | UnknownError Int
             deriving (Eq,Show)

instance Enum Error where
    fromEnum r = 
      case r of
        NoError                          -> 0
        DeadLnkError                     -> 1
        GetInconsistentError             -> 2
        GetOutOfSeqError                 -> 3
        PutBadTokError                   -> 4
        PutOutOfSeqError                 -> 5
        PutTooBigError                   -> 6
        MachineOverflowError             -> 7
        OutOfMemoryError                 -> 8
        SocketUnacceptedError            -> 9
        UnconnectedError                 -> 10
        PutEndPacketError                -> 21
        NextIncompleteCurrentPacketError -> 22
        NextUnknownPacketError           -> 23
        GetEndPacketError                -> 24
        AbortError                       -> 25
        ClosedError                      -> 11
        InitError                        -> 32
        ArgvError                        -> 33
        ProtocolError                    -> 34
        ModeError                        -> 35
        LaunchError                      -> 36
        RelaunchError                    -> 37
        LaunchSpaceError                 -> 38
        NoParentError                    -> 39
        NameTakenError                   -> 40
        NoListenError                    -> 41
        BadNameError                     -> 42
        BadHostError                     -> 43
        LaunchFailedError                -> 45
        LaunchNameError                  -> 46
        PutConvertError                  -> 48
        GetConvertError                  -> 49
        PutBadEncodingError              -> 47
        UnknownError i                   -> i

    toEnum i =
      case i of
        0  -> NoError                          
        1  -> DeadLnkError                     
        2  -> GetInconsistentError             
        3  -> GetOutOfSeqError                 
        4  -> PutBadTokError                   
        5  -> PutOutOfSeqError                 
        6  -> PutTooBigError                   
        7  -> MachineOverflowError             
        8  -> OutOfMemoryError                 
        9  -> SocketUnacceptedError            
        10 -> UnconnectedError                 
        21 -> PutEndPacketError                
        22 -> NextIncompleteCurrentPacketError 
        23 -> NextUnknownPacketError           
        24 -> GetEndPacketError                
        25 -> AbortError                       
        11 -> ClosedError                      
        32 -> InitError
        33 -> ArgvError
        34 -> ProtocolError
        35 -> ModeError
        36 -> LaunchError
        37 -> RelaunchError
        38 -> LaunchSpaceError
        39 -> NoParentError
        40 -> NameTakenError
        41 -> NoListenError
        42 -> BadNameError
        43 -> BadHostError
        45 -> LaunchFailedError
        46 -> LaunchNameError
        48 -> PutConvertError
        49 -> GetConvertError
        47 -> PutBadEncodingError
        i  -> UnknownError i

instance Ord Error where
    compare e1 e2 = compare (fromEnum e1) (fromEnum e2)

-- | Turns an 'Integral' into the corresponding 'Error'.
mkError :: Integral a => a -> Error
mkError = toEnum . fromIntegral

-- | An enumeration of /MathLink/ message types.
data Message = TerminateMessage
             | InterruptMessage
             | AbortMessage
             | EndPacketMessage
             | SynchronizeMessage
             | ImDyingMessage
             | WaitingAcknowledgementMessage
             | MarkTopLevelMessage
             | LinkClosingMessage
             | AuthenticateFailureMessage
             | UserMessage Int
             | UnknownMessage Int
               deriving (Eq,Show)

instance Enum Message where
    fromEnum m =
        case m of
          TerminateMessage              -> 1
          InterruptMessage              -> 2
          AbortMessage                  -> 3
          EndPacketMessage              -> 4
          SynchronizeMessage            -> 5
          ImDyingMessage                -> 6
          WaitingAcknowledgementMessage -> 7
          MarkTopLevelMessage           -> 8
          LinkClosingMessage            -> 9
          AuthenticateFailureMessage    -> 10
          UserMessage i                 -> i
          UnknownMessage i              -> i

    toEnum i =
        case i of
          i | i >= 128 && i <= 255 -> UserMessage i
          1                        -> TerminateMessage
          2                        -> InterruptMessage
          3                        -> AbortMessage
          4                        -> EndPacketMessage
          5                        -> SynchronizeMessage
          6                        -> ImDyingMessage
          7                        -> WaitingAcknowledgementMessage
          8                        -> MarkTopLevelMessage
          9                        -> LinkClosingMessage
          10                       -> AuthenticateFailureMessage
          i                        -> UnknownMessage i

instance Ord Message where
    compare m1 m2 = compare (fromEnum m1) (fromEnum m2)

firstUserMessage :: Message
firstUserMessage = UserMessage 128

lastUserMessage :: Message
lastUserMessage = UserMessage 255

mkMessage :: Integral a => a -> Message
mkMessage = toEnum . fromIntegral


-- | An enumeration of /MathLink/ packet types
data Packet = IllegalPacket
            | CallPacket
            | EvaluatePacket
            | ReturnPacket
            | InputNamePacket
            | EnterTextPacket
            | EnterExpressionPacket
            | OutputNamePacket
            | ReturnTextPacket
            | ReturnExpressionPacket
            | DisplayPacket
            | DisplayEndPacket
            | MessagePacket
            | TextPacket
            | InputPacket
            | InputStringPacket
            | MenuPacket
            | SyntaxPacket
            | SuspendPacket
            | ResumePacket
            | BeginDialogPacket
            | EndDialogPacket
            | UserPacket Int
            | UnknownPacket Int
              deriving (Eq,Show)

instance Enum Packet where
    fromEnum p =
        case p of
          IllegalPacket          -> 0
          CallPacket             -> 7
          EvaluatePacket         -> 13
          ReturnPacket           -> 3
          InputNamePacket        -> 8
          EnterTextPacket        -> 14
          EnterExpressionPacket  -> 15
          OutputNamePacket       -> 9
          ReturnTextPacket       -> 4
          ReturnExpressionPacket -> 16
          DisplayPacket          -> 11
          DisplayEndPacket       -> 12
          MessagePacket          -> 5
          TextPacket             -> 2
          InputPacket            -> 1
          InputStringPacket      -> 21
          MenuPacket             -> 6
          SyntaxPacket           -> 10
          SuspendPacket          -> 17
          ResumePacket           -> 18
          BeginDialogPacket      -> 19
          EndDialogPacket        -> 20
          UserPacket i           -> i
          UnknownPacket i        -> i

    toEnum i = 
        case i of
          0   -> IllegalPacket
          7   -> CallPacket
          13  -> EvaluatePacket
          3   -> ReturnPacket
          8   -> InputNamePacket
          14  -> EnterTextPacket
          15  -> EnterExpressionPacket
          9   -> OutputNamePacket
          4   -> ReturnTextPacket
          16  -> ReturnExpressionPacket
          11  -> DisplayPacket
          12  -> DisplayEndPacket
          5   -> MessagePacket
          2   -> TextPacket
          1   -> InputPacket
          21  -> InputStringPacket
          6   -> MenuPacket
          10  -> SyntaxPacket
          17  -> SuspendPacket
          18  -> ResumePacket
          19  -> BeginDialogPacket
          20  -> EndDialogPacket
          i | i >= 128 && i <= 255 -> UserPacket i
          i   -> UnknownPacket i

instance Ord Packet where
    compare p1 p2 = compare (fromEnum p1) (fromEnum p2)

firstUserPacket :: Packet
firstUserPacket = UserPacket 128

lastUserPacket :: Packet
lastUserPacket = UserPacket 255

mkPacket :: Integral a => a -> Packet
mkPacket = toEnum . fromIntegral

-- | An enumeriation of possible return values from the /MathLink/ functions @MLGetNext@ or @MLGetType@.
data Type = ErrorType
          | IntType
          | RealType
          | StringType
          | SymbolType
          | FunctionType
          | UnknownType Int
            deriving (Eq,Show)

instance Enum Type where
  fromEnum t = 
    case t of
      ErrorType     -> 0
      IntType       -> 43
      RealType      -> 42
      StringType    -> 34
      SymbolType    -> 35
      FunctionType  -> 70
      UnknownType i -> i

  toEnum i = 
    case i of
      0  -> ErrorType
      43 -> IntType
      42 -> RealType
      34 -> StringType
      35 -> SymbolType
      70 -> FunctionType
      73 -> IntType     -- old int type
      82 -> RealType    -- old real type
      83 -> StringType  -- old string type
      89 -> SymbolType  -- old symbol type
      i  -> UnknownType i

instance Ord Type where
  compare t1 t2 = compare (fromEnum t1) (fromEnum t2)

mkType :: Integral a => a -> Type
mkType = toEnum . fromIntegral