Commit 6a1e9120 authored by Sumit Sahrawat's avatar Sumit Sahrawat

Minor changes

- Return of the newlines: Add all newlines once again
- Provide better comments
- Remove `sender`
- Consistently use set and get prefixed functions
parent 73bdfb01
......@@ -16,4 +16,4 @@ instance IHaskellDisplay Value where
display renderable = return $ Display [plain json, html dom]
where
json = T.unpack $ E.decodeUtf8 $ LBS.toStrict $ encodePretty renderable
dom = [i|<div class="highlight-code" id="javascript">${json}</div>|]
\ No newline at end of file
dom = [i|<div class="highlight-code" id="javascript">${json}</div>|]
......@@ -16,4 +16,4 @@ instance Show a => IHaskellDisplay (Maybe a) where
Nothing -> "<span style='color: red; font-weight: bold;'>Nothing</span>"
Just x -> printf
"<span style='color: green; font-weight: bold;'>Just</span><span style='font-family: monospace;'>%s</span>"
(show x)
\ No newline at end of file
(show x)
......@@ -15,4 +15,4 @@ instance IHaskellDisplay (MarkupM a) where
where
str = renderMarkup (void val)
stringDisplay = plain str
htmlDisplay = html str
\ No newline at end of file
htmlDisplay = html str
......@@ -46,4 +46,4 @@ chartData renderable format = do
mkFile opts filename renderable = renderableToFile opts filename renderable
#else
mkFile opts filename renderable = renderableToFile opts renderable filename
#endif
\ No newline at end of file
#endif
......@@ -48,4 +48,4 @@ diagramData renderable format = do
-- Rendering hint.
diagram :: Diagram Cairo -> Diagram Cairo
diagram = id
\ No newline at end of file
diagram = id
......@@ -53,4 +53,4 @@ animationData renderable = do
-- Rendering hint.
animation :: Animation Cairo V2 Double -> Animation Cairo V2 Double
animation = id
\ No newline at end of file
animation = id
......@@ -12,4 +12,4 @@ instance IHaskellDisplay LaTeX where
display = display . IHaskell.Display.latex . T.unpack . render
instance (a ~ (), IO ~ io) => IHaskellDisplay (LaTeXT io a) where
display ma = display =<< execLaTeXT ma
\ No newline at end of file
display ma = display =<< execLaTeXT ma
......@@ -91,4 +91,4 @@ imWidthHeight (ImageCMYK8 im) = imWH im
imWidthHeight (ImageCMYK16 im) = imWH im
imWH :: Image a -> (Int, Int)
imWH im = (imageWidth im, imageHeight im)
\ No newline at end of file
imWH im = (imageWidth im, imageHeight im)
......@@ -71,4 +71,4 @@ data MagicClass = SVG
| HTML
| LaTeX
| Unknown
deriving Show
\ No newline at end of file
deriving Show
......@@ -49,4 +49,4 @@ instance Show a => IHaskellWidget (Parser a) where
let key = "text" :: Text
Just (String text) = Map.lookup key dict
result = parse widget "<interactive>" $ T.unpack text
publisher $ toJSON result
\ No newline at end of file
publisher $ toJSON result
......@@ -40,4 +40,4 @@ figureData figure format = do
where
extension SVG = "svg"
extension PNG = "png"
extension _ = ""
\ No newline at end of file
extension _ = ""
......@@ -103,4 +103,4 @@ displayInteraction (KnitImage cap img) = do
(H.unsafeByteStringValue
-- assumes you use the default device which is png
(Char.pack "data:image/png;base64," <> encoded))
<> caption
\ No newline at end of file
<> caption
......@@ -29,4 +29,4 @@ instance IHaskellDisplay Canvas where
display cnv = do
name <- getUniqueName
let script = buildScript' (width cnv) (height cnv) name (canvas cnv)
return $ Display [html $ unpack $ toLazyText script]
\ No newline at end of file
return $ Display [html $ unpack $ toLazyText script]
module IHaskell.Display.Widgets (module IHaskell.Display.Widgets.Button) where
import IHaskell.Display.Widgets.Button
\ No newline at end of file
import IHaskell.Display.Widgets.Button
......@@ -12,14 +12,13 @@ module IHaskell.Display.Widgets.Button (
setButtonStyle,
setButtonLabel,
setButtonTooltip,
disableButton,
enableButton,
setButtonStatus,
toggleButtonStatus,
-- * Get button properties
getButtonStyle,
getButtonLabel,
getButtonTooltip,
isDisabled,
getButtonStatus,
-- * Click handlers
setClickHandler,
getClickHandler,
......@@ -43,15 +42,15 @@ import IHaskell.Eval.Widgets
import qualified IHaskell.IPython.Message.UUID as U
import IHaskell.Types (WidgetMethod(..))
-- | ADT for a button
-- | A 'Button' represents a Button from IPython.html.widgets.
data Button =
Button
{ uuid :: U.UUID
, description :: IORef Text
, tooltip :: IORef Text
, disabled :: IORef Bool
, buttonStyle :: IORef ButtonStyle
, clickHandler :: IORef (Button -> IO ())
{ uuid :: U.UUID -- ^ The UUID for the comm
, description :: IORef Text -- ^ The label displayed on the button
, tooltip :: IORef Text -- ^ The tooltip shown on mouseover
, disabled :: IORef Bool -- ^ Whether the button is disabled
, buttonStyle :: IORef ButtonStyle -- ^ The button_style
, clickHandler :: IORef (Button -> IO ()) -- ^ Function executed when button is clicked
}
-- | Pre-defined button-styles
......@@ -67,15 +66,20 @@ data ButtonStyle = Primary
mkButton :: IO Button
mkButton = do
-- Default properties, with a random uuid
uuid <- U.random
sender <- newIORef Nothing
desc <- newIORef "label" -- Non-empty to get a display
commUUID <- U.random
desc <- newIORef "label" -- Non-empty to get a display
ttip <- newIORef ""
dis <- newIORef False
sty <- newIORef None
fun <- newIORef (\_ -> return ())
let b = Button uuid desc ttip dis sty fun
let b = Button { uuid = commUUID
, description = desc
, tooltip = ttip
, disabled = dis
, buttonStyle = sty
, clickHandler = fun
}
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen b (toJSON ButtonInitData) (toJSON b)
......@@ -83,9 +87,13 @@ mkButton = do
-- Return the button widget
return b
-- | Send an update msg for a button, with custom json. Make it easy
-- to update fragments of the state, by accepting a Pair instead of a
-- Value.
update :: Button -> [Pair] -> IO ()
update b v = widgetSendUpdate b . toJSON . object $ v
-- | Modify attributes of a button, stored inside it as IORefs
modify :: Button -> (Button -> IORef a) -> a -> IO ()
modify b attr val = writeIORef (attr b) val
......@@ -107,17 +115,12 @@ setButtonTooltip b txt = do
modify b tooltip txt
update b ["tooltip" .= txt]
-- | Disable the button
disableButton :: Button -> IO ()
disableButton b = do
modify b disabled True
update b ["disabled" .= True]
-- | Enable the button
enableButton :: Button -> IO ()
enableButton b = do
modify b disabled False
update b ["disabled" .= False]
-- | Set buttton status. True: Enabled, False: Disabled
setButtonStatus :: Button -> Bool -> IO ()
setButtonStatus b stat = do
let newStatus = not stat
modify b disabled newStatus
update b ["disabled" .= newStatus]
-- | Toggle the button
toggleButtonStatus :: Button -> IO ()
......@@ -139,9 +142,9 @@ getButtonLabel = readIORef . description
getButtonTooltip :: Button -> IO Text
getButtonTooltip = readIORef . tooltip
-- | Check whether the button is disabled
isDisabled :: Button -> IO Bool
isDisabled = readIORef . disabled
-- | Check whether the button is enabled / disabled
getButtonStatus :: Button -> IO Bool
getButtonStatus = not . readIORef . disabled
-- | Set a function to be activated on click
setClickHandler :: Button -> (Button -> IO ()) -> IO ()
......@@ -207,4 +210,4 @@ instance IHaskellWidget Button where
when (event == "click") $ triggerClick widget
str :: String -> String
str = id
\ No newline at end of file
str = id
......@@ -249,4 +249,4 @@ main = do
putStrLn "Usage:"
putStrLn "simple-calc-example setup -- set up the profile"
putStrLn
"simple-calc-example kernel FILE -- run a kernel with FILE for communication with the frontend"
\ No newline at end of file
"simple-calc-example kernel FILE -- run a kernel with FILE for communication with the frontend"
......@@ -242,4 +242,4 @@ dupHeader :: MonadIO m => MessageHeader -> MessageType -> m MessageHeader
dupHeader hdr mtype =
do
uuid <- liftIO UUID.random
return hdr { messageId = uuid, msgType = mtype }
\ No newline at end of file
return hdr { messageId = uuid, msgType = mtype }
......@@ -6,4 +6,4 @@ import IHaskell.IPython.Types as X
import IHaskell.IPython.Message.Writer as X
import IHaskell.IPython.Message.Parser as X
import IHaskell.IPython.Message.UUID as X
import IHaskell.IPython.ZeroMQ as X
\ No newline at end of file
import IHaskell.IPython.ZeroMQ as X
......@@ -173,4 +173,4 @@ commCloseParser :: LByteString -> Message
commCloseParser = requestParser $ \obj -> do
uuid <- obj .: "comm_id"
value <- obj .: "data"
return $ CommClose noHeader uuid value
\ No newline at end of file
return $ CommClose noHeader uuid value
......@@ -37,4 +37,4 @@ instance FromJSON UUID where
instance ToJSON UUID where
-- Extract the string from the UUID.
toJSON (UUID str) = String $ pack str
\ No newline at end of file
toJSON (UUID str) = String $ pack str
......@@ -129,4 +129,4 @@ ints :: [Int] -> [Int]
ints = id
string :: String -> String
string = id
\ No newline at end of file
string = id
......@@ -477,4 +477,4 @@ instance Show MimeType where
show (MimeJpg _ _) = "image/jpeg"
show MimeSvg = "image/svg+xml"
show MimeLatex = "text/latex"
show MimeJavascript = "application/javascript"
\ No newline at end of file
show MimeJavascript = "application/javascript"
......@@ -233,4 +233,4 @@ sendMessage debug hmacKey socket message = do
idents = identifiers head
metadata = "{}"
content = encodeStrict message
headStr = encodeStrict head
\ No newline at end of file
headStr = encodeStrict head
......@@ -45,4 +45,4 @@ ident :: Parser String
ident = many (alphaNum <|> oneOf "-.")
dependency :: Parser String
dependency = string " dependency \"" *> ident <* string "\" doesn't exist\n"
\ No newline at end of file
dependency = string " dependency \"" *> ident <* string "\" doesn't exist\n"
......@@ -41,4 +41,4 @@ failIfExists :: FilePath -> IO ()
failIfExists file = do
exists <- doesFileExist file
when exists $ fail $
printf "File %s already exists. To force supply --force." file
\ No newline at end of file
printf "File %s already exists. To force supply --force." file
......@@ -107,4 +107,4 @@ fromExt s =
case map toLower (takeExtension s) of
".lhs" -> Just LhsMarkdown
".ipynb" -> Just IpynbFile
_ -> Nothing
\ No newline at end of file
_ -> Nothing
......@@ -68,4 +68,4 @@ convOutputs sty array = do
getTexts :: LT.Text -> Value -> Maybe LT.Text
getTexts p (Object object)
| Just (Array text) <- lookup "text" object = concatWithPrefix p text
getTexts _ _ = Nothing
\ No newline at end of file
getTexts _ _ = Nothing
......@@ -119,4 +119,4 @@ classifyLines sty@(LhsStyle c o _ _ _ _) (l:ls) =
then Just ""
else Nothing
dropSpace = LT.dropWhile isSpace
classifyLines _ [] = []
\ No newline at end of file
classifyLines _ [] = []
......@@ -166,4 +166,4 @@ switchToTmpDir = void (try switchDir :: IO (Either SomeException ()))
where
switchDir =
getTemporaryDirectory >>=
setCurrentDirectory
\ No newline at end of file
setCurrentDirectory
......@@ -339,4 +339,4 @@ completePathFilter includeFile includeDirectory left right = GhcMonad.liftIO $ d
else str
visible = filter (not . isHidden) suggestions
hidden = filter isHidden suggestions
return $ visible ++ hidden
\ No newline at end of file
return $ visible ++ hidden
......@@ -1288,4 +1288,4 @@ displayError :: ErrMsg -> Display
displayError msg = Display [plain . typeCleaner $ msg, html $ formatError msg]
mono :: String -> String
mono = printf "<span class='mono'>%s</span>"
\ No newline at end of file
mono = printf "<span class='mono'>%s</span>"
......@@ -253,4 +253,4 @@ span :: String -> String -> String
span = printf "<span class='%s'>%s</span>"
link :: String -> String -> String
link = printf "<a target='_blank' href='%s'>%s</a>"
\ No newline at end of file
link = printf "<a target='_blank' href='%s'>%s</a>"
......@@ -23,4 +23,4 @@ info name = ghandle handler $ do
return $ typeCleaner $ showPpr dflags result
where
handler :: SomeException -> Interpreter String
handler _ = return ""
\ No newline at end of file
handler _ = return ""
......@@ -53,4 +53,4 @@ inspect code pos = do
response <- ghandle handler (Just <$> getType identifier)
let prefix = identifier ++ " :: "
fmt str = Display [plain $ prefix ++ str]
return $ fmt <$> response
\ No newline at end of file
return $ fmt <$> response
......@@ -224,4 +224,4 @@ showSuggestion = remove lintIdent . dropDo
-- Ignore other list elements - just proceed onwards.
clean (x:xs) = x : clean xs
clean [] = []
\ No newline at end of file
clean [] = []
......@@ -64,4 +64,4 @@ shellWords = try (eof *> return []) <|> do
return $ x : xs
parseShell :: String -> Either ParseError [String]
parseShell string = parse shellWords "shell" (string ++ "\n")
\ No newline at end of file
parseShell string = parse shellWords "shell" (string ++ "\n")
......@@ -295,4 +295,4 @@ getModuleName moduleSrc = do
case unLoc <$> hsmodName (unLoc mod) of
Nothing -> error "Module must have a name."
Just name -> return $ split "." $ moduleNameString name
otherwise -> error "getModuleName failed, output was neither Parsed nor Failure"
\ No newline at end of file
otherwise -> error "getModuleName failed, output was neither Parsed nor Failure"
......@@ -393,4 +393,4 @@ getDescription str = do
showFixity thing fixity =
if fixity == GHC.defaultFixity
then O.empty
else O.ppr fixity O.<+> pprInfixName (getName thing)
\ No newline at end of file
else O.ppr fixity O.<+> pprInfixName (getName thing)
......@@ -142,4 +142,4 @@ widgetHandler :: (Message -> IO ())
widgetHandler _ _ state [] = return state
widgetHandler sender header state (x:xs) = do
newState <- handleMessage sender header state x
widgetHandler sender header newState xs
\ No newline at end of file
widgetHandler sender header newState xs
......@@ -175,4 +175,4 @@ ihaskellArgs =
noArgs = flagArg unexpected ""
where
unexpected a = error $ "Unexpected argument: " ++ a
\ No newline at end of file
unexpected a = error $ "Unexpected argument: " ++ a
......@@ -262,4 +262,4 @@ getSandboxPackageConf = SH.shelly $ do
case confdirs of
[] -> return Nothing
dir:_ ->
return $ Just dir
\ No newline at end of file
return $ Just dir
......@@ -117,4 +117,4 @@ recordParentHeader dir header =
recordKernelProfile :: String -> Profile -> IO ()
recordKernelProfile dir profile =
writeFile (dir ++ "/.kernel-profile") $ show profile
\ No newline at end of file
writeFile (dir ++ "/.kernel-profile") $ show profile
......@@ -73,4 +73,4 @@ publishResult send replyHeader displayed updateNeeded pagerOutput usePager resul
prependCss (DisplayData MimeHtml html) =
DisplayData MimeHtml $ mconcat ["<style>", T.pack ihaskellCSS, "</style>", html]
prependCss x = x
\ No newline at end of file
prependCss x = x
......@@ -229,4 +229,4 @@ dupHeader :: MessageHeader -> MessageType -> IO MessageHeader
dupHeader header messageType = do
uuid <- liftIO random
return header { messageId = uuid, msgType = messageType }
\ No newline at end of file
return header { messageId = uuid, msgType = messageType }
......@@ -147,3 +147,4 @@ putChar = liftIO . P.putChar
print :: (MonadIO m, Show a) => a -> m ()
print = liftIO . P.print
......@@ -23,4 +23,4 @@ replace needle replacement haystack =
T.unpack $ T.replace (T.pack needle) (T.pack replacement) (T.pack haystack)
split :: String -> String -> [String]
split delim = map T.unpack . T.splitOn (T.pack delim) . T.pack
\ No newline at end of file
split delim = map T.unpack . T.splitOn (T.pack delim) . T.pack
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment