{-# LANGUAGE OverloadedStrings, CPP #-}

-- | Description : Easy IPython kernels = Overview This module provides automation for writing
-- simple IPython kernels. In particular, it provides a record type that defines configurations and
-- a function that interprets a configuration as an action in some monad that can do IO.
--
-- The configuration consists primarily of functions that implement the various features of a
-- kernel, such as running code, looking up documentation, and performing completion. An example for
-- a simple language that nevertheless has side effects, global state, and timing effects is
-- included in the examples directory.
--
-- = Kernel Specs
--
-- To run your kernel, you will need to install the kernelspec into the Jupyter namespace. If your
-- kernel name is `kernel`, you will need to run the command:
--
-- > kernel install
--
-- This will inform Jupyter of the kernel so that it may be used.
--
-- == Further profile improvements Consult the IPython documentation along with the generated
-- profile source code for further configuration of the frontend, including syntax highlighting,
-- logos, help text, and so forth.
module IHaskell.IPython.EasyKernel (easyKernel, installKernelspec, KernelConfig(..)) where

import           Data.Aeson (decode, encode, toJSON)

import qualified Data.ByteString.Lazy as BL

import           System.IO.Temp (withTempDirectory)
import           System.Process (rawSystem)

import           Control.Concurrent (MVar, readChan, writeChan, newMVar, readMVar, modifyMVar_)
import           Control.Monad.IO.Class (MonadIO(..))
import           Control.Monad (forever, when, void)

import qualified Data.Map as Map
import           Data.Maybe (fromMaybe)
import qualified Data.Text as T

import           IHaskell.IPython.Kernel
import           IHaskell.IPython.Message.UUID as UUID

import           System.Directory (createDirectoryIfMissing, getTemporaryDirectory)
import           System.FilePath ((</>))
import           System.Exit (exitSuccess)
import           System.IO (openFile, IOMode(ReadMode))

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap as KeyMap
#else
import qualified Data.HashMap.Strict as HashMap
#endif

-- | The kernel configuration specifies the behavior that is specific to your language. The type
-- parameters provide the monad in which your kernel will run, the type of intermediate outputs from
-- running cells, and the type of final results of cells, respectively.
data KernelConfig m output result =
       KernelConfig
         {
         -- | Info on the language of the kernel.
         forall (m :: * -> *) output result.
KernelConfig m output result -> LanguageInfo
kernelLanguageInfo :: LanguageInfo
         -- | Write all the files into the kernel directory, including `kernel.js`, `logo-64x64.svg`, and any
         -- other required files. The directory to write to will be passed to this function, and the return
         -- value should be the kernelspec to be written to `kernel.json`.
         , forall (m :: * -> *) output result.
KernelConfig m output result -> FilePath -> IO KernelSpec
writeKernelspec :: FilePath -> IO KernelSpec
         -- | How to render intermediate output
         , forall (m :: * -> *) output result.
KernelConfig m output result -> output -> [DisplayData]
displayOutput :: output -> [DisplayData]
         -- | How to render final cell results
         , forall (m :: * -> *) output result.
KernelConfig m output result -> result -> [DisplayData]
displayResult :: result -> [DisplayData]
         -- | Perform completion. The returned tuple consists of the matched text and completions. The
         -- arguments are the code in the cell and the position of the cursor in the cell.
         , forall (m :: * -> *) output result.
KernelConfig m output result -> Text -> Int -> m (Text, [Text])
completion :: T.Text -> Int -> m (T.Text, [T.Text])
         -- | Return the information or documentation for its argument, described by the cell contents and
         -- cursor position. The returned value is simply the data to display.
         , forall (m :: * -> *) output result.
KernelConfig m output result
-> Text -> Int -> m (Maybe [DisplayData])
inspectInfo :: T.Text -> Int -> m (Maybe [DisplayData])
         -- | Execute a cell. The arguments are the contents of the cell, an IO action that will clear the
         -- current intermediate output, and an IO action that will add a new item to the intermediate
         -- output. The result consists of the actual result, the status to be sent to IPython, and the
         -- contents of the pager. Return the empty string to indicate that there is no pager output. Errors
         -- should be handled by defining an appropriate error constructor in your result type.
         , forall (m :: * -> *) output result.
KernelConfig m output result
-> Text
-> IO ()
-> (output -> IO ())
-> m (result, ExecuteReplyStatus, FilePath)
run :: T.Text -> IO () -> (output -> IO ()) -> m (result, ExecuteReplyStatus, String)
         , forall (m :: * -> *) output result.
KernelConfig m output result -> Bool
debug :: Bool -- ^ Whether to print extra debugging information to
         -- | A One-line description of the kernel
         , forall (m :: * -> *) output result.
KernelConfig m output result -> FilePath
kernelBanner :: String
         -- | The version of the messaging specification used by the kernel
         , forall (m :: * -> *) output result.
KernelConfig m output result -> FilePath
kernelProtocolVersion :: String
         -- | Name of the kernel implementation
         , forall (m :: * -> *) output result.
KernelConfig m output result -> FilePath
kernelImplName :: String
         -- | Version of the kernel implementation
         , forall (m :: * -> *) output result.
KernelConfig m output result -> FilePath
kernelImplVersion :: String
         }

-- Install the kernelspec, using the `writeKernelspec` field of the kernel configuration.
installKernelspec :: MonadIO m
                  => KernelConfig m output result -- ^ Kernel configuration to install
                  -> Bool                         -- ^ Whether to use Jupyter `--replace`
                  -> Maybe FilePath               -- ^ (Optional) prefix to install into for Jupyter `--prefix`
                  -> m ()
installKernelspec :: forall (m :: * -> *) output result.
MonadIO m =>
KernelConfig m output result -> Bool -> Maybe FilePath -> m ()
installKernelspec KernelConfig m output result
config Bool
replace Maybe FilePath
installPrefixMay =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall {b}. (FilePath -> IO b) -> IO b
withTmpDir forall a b. (a -> b) -> a -> b
$ \FilePath
tmp -> do
    let kernelDir :: FilePath
kernelDir = FilePath
tmp FilePath -> FilePath -> FilePath
</> LanguageInfo -> FilePath
languageName (forall (m :: * -> *) output result.
KernelConfig m output result -> LanguageInfo
kernelLanguageInfo KernelConfig m output result
config)
    Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
kernelDir
    KernelSpec
kernelSpec <- forall (m :: * -> *) output result.
KernelConfig m output result -> FilePath -> IO KernelSpec
writeKernelspec KernelConfig m output result
config FilePath
kernelDir

    let filename :: FilePath
filename = FilePath
kernelDir FilePath -> FilePath -> FilePath
</> FilePath
"kernel.json"
    FilePath -> ByteString -> IO ()
BL.writeFile FilePath
filename forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON KernelSpec
kernelSpec

    let replaceFlag :: [FilePath]
replaceFlag = [FilePath
"--replace" | Bool
replace]
        installPrefixFlag :: [FilePath]
installPrefixFlag = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [FilePath
"--user"] (\FilePath
prefix -> [FilePath
"--prefix", FilePath
prefix]) Maybe FilePath
installPrefixMay
        cmd :: [FilePath]
cmd = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath
"kernelspec", FilePath
"install"], [FilePath]
installPrefixFlag, [FilePath
kernelDir], [FilePath]
replaceFlag]
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> IO ExitCode
rawSystem FilePath
"ipython" [FilePath]
cmd
  where
    withTmpDir :: (FilePath -> IO b) -> IO b
withTmpDir FilePath -> IO b
act = do
      FilePath
tmp <- IO FilePath
getTemporaryDirectory
      forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
FilePath -> FilePath -> (FilePath -> m a) -> m a
withTempDirectory FilePath
tmp FilePath
"easyKernel" FilePath -> IO b
act

getProfile :: FilePath -> IO Profile
getProfile :: FilePath -> IO Profile
getProfile FilePath
fn = do
  ByteString
profData <- FilePath -> IOMode -> IO Handle
openFile FilePath
fn IOMode
ReadMode forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> IO ByteString
BL.hGetContents
  case forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
profData of
    Just Profile
prof -> forall (m :: * -> *) a. Monad m => a -> m a
return Profile
prof
    Maybe Profile
Nothing   -> forall a. HasCallStack => FilePath -> a
error FilePath
"Invalid profile data"

createReplyHeader :: MonadIO m => MessageHeader -> m MessageHeader
createReplyHeader :: forall (m :: * -> *). MonadIO m => MessageHeader -> m MessageHeader
createReplyHeader MessageHeader
parent = do
  -- Generate a new message UUID.
  UUID
newMessageId <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
UUID.random
  let repType :: MessageType
repType = forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err (MessageType -> Maybe MessageType
replyType forall a b. (a -> b) -> a -> b
$ MessageHeader -> MessageType
mhMsgType MessageHeader
parent)
      err :: a
err = forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"No reply for message " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show (MessageHeader -> MessageType
mhMsgType MessageHeader
parent)

#if MIN_VERSION_aeson(2,0,0)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ByteString]
-> Maybe MessageHeader
-> Metadata
-> UUID
-> UUID
-> Text
-> MessageType
-> [ByteString]
-> MessageHeader
MessageHeader (MessageHeader -> [ByteString]
mhIdentifiers MessageHeader
parent) (forall a. a -> Maybe a
Just MessageHeader
parent) (Object -> Metadata
Metadata (forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList []))
            UUID
newMessageId (MessageHeader -> UUID
mhSessionId MessageHeader
parent) (MessageHeader -> Text
mhUsername MessageHeader
parent) MessageType
repType []
#else
  return $ MessageHeader (mhIdentifiers parent) (Just parent) (Metadata (HashMap.fromList []))
            newMessageId (mhSessionId parent) (mhUsername parent) repType []
#endif


-- | Execute an IPython kernel for a config. Your 'main' action should call this as the last thing
-- it does.
easyKernel :: MonadIO m
           => FilePath -- ^ The connection file provided by the IPython frontend
           -> KernelConfig m output result -- ^ The kernel configuration specifying how to react to
                                           -- messages
           -> m ()
easyKernel :: forall (m :: * -> *) output result.
MonadIO m =>
FilePath -> KernelConfig m output result -> m ()
easyKernel FilePath
profileFile KernelConfig m output result
config = do
  Profile
prof <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Profile
getProfile FilePath
profileFile
  ZeroMQInterface
zmq <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Profile -> Bool -> IO ZeroMQInterface
serveProfile Profile
prof Bool
False
  MVar Integer
execCount <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (MVar a)
newMVar Integer
0
  forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
    Message
req <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Chan a -> IO a
readChan (ZeroMQInterface -> Chan Message
shellRequestChannel ZeroMQInterface
zmq)
    MessageHeader
repHeader <- forall (m :: * -> *). MonadIO m => MessageHeader -> m MessageHeader
createReplyHeader (Message -> MessageHeader
header Message
req)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (m :: * -> *) output result.
KernelConfig m output result -> Bool
debug KernelConfig m output result
config) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> IO ()
print Message
req
    Message
reply <- forall (m :: * -> *) output result.
MonadIO m =>
KernelConfig m output result
-> MVar Integer
-> ZeroMQInterface
-> Message
-> MessageHeader
-> m Message
replyTo KernelConfig m output result
config MVar Integer
execCount ZeroMQInterface
zmq Message
req MessageHeader
repHeader
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Chan a -> a -> IO ()
writeChan (ZeroMQInterface -> Chan Message
shellReplyChannel ZeroMQInterface
zmq) Message
reply

replyTo :: MonadIO m
        => KernelConfig m output result
        -> MVar Integer
        -> ZeroMQInterface
        -> Message
        -> MessageHeader
        -> m Message
replyTo :: forall (m :: * -> *) output result.
MonadIO m =>
KernelConfig m output result
-> MVar Integer
-> ZeroMQInterface
-> Message
-> MessageHeader
-> m Message
replyTo KernelConfig m output result
config MVar Integer
_ ZeroMQInterface
interface KernelInfoRequest{} MessageHeader
replyHeader = do
  let send :: Message -> IO ()
send = forall a. Chan a -> a -> IO ()
writeChan (ZeroMQInterface -> Chan Message
iopubChannel ZeroMQInterface
interface)

  MessageHeader
idleHeader <- forall (m :: * -> *).
MonadIO m =>
MessageHeader -> MessageType -> m MessageHeader
dupHeader MessageHeader
replyHeader MessageType
StatusMessage
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> IO ()
send forall a b. (a -> b) -> a -> b
$ MessageHeader -> ExecutionState -> Message
PublishStatus MessageHeader
idleHeader ExecutionState
Idle

  forall (m :: * -> *) a. Monad m => a -> m a
return
    KernelInfoReply
      { header :: MessageHeader
header = MessageHeader
replyHeader
      , languageInfo :: LanguageInfo
languageInfo = forall (m :: * -> *) output result.
KernelConfig m output result -> LanguageInfo
kernelLanguageInfo KernelConfig m output result
config
      , implementation :: FilePath
implementation = forall (m :: * -> *) output result.
KernelConfig m output result -> FilePath
kernelImplName KernelConfig m output result
config
      , implementationVersion :: FilePath
implementationVersion = forall (m :: * -> *) output result.
KernelConfig m output result -> FilePath
kernelImplVersion KernelConfig m output result
config
      , banner :: FilePath
banner = forall (m :: * -> *) output result.
KernelConfig m output result -> FilePath
kernelBanner KernelConfig m output result
config
      , protocolVersion :: FilePath
protocolVersion = forall (m :: * -> *) output result.
KernelConfig m output result -> FilePath
kernelProtocolVersion KernelConfig m output result
config
      , status :: ExecuteReplyStatus
status = ExecuteReplyStatus
Ok
      }

replyTo KernelConfig m output result
_ MVar Integer
_ ZeroMQInterface
_ CommInfoRequest{} MessageHeader
replyHeader =
  forall (m :: * -> *) a. Monad m => a -> m a
return
    CommInfoReply
      { header :: MessageHeader
header = MessageHeader
replyHeader
      , commInfo :: Map FilePath FilePath
commInfo = forall k a. Map k a
Map.empty }

replyTo KernelConfig m output result
_ MVar Integer
_ ZeroMQInterface
interface ShutdownRequest { restartPending :: Message -> Bool
restartPending = Bool
pending } MessageHeader
replyHeader = do
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Chan a -> a -> IO ()
writeChan (ZeroMQInterface -> Chan Message
shellReplyChannel ZeroMQInterface
interface) forall a b. (a -> b) -> a -> b
$ MessageHeader -> Bool -> Message
ShutdownReply MessageHeader
replyHeader Bool
pending
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO a
exitSuccess

replyTo KernelConfig m output result
config MVar Integer
execCount ZeroMQInterface
interface req :: Message
req@ExecuteRequest{} MessageHeader
replyHeader = do
  let send :: Message -> IO ()
send = forall a. Chan a -> a -> IO ()
writeChan (ZeroMQInterface -> Chan Message
iopubChannel ZeroMQInterface
interface)

  MessageHeader
busyHeader <- forall (m :: * -> *).
MonadIO m =>
MessageHeader -> MessageType -> m MessageHeader
dupHeader MessageHeader
replyHeader MessageType
StatusMessage
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> IO ()
send forall a b. (a -> b) -> a -> b
$ MessageHeader -> ExecutionState -> Message
PublishStatus MessageHeader
busyHeader ExecutionState
Busy

  MessageHeader
outputHeader <- forall (m :: * -> *).
MonadIO m =>
MessageHeader -> MessageType -> m MessageHeader
dupHeader MessageHeader
replyHeader MessageType
DisplayDataMessage
  (result
res, ExecuteReplyStatus
replyStatus, FilePath
pagerOut) <- let clearOutput :: IO ()
clearOutput = do
                                                      MessageHeader
clearHeader <- forall (m :: * -> *).
MonadIO m =>
MessageHeader -> MessageType -> m MessageHeader
dupHeader MessageHeader
replyHeader
                                                                       MessageType
ClearOutputMessage
                                                      Message -> IO ()
send forall a b. (a -> b) -> a -> b
$ MessageHeader -> Bool -> Message
ClearOutput MessageHeader
clearHeader Bool
False
                                      sendOutput :: output -> IO ()
sendOutput output
x =
                                                      Message -> IO ()
send forall a b. (a -> b) -> a -> b
$ MessageHeader -> [DisplayData] -> Maybe Transient -> Message
PublishDisplayData
                                                               MessageHeader
outputHeader
                                                               (forall (m :: * -> *) output result.
KernelConfig m output result -> output -> [DisplayData]
displayOutput KernelConfig m output result
config output
x)
                                                               forall a. Maybe a
Nothing
                                  in forall (m :: * -> *) output result.
KernelConfig m output result
-> Text
-> IO ()
-> (output -> IO ())
-> m (result, ExecuteReplyStatus, FilePath)
run KernelConfig m output result
config (Message -> Text
getCode Message
req) IO ()
clearOutput output -> IO ()
sendOutput
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> IO ()
send forall a b. (a -> b) -> a -> b
$ MessageHeader -> [DisplayData] -> Maybe Transient -> Message
PublishDisplayData MessageHeader
outputHeader (forall (m :: * -> *) output result.
KernelConfig m output result -> result -> [DisplayData]
displayResult KernelConfig m output result
config result
res) forall a. Maybe a
Nothing


  MessageHeader
idleHeader <- forall (m :: * -> *).
MonadIO m =>
MessageHeader -> MessageType -> m MessageHeader
dupHeader MessageHeader
replyHeader MessageType
StatusMessage
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> IO ()
send forall a b. (a -> b) -> a -> b
$ MessageHeader -> ExecutionState -> Message
PublishStatus MessageHeader
idleHeader ExecutionState
Idle

  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar Integer
execCount (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+ Integer
1))
  Integer
counter <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
readMVar MVar Integer
execCount

  forall (m :: * -> *) a. Monad m => a -> m a
return
    ExecuteReply
      { header :: MessageHeader
header = MessageHeader
replyHeader
      , pagerOutput :: [DisplayData]
pagerOutput = [MimeType -> Text -> DisplayData
DisplayData MimeType
PlainText forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
pagerOut]
      , executionCounter :: Int
executionCounter = forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
counter
      , status :: ExecuteReplyStatus
status = ExecuteReplyStatus
replyStatus
      }

replyTo KernelConfig m output result
config MVar Integer
_ ZeroMQInterface
_ req :: Message
req@CompleteRequest{} MessageHeader
replyHeader = do
  let code :: Text
code = Message -> Text
getCode Message
req
      pos :: Int
pos = Message -> Int
getCursorPos Message
req
  (Text
matchedText, [Text]
completions) <- forall (m :: * -> *) output result.
KernelConfig m output result -> Text -> Int -> m (Text, [Text])
completion KernelConfig m output result
config Text
code Int
pos

  let start :: Int
start = Int
pos forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
matchedText
      end :: Int
end = Int
pos
#if MIN_VERSION_aeson(2,0,0)
      reply :: Message
reply = MessageHeader
-> [Text] -> Int -> Int -> Metadata -> Bool -> Message
CompleteReply MessageHeader
replyHeader [Text]
completions Int
start Int
end (Object -> Metadata
Metadata forall v. KeyMap v
KeyMap.empty) Bool
True
#else
      reply = CompleteReply replyHeader completions start end (Metadata HashMap.empty) True
#endif
  forall (m :: * -> *) a. Monad m => a -> m a
return Message
reply

replyTo KernelConfig m output result
config MVar Integer
_ ZeroMQInterface
_ req :: Message
req@InspectRequest{} MessageHeader
replyHeader = do
  Maybe [DisplayData]
result <- forall (m :: * -> *) output result.
KernelConfig m output result
-> Text -> Int -> m (Maybe [DisplayData])
inspectInfo KernelConfig m output result
config (Message -> Text
inspectCode Message
req) (Message -> Int
inspectCursorPos Message
req)
  let reply :: Message
reply =
        case Maybe [DisplayData]
result of
          Just [DisplayData]
datas -> InspectReply
            { header :: MessageHeader
header = MessageHeader
replyHeader
            , inspectStatus :: Bool
inspectStatus = Bool
True
            , inspectData :: [DisplayData]
inspectData = [DisplayData]
datas
            }
          Maybe [DisplayData]
_ -> InspectReply { header :: MessageHeader
header = MessageHeader
replyHeader, inspectStatus :: Bool
inspectStatus = Bool
False, inspectData :: [DisplayData]
inspectData = [] }
  forall (m :: * -> *) a. Monad m => a -> m a
return Message
reply

replyTo KernelConfig m output result
_ MVar Integer
_ ZeroMQInterface
_ Message
msg MessageHeader
_ = do
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn FilePath
"Unknown message: "
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> IO ()
print Message
msg
  forall (m :: * -> *) a. Monad m => a -> m a
return Message
msg

dupHeader :: MonadIO m => MessageHeader -> MessageType -> m MessageHeader
dupHeader :: forall (m :: * -> *).
MonadIO m =>
MessageHeader -> MessageType -> m MessageHeader
dupHeader MessageHeader
hdr MessageType
mtype =
  do
    UUID
uuid <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
UUID.random
    forall (m :: * -> *) a. Monad m => a -> m a
return MessageHeader
hdr { mhMessageId :: UUID
mhMessageId = UUID
uuid, mhMsgType :: MessageType
mhMsgType = MessageType
mtype }