module IHaskell.Types (
Message (..),
MessageHeader (..),
MessageType(..),
Username,
Metadata(..),
replyType,
ExecutionState (..),
StreamType(..),
MimeType(..),
DisplayData(..),
EvaluationResult(..),
ExecuteReplyStatus(..),
InitInfo(..),
KernelState(..),
LintStatus(..),
Width, Height,
FrontendType(..),
ViewFormat(..),
Display(..),
defaultKernelState,
extractPlain,
kernelOpts,
KernelOpt(..),
IHaskellDisplay(..),
IHaskellWidget(..),
Widget(..),
CommInfo(..),
) where
import ClassyPrelude
import qualified Data.ByteString.Char8 as Char
import Data.Serialize
import GHC.Generics
import Data.Map (Map, empty)
import Data.Aeson (Value)
import Text.Read as Read hiding (pfail, String)
import Text.ParserCombinators.ReadP
import IHaskell.IPython.Kernel
data ViewFormat
= Pdf
| Html
| Ipynb
| Markdown
| Latex
deriving Eq
instance Show ViewFormat where
show Pdf = "pdf"
show Html = "html"
show Ipynb = "ipynb"
show Markdown = "markdown"
show Latex = "latex"
instance Read ViewFormat where
readPrec = Read.lift $ do
str <- munch (const True)
case str of
"pdf" -> return Pdf
"html" -> return Html
"ipynb" -> return Ipynb
"notebook" -> return Ipynb
"latex" -> return Latex
"markdown" -> return Markdown
"md" -> return Markdown
_ -> pfail
class IHaskellDisplay a where
display :: a -> IO Display
class IHaskellDisplay a => IHaskellWidget a where
targetName :: a -> String
open :: a
-> (Value -> IO ())
-> IO ()
open _ _ = return ()
comm :: a
-> Value
-> (Value -> IO ())
-> IO ()
comm _ _ _ = return ()
close :: a
-> Value
-> IO ()
close _ _ = return ()
data Widget = forall a. IHaskellWidget a => Widget a
deriving Typeable
instance IHaskellDisplay Widget where
display (Widget widget) = display widget
instance IHaskellWidget Widget where
targetName (Widget widget) = targetName widget
open (Widget widget) = open widget
comm (Widget widget) = comm widget
close (Widget widget) = close widget
instance Show Widget where
show _ = "<Widget>"
data Display = Display [DisplayData]
| ManyDisplay [Display]
deriving (Show, Typeable, Generic)
instance Serialize Display
instance Monoid Display where
mempty = Display []
ManyDisplay a `mappend` ManyDisplay b = ManyDisplay (a ++ b)
ManyDisplay a `mappend` b = ManyDisplay (a ++ [b])
a `mappend` ManyDisplay b = ManyDisplay (a : b)
a `mappend` b = ManyDisplay [a,b]
instance Semigroup Display where
a <> b = a `mappend` b
data KernelState = KernelState
{ getExecutionCounter :: Int,
getLintStatus :: LintStatus,
getFrontend :: FrontendType,
useSvg :: Bool,
useShowErrors :: Bool,
useShowTypes :: Bool,
usePager :: Bool,
openComms :: Map UUID Widget
}
deriving Show
defaultKernelState :: KernelState
defaultKernelState = KernelState
{ getExecutionCounter = 1,
getLintStatus = LintOn,
getFrontend = IPythonConsole,
useSvg = True,
useShowErrors = False,
useShowTypes = False,
usePager = True,
openComms = empty
}
data FrontendType
= IPythonConsole
| IPythonNotebook
deriving (Show, Eq, Read)
data KernelOpt = KernelOpt {
getOptionName :: [String],
getSetName :: [String],
getUpdateKernelState :: KernelState -> KernelState
}
kernelOpts :: [KernelOpt]
kernelOpts =
[ KernelOpt ["lint"] [] $ \state -> state { getLintStatus = LintOn }
, KernelOpt ["no-lint"] [] $ \state -> state { getLintStatus = LintOff }
, KernelOpt ["svg"] [] $ \state -> state { useSvg = True }
, KernelOpt ["no-svg"] [] $ \state -> state { useSvg = False }
, KernelOpt ["show-types"] ["+t"] $ \state -> state { useShowTypes = True }
, KernelOpt ["no-show-types"] ["-t"] $ \state -> state { useShowTypes = False }
, KernelOpt ["show-errors"] [] $ \state -> state { useShowErrors = True }
, KernelOpt ["no-show-errors"] [] $ \state -> state { useShowErrors = False }
, KernelOpt ["pager"] [] $ \state -> state { usePager = True }
, KernelOpt ["no-pager"] [] $ \state -> state { usePager = False }
]
data InitInfo = InitInfo {
extensions :: [String],
initCells :: [String],
initDir :: String,
frontend :: FrontendType
}
deriving (Show, Read)
data LintStatus
= LintOn
| LintOff
deriving (Eq, Show)
data CommInfo = CommInfo Widget UUID String
data EvaluationResult =
IntermediateResult {
outputs :: Display
}
| FinalResult {
outputs :: Display,
pagerOut :: String,
startComms :: [CommInfo]
}