{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, DeriveGeneric #-}
-- | This module contains all types used to create an IPython language
-- kernel.
module IHaskell.IPython.Types (
  -- * IPython kernel profile
  Profile(..),
  Transport(..),
  Port(..),
  IP(..),

  -- * IPython messaging protocol
  Message(..),
  MessageHeader(..),
  Username(..),
  Metadata(..),
  MessageType(..),
  Width(..), Height(..),
  StreamType(..),
  ExecutionState(..),
  ExecuteReplyStatus(..),
  replyType,

  -- ** IPython display data message
  DisplayData(..),
  MimeType(..),
  extractPlain
                     
  ) where

import            Data.Aeson
import            Control.Applicative         ((<$>), (<*>))
import            Data.ByteString             (ByteString)
import qualified  Data.Text                   as Text
import qualified  Data.Text.Encoding          as Text
import            Data.Text                   (Text)
import            Data.Serialize
import            IHaskell.IPython.Message.UUID
import            GHC.Generics                (Generic)
import            Data.Typeable
import            Data.List                   (find)
import            Data.Map                    (Map)

-------------------- IPython Kernel Profile Types ----------------------
-- | A TCP port.
type Port = Int

-- | An IP address.
type IP = String

-- | The transport mechanism used to communicate with the IPython frontend.
data Transport
     = TCP                 -- ^ Default transport mechanism via TCP.
     deriving (Show, Read)

-- | A kernel profile, specifying how the kernel communicates.
data Profile = Profile {
  ip :: IP,               -- ^ The IP on which to listen.
  transport :: Transport, -- ^ The transport mechanism.
  stdinPort :: Port,      -- ^ The stdin channel port. 
  controlPort :: Port,    -- ^ The control channel port.
  hbPort :: Port,         -- ^ The heartbeat channel port.
  shellPort :: Port,      -- ^ The shell command port.
  iopubPort :: Port,      -- ^ The IOPub port.
  key :: Text             -- ^ The HMAC encryption key.
  } deriving (Show, Read)

-- Convert the kernel profile to and from JSON.
instance FromJSON Profile where
  parseJSON (Object v) = 
    Profile <$> v .: "ip"
            <*> v .: "transport"
            <*> v .: "stdin_port"
            <*> v .: "control_port"
            <*> v .: "hb_port"
            <*> v .: "shell_port"
            <*> v .: "iopub_port"
            <*> v .: "key"
  parseJSON _ = fail "Expecting JSON object."

instance ToJSON Profile where
  toJSON profile = object [
                    "ip"          .= ip profile,
                    "transport"   .= transport profile,
                    "stdin_port"  .= stdinPort profile,
                    "control_port".= controlPort profile,
                    "hb_port"     .= hbPort profile,
                    "shell_port"  .= shellPort profile,
                    "iopub_port"  .= iopubPort profile,
                    "key"         .= key profile
                   ]

instance FromJSON Transport where
  parseJSON (String mech) =
    case mech of
      "tcp" -> return TCP
      _ -> fail $ "Unknown transport mechanism " ++ Text.unpack mech
  parseJSON _ = fail "Expected JSON string as transport."

instance ToJSON Transport where
  toJSON TCP = String "tcp"


-------------------- IPython Message Types ----------------------

-- | A message header with some metadata.  
data MessageHeader = MessageHeader {
  identifiers :: [ByteString],         -- ^ The identifiers sent with the message.
  parentHeader :: Maybe MessageHeader, -- ^ The parent header, if present.
  metadata :: Metadata,                -- ^ A dict of metadata.
  messageId :: UUID,                   -- ^ A unique message UUID.
  sessionId :: UUID,                   -- ^ A unique session UUID.
  username :: Username,                -- ^ The user who sent this message.
  msgType :: MessageType               -- ^ The message type.
  } deriving (Show, Read)

-- Convert a message header into the JSON field for the header.
-- This field does not actually have all the record fields.
instance ToJSON MessageHeader where
  toJSON header = object [
                    "msg_id"  .= messageId header,
                    "session" .= sessionId header,
                    "username" .= username header,
                    "msg_type" .= showMessageType (msgType header)
                  ]

-- | A username for the source of a message.
type Username = Text

-- | A metadata dictionary.
type Metadata = Map Text Text

-- | The type of a message, corresponding to IPython message types.
data MessageType = KernelInfoReplyMessage
                 | KernelInfoRequestMessage
                 | ExecuteReplyMessage
                 | ExecuteRequestMessage
                 | StatusMessage
                 | StreamMessage
                 | DisplayDataMessage
                 | OutputMessage
                 | InputMessage
                 | CompleteRequestMessage
                 | CompleteReplyMessage
                 | ObjectInfoRequestMessage
                 | ObjectInfoReplyMessage
                 | ShutdownRequestMessage
                 | ShutdownReplyMessage
                 | ClearOutputMessage
                 | InputRequestMessage
                 | InputReplyMessage
                 | CommOpenMessage
                 | CommDataMessage
                 | CommCloseMessage
                 deriving (Show, Read, Eq)

showMessageType :: MessageType -> String
showMessageType KernelInfoReplyMessage     = "kernel_info_reply"
showMessageType KernelInfoRequestMessage   = "kernel_info_request"
showMessageType ExecuteReplyMessage        = "execute_reply"
showMessageType ExecuteRequestMessage      = "execute_request"
showMessageType StatusMessage              = "status"
showMessageType StreamMessage              = "stream"
showMessageType DisplayDataMessage         = "display_data"
showMessageType OutputMessage              = "pyout"
showMessageType InputMessage               = "pyin"
showMessageType CompleteRequestMessage     = "complete_request"
showMessageType CompleteReplyMessage       = "complete_reply"
showMessageType ObjectInfoRequestMessage   = "object_info_request"
showMessageType ObjectInfoReplyMessage     = "object_info_reply"
showMessageType ShutdownRequestMessage     = "shutdown_request"
showMessageType ShutdownReplyMessage       = "shutdown_reply"
showMessageType ClearOutputMessage         = "clear_output"
showMessageType InputRequestMessage        = "input_request"
showMessageType InputReplyMessage          = "input_reply"
showMessageType CommOpenMessage            = "comm_open"           
showMessageType CommDataMessage            = "comm_msg"            
showMessageType CommCloseMessage           = "comm_close"          

instance FromJSON MessageType where
  parseJSON (String s) = case s of
    "kernel_info_reply"   -> return KernelInfoReplyMessage
    "kernel_info_request" -> return KernelInfoRequestMessage
    "execute_reply"       -> return ExecuteReplyMessage
    "execute_request"     -> return ExecuteRequestMessage
    "status"              -> return StatusMessage
    "stream"              -> return StreamMessage
    "display_data"        -> return DisplayDataMessage
    "pyout"               -> return OutputMessage
    "pyin"                -> return InputMessage
    "complete_request"    -> return CompleteRequestMessage
    "complete_reply"      -> return CompleteReplyMessage
    "object_info_request" -> return ObjectInfoRequestMessage
    "object_info_reply"   -> return ObjectInfoReplyMessage
    "shutdown_request"    -> return ShutdownRequestMessage
    "shutdown_reply"      -> return ShutdownReplyMessage
    "clear_output"        -> return ClearOutputMessage
    "input_request"       -> return InputRequestMessage
    "input_reply"         -> return InputReplyMessage
    "comm_open"           -> return CommOpenMessage
    "comm_msg"            -> return CommDataMessage
    "comm_close"          -> return CommCloseMessage

    _                     -> fail ("Unknown message type: " ++ show s)
  parseJSON _ = fail "Must be a string."


-- | A message used to communicate with the IPython frontend.
data Message 
  -- | A request from a frontend for information about the kernel.
  = KernelInfoRequest { header :: MessageHeader }
  -- | A response to a KernelInfoRequest.
  | KernelInfoReply { 
      header :: MessageHeader,
      versionList :: [Int],     -- ^ The version of the language, e.g. [7, 6, 3] for GHC 7.6.3
      language :: String        -- ^ The language name, e.g. "haskell"
     }
               
  -- | A request from a frontend to execute some code.
  | ExecuteRequest {
      header :: MessageHeader,
      getCode :: Text,             -- ^ The code string.
      getSilent :: Bool,                 -- ^ Whether this should be silently executed.
      getStoreHistory :: Bool,           -- ^ Whether to store this in history.
      getAllowStdin :: Bool,             -- ^ Whether this code can use stdin.

      getUserVariables :: [Text],  -- ^ Unused.
      getUserExpressions :: [Text] -- ^ Unused.
    }

  -- | A reply to an execute request.
  | ExecuteReply {
      header :: MessageHeader,
      status :: ExecuteReplyStatus,         -- ^ The status of the output.
      pagerOutput :: String,                -- ^ The help string to show in the pager.
      executionCounter :: Int               -- ^ The execution count, i.e. which output this is.
    }

  | PublishStatus {
      header :: MessageHeader,
      executionState :: ExecutionState      -- ^ The execution state of the kernel.
    }

  | PublishStream {
      header :: MessageHeader,
      streamType :: StreamType,             -- ^ Which stream to publish to.
      streamContent :: String               -- ^ What to publish.
    }

  | PublishDisplayData {
      header :: MessageHeader,
      source :: String,                     -- ^ The name of the data source.
      displayData :: [DisplayData]          -- ^ A list of data representations.
    }

  | PublishOutput {
      header :: MessageHeader,
      reprText :: String,                   -- ^ Printed output text.
      executionCount :: Int                 -- ^ Which output this is for.
    }

  | PublishInput {
      header :: MessageHeader,
      inCode :: String,                     -- ^ Submitted input code.
      executionCount :: Int                 -- ^ Which input this is.
    }

  | CompleteRequest {
      header :: MessageHeader,
      getCode :: Text, {- ^
            The entire block of text where the line is.  This may be useful in the
            case of multiline completions where more context may be needed.  Note: if
            in practice this field proves unnecessary, remove it to lighten the
            messages. json field @block@  -}
      getCodeLine :: Text, -- ^ just the line with the cursor. json field @line@
      getCursorPos :: Int -- ^ position of the cursor (index into the line?). json field @cursor_pos@

    }

  | CompleteReply {
     header :: MessageHeader,
     completionMatches :: [Text],
     completionMatchedText :: Text,
     completionText :: Text,
     completionStatus :: Bool
  }

  | ObjectInfoRequest {
      header :: MessageHeader, 
      objectName :: Text,  -- ^ Name of object being searched for.
      detailLevel :: Int         -- ^ Level of detail desired (defaults to 0).
                                -- 0 is equivalent to foo?, 1 is equivalent
                                -- to foo??.
    }

  | ObjectInfoReply {
      header :: MessageHeader, 
      objectName :: Text,          -- ^ Name of object which was searched for.
      objectFound :: Bool,         -- ^ Whether the object was found.
      objectTypeString :: Text,    -- ^ Object type.
      objectDocString  :: Text 
    }

  | ShutdownRequest {
      header :: MessageHeader,
      restartPending :: Bool    -- ^ Whether this shutdown precedes a restart.
    }
  | ShutdownReply {
      header :: MessageHeader,
      restartPending :: Bool    -- ^ Whether this shutdown precedes a restart.
    }

  | ClearOutput {
      header :: MessageHeader,
      wait :: Bool -- ^ Whether to wait to redraw until there is more output.
  }

  | RequestInput {
      header :: MessageHeader,
      inputPrompt :: String      
  }

  | InputReply {
      header :: MessageHeader,
      inputValue :: String      
  }

  | CommOpen {
      header :: MessageHeader,
      commTargetName :: String,
      commUuid :: UUID,
      commData :: Value
  }

  | CommData {
      header :: MessageHeader,
      commUuid :: UUID,
      commData :: Value
  }

  | CommClose {
      header :: MessageHeader,
      commUuid :: UUID,
      commData :: Value
  }

  | SendNothing -- Dummy message; nothing is sent.
    deriving Show

-- | Possible statuses in the execution reply messages.
data ExecuteReplyStatus = Ok | Err | Abort

instance Show ExecuteReplyStatus where
  show Ok = "ok"
  show Err = "error"
  show Abort = "abort"

-- | The execution state of the kernel.
data ExecutionState = Busy | Idle | Starting deriving Show

-- | Input and output streams.
data StreamType = Stdin | Stdout deriving Show

-- | Get the reply message type for a request message type.
replyType :: MessageType -> Maybe MessageType
replyType KernelInfoRequestMessage  = Just KernelInfoReplyMessage
replyType ExecuteRequestMessage     = Just ExecuteReplyMessage
replyType CompleteRequestMessage    = Just CompleteReplyMessage
replyType ObjectInfoRequestMessage  = Just ObjectInfoReplyMessage
replyType ShutdownRequestMessage    = Just ShutdownReplyMessage
replyType _ = Nothing

-- | Data for display: a string with associated MIME type.
data DisplayData = DisplayData MimeType Text deriving (Typeable, Generic)

-- We can't print the actual data, otherwise this will be printed every
-- time it gets computed because of the way the evaluator is structured.
-- See how `displayExpr` is computed.
instance Show DisplayData where
  show _ = "DisplayData"

-- Allow DisplayData serialization
instance Serialize Text where
    put str = put (Text.encodeUtf8 str)
    get = Text.decodeUtf8 <$> get
instance Serialize DisplayData
instance Serialize MimeType

-- | Possible MIME types for the display data.
type Width = Int
type Height = Int
data MimeType = PlainText
              | MimeHtml
              | MimePng Width Height
              | MimeJpg Width Height
              | MimeSvg
              | MimeLatex
              | MimeJavascript
              deriving (Eq, Typeable, Generic)

-- Extract the plain text from a list of displays.
extractPlain :: [DisplayData] -> String
extractPlain disps =
  case find isPlain disps of
    Nothing -> ""
    Just (DisplayData PlainText bytestr) -> Text.unpack bytestr
  where
    isPlain (DisplayData mime _) = mime == PlainText

instance Show MimeType where
  show PlainText = "text/plain"
  show MimeHtml  = "text/html"
  show (MimePng _ _)   = "image/png" 
  show (MimeJpg _ _)   = "image/jpeg"
  show MimeSvg   = "image/svg+xml"
  show MimeLatex = "text/latex"
  show MimeJavascript = "application/javascript"