Commit 87cf416d authored by Adam Vogt's avatar Adam Vogt

Merge branch 'master' of https://github.com/gibiansky/IHaskell

parents 7cda8c7a 144fa549
......@@ -40,47 +40,49 @@ category: Development
build-type: Simple
-- Constraint on the version of Cabal needed to build this package.
cabal-version: >=1.8
cabal-version: >=1.16
data-files:
profile/profile.tar
library
hs-source-dirs: src
build-depends: base ==4.6.*,
cereal == 0.3.*,
HTTP,
base64-bytestring >= 1.0,
process >= 1.1,
hlint,
cmdargs >= 0.10,
tar,
ipython-kernel,
ghc-parser,
unix >= 2.6,
hspec,
default-language: Haskell2010
build-depends:
base ==4.6.*,
aeson >=0.6,
MissingH >=1.2,
classy-prelude >=0.7,
base64-bytestring >=1.0,
bytestring >=0.10,
cereal ==0.3.*,
classy-prelude >=0.7,
cmdargs >=0.10,
containers >=0.5,
directory -any,
filepath -any,
ghc ==7.6.*,
ghc-parser -any,
ghc-paths ==0.1.*,
haskeline -any,
here -any,
hlint -any,
hspec -any,
HTTP -any,
HUnit -any,
ipython-kernel -any,
MissingH >=1.2,
mtl >=2.1,
parsec -any,
process >=1.1,
random >=1.0,
shelly >=1.3,
split >= 0.2,
utf8-string,
strict >=0.3,
shelly >=1.3,
system-argv0,
directory,
here,
system-filepath,
filepath,
mtl >= 2.1,
transformers,
haskeline,
HUnit,
parsec
system-argv0 -any,
system-filepath -any,
tar -any,
transformers -any,
unix >= 2.6,
utf8-string -any
exposed-modules: IHaskell.Display
IHaskell.Eval.Completion
......@@ -121,81 +123,84 @@ executable IHaskell
extensions: DoAndIfThenElse
-- Other library packages from which modules are imported.
build-depends: base ==4.6.*,
cereal == 0.3.*,
HTTP,
base64-bytestring >= 1.0,
process >= 1.1,
hlint,
cmdargs >= 0.10,
tar,
ghc-parser,
ipython-kernel,
unix >= 2.6,
hspec,
default-language: Haskell2010
build-depends:
base ==4.6.*,
aeson >=0.6,
MissingH >=1.2,
classy-prelude >=0.7,
base64-bytestring >=1.0,
bytestring >=0.10,
cereal ==0.3.*,
classy-prelude >=0.7,
cmdargs >=0.10,
containers >=0.5,
directory -any,
filepath -any,
ghc ==7.6.*,
ghc-parser -any,
ghc-paths ==0.1.*,
haskeline -any,
here -any,
hlint -any,
hspec -any,
HTTP -any,
HUnit -any,
ipython-kernel -any,
MissingH >=1.2,
mtl >=2.1,
parsec -any,
process >=1.1,
random >=1.0,
shelly >=1.3,
split >= 0.2,
utf8-string,
strict >=0.3,
shelly >=1.3,
system-argv0,
directory,
here,
system-filepath,
filepath,
mtl >= 2.1,
transformers,
haskeline,
HUnit,
parsec
system-argv0 -any,
system-filepath -any,
tar -any,
transformers -any,
unix >= 2.6,
utf8-string -any
Test-Suite hspec
hs-source-dirs: src
Type: exitcode-stdio-1.0
Ghc-Options: -threaded
Main-Is: Hspec.hs
build-depends: base ==4.6.*,
cereal == 0.3.*,
HTTP,
base64-bytestring >= 1.0,
process >= 1.1,
hlint,
cmdargs >= 0.10,
tar,
ghc-parser,
ipython-kernel,
unix >= 2.6,
hspec,
default-language: Haskell2010
build-depends:
base ==4.6.*,
aeson >=0.6,
MissingH >=1.2,
classy-prelude >=0.7,
base64-bytestring >=1.0,
bytestring >=0.10,
cereal ==0.3.*,
classy-prelude >=0.7,
cmdargs >=0.10,
containers >=0.5,
directory -any,
filepath -any,
ghc ==7.6.*,
ghc-parser -any,
ghc-paths ==0.1.*,
haskeline -any,
here -any,
hlint -any,
hspec -any,
HTTP -any,
HUnit -any,
ipython-kernel -any,
MissingH >=1.2,
mtl >=2.1,
parsec -any,
process >=1.1,
random >=1.0,
shelly >=1.3,
split >= 0.2,
utf8-string,
strict >=0.3,
shelly >=1.3,
system-argv0,
directory,
here,
system-filepath,
filepath,
mtl >= 2.1,
transformers,
haskeline,
HUnit,
setenv,
parsec
system-argv0 -any,
system-filepath -any,
tar -any,
transformers -any,
unix >= 2.6,
utf8-string -any
extensions: DoAndIfThenElse
OverloadedStrings
......
This diff is collapsed.
This source diff could not be displayed because it is too large. You can view the blob instead.
This source diff could not be displayed because it is too large. You can view the blob instead.
......@@ -14,7 +14,7 @@ maintainer: andrew.gibiansky@gmail.com
category: Language
build-type: Custom
-- extra-source-files:
cabal-version: >=1.10
cabal-version: >=1.16
extra-source-files:
build-parser.sh
......@@ -25,7 +25,8 @@ library
Language.Haskell.GHC.HappyParser
-- other-modules:
-- other-extensions:
build-depends: base >=4.6 && <4.7, ghc == 7.6.3
build-depends: base >=4.6 && <4.7,
ghc ==7.6.*
-- hs-source-dirs:
default-language: Haskell2010
......@@ -10,7 +10,7 @@ import Data.String.Here
import IHaskell.Display
instance IHaskellDisplay Value where
display renderable = return [plain json, html dom]
display renderable = return $ Display [plain json, html dom]
where
json = unpack $ decodeUtf8 $ encodePretty renderable
dom = [i|<div class="highlight-code" id="javascript">${json}</div>|]
......@@ -6,7 +6,7 @@ import IHaskell.Display
import Text.Printf
instance Show a => IHaskellDisplay (Maybe a) where
display just = return [stringDisplay, htmlDisplay]
display just = return $ Display [stringDisplay, htmlDisplay]
where
stringDisplay = plain (show just)
htmlDisplay = html str
......
......@@ -10,7 +10,7 @@ import Text.Blaze.Internal
import Control.Monad
instance IHaskellDisplay (MarkupM a) where
display val = return [stringDisplay, htmlDisplay]
display val = return $ Display [stringDisplay, htmlDisplay]
where
str = renderMarkup (void val)
stringDisplay = plain str
......
......@@ -26,7 +26,7 @@ instance IHaskellDisplay (Renderable a) where
-- but SVGs are not resizable in the IPython notebook.
svgDisp <- chartData renderable SVG
return [pngDisp, svgDisp]
return $ Display [pngDisp, svgDisp]
chartData :: Renderable a -> FileFormat -> IO DisplayData
chartData renderable format = do
......
......@@ -16,7 +16,7 @@ instance IHaskellDisplay (Diagram Cairo R2) where
display renderable = do
png <- diagramData renderable PNG
svg <- diagramData renderable SVG
return [png, svg]
return $ Display [png, svg]
diagramData :: Diagram Cairo R2 -> OutputType -> IO DisplayData
diagramData renderable format = do
......
......@@ -24,7 +24,7 @@ instance IHaskellDisplay B.ByteString where
m <- magicOpen []
magicLoadDefault m
f <- B.unsafeUseAsCStringLen x (magicCString m)
return [withClass (parseMagic f) x]
return $ Display [withClass (parseMagic f) x]
b64 :: B.ByteString -> String
b64 = Char.unpack . Base64.encode
......
......@@ -27,11 +27,11 @@ library
hs-source-dirs: src
default-language: Haskell2010
build-depends: base >=4.6 && <4.7,
bytestring >= 0.10,
aeson >= 0.6,
text >= 0.11,
containers >= 0.5,
unix >= 2.6,
uuid >= 1.3,
cereal == 0.3.*,
zeromq4-haskell >= 0.1
aeson >=0.6,
bytestring >=0.10,
cereal ==0.3.*,
containers >=0.5,
text >=0.11,
unix >=2.6,
uuid >=1.3,
zeromq4-haskell >=0.1
......@@ -101,7 +101,7 @@ instance ToJSON StreamType where
-- | Convert a MIME type and value into a JSON dictionary pair.
displayDataToJson :: DisplayData -> (Text, Value)
displayDataToJson (Display mimeType dataStr) = pack (show mimeType) .= dataStr
displayDataToJson (DisplayData mimeType dataStr) = pack (show mimeType) .= dataStr
----- Constants -----
......
......@@ -341,13 +341,13 @@ replyType ShutdownRequestMessage = Just ShutdownReplyMessage
replyType _ = Nothing
-- | Data for display: a string with associated MIME type.
data DisplayData = Display MimeType ByteString deriving (Typeable, Generic)
data DisplayData = DisplayData MimeType ByteString 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 _ = "Display"
show _ = "DisplayData"
-- Allow DisplayData serialization
instance Serialize DisplayData
......@@ -369,9 +369,9 @@ extractPlain :: [DisplayData] -> String
extractPlain disps =
case find isPlain disps of
Nothing -> ""
Just (Display PlainText bytestr) -> Char.unpack bytestr
Just (DisplayData PlainText bytestr) -> Char.unpack bytestr
where
isPlain (Display mime _) = mime == PlainText
isPlain (DisplayData mime _) = mime == PlainText
instance Show MimeType where
show PlainText = "text/plain"
......
......@@ -7,3 +7,7 @@ c.Session.keyfile = b''
# Syntax highlight properly in Haskell notebooks.
c.NbConvertBase.default_language = "haskell"
# Where to look for templates.
template_path = "/".join(__file__.split("/")[:-1] + ["templates"])
c.TemplateExporter.template_path = [template_path]
{%- extends 'html_full.tpl' -%}
{%- block header -%}
<!DOCTYPE html>
<html>
<head>
<meta charset="utf-8" />
<title>{{resources['metadata']['name']}}</title>
{% for css in resources.inlining.css -%}
<style type="text/css">
{{ css }}
</style>
{% endfor %}
<style type="text/css">
/* Overrides of notebook CSS for static HTML export */
body {
overflow: visible;
padding: 8px;
}
.input_area {
padding: 0.2em;
}
pre {
padding: 0.2em;
border: none;
margin: 0px;
font-size: 13px;
}
</style>
<!-- Our custom CSS -->
<style type="text/css">
/*
Custom IHaskell CSS.
*/
/* Styles used for the Hoogle display in the pager */
.hoogle-doc {
display: block;
padding-bottom: 1.3em;
padding-left: 0.4em;
}
.hoogle-code {
display: block;
font-family: monospace;
white-space: pre;
}
.hoogle-text {
display: block;
}
.hoogle-name {
color: green;
font-weight: bold;
}
.hoogle-head {
font-weight: bold;
}
.hoogle-sub {
display: block;
margin-left: 0.4em;
}
.hoogle-package {
font-weight: bold;
font-style: italic;
}
.hoogle-module {
font-weight: bold;
}
/* Styles used for basic displays */
.get-type {
color: green;
font-weight: bold;
font-family: monospace;
display: block;
white-space: pre;
}
.show-type {
color: green;
font-weight: bold;
font-family: monospace;
margin-left: 1em;
}
.mono {
font-family: monospace;
display: block;
}
.err-msg {
color: red;
font-style: italic;
font-family: monospace;
white-space: pre;
display: block;
}
#unshowable {
color: red;
font-weight: bold;
}
.err-msg.in.collapse {
padding-top: 0.7em;
}
/* Code that will get highlighted before it is highlighted */
.highlight-code {
white-space: pre;
font-family: monospace;
}
/* Hlint styles */
.suggestion-warning {
font-weight: bold;
color: rgb(200, 130, 0);
}
.suggestion-error {
font-weight: bold;
color: red;
}
.suggestion-name {
font-weight: bold;
}
</style>
<script src="https://c328740.ssl.cf1.rackcdn.com/mathjax/latest/MathJax.js?config=TeX-AMS_HTML" type="text/javascript"></script>
<script type="text/javascript">
init_mathjax = function() {
if (window.MathJax) {
// MathJax loaded
MathJax.Hub.Config({
tex2jax: {
inlineMath: [ ['$','$'], ["\\(","\\)"] ],
displayMath: [ ['$$','$$'], ["\\[","\\]"] ]
},
displayAlign: 'left', // Change this to 'center' to center equations.
"HTML-CSS": {
styles: {'.MathJax_Display': {"margin": 0}}
}
});
MathJax.Hub.Queue(["Typeset",MathJax.Hub]);
}
}
init_mathjax();
</script>
</head>
{%- endblock header -%}
{% block body %}
<body>
{{ super() }}
</body>
{%- endblock body %}
......@@ -72,15 +72,13 @@ evaluationComparing comparison string = do
becomes string expected = evaluationComparing comparison string
where
comparison :: ([Display], String) -> IO ()
comparison (results, pageOut) = do
when (length results /= length expected) $
expectationFailure $ "Expected result to have " ++ show (length expected)
++ " results. Got " ++ show results
let isPlain (Display PlainText _) = True
isPlain _ = False
forM_ (zip results expected) $ \(result, expected) ->
forM_ (zip results expected) $ \(Display result, expected) ->
case extractPlain result of
"" -> expectationFailure $ "No plain-text output in " ++ show result ++ "\nExpected: " ++ expected
str -> str `shouldBe` expected
......
......@@ -5,12 +5,13 @@ module IHaskell.Display (
serializeDisplay,
Width, Height, Base64,
encode64, base64,
DisplayData
Display(..),
DisplayData(..),
) where
import ClassyPrelude
import Data.Serialize as Serialize
import Data.ByteString
import Data.ByteString hiding (map)
import Data.String.Utils (rstrip)
import qualified Data.ByteString.Base64 as Base64
import qualified Data.ByteString.Char8 as Char
......@@ -27,52 +28,62 @@ type Base64 = ByteString
-- > instance (Show a) => IHaskellDisplay a
-- > instance Show a where shows _ = id
class IHaskellDisplay a where
display :: a -> IO [DisplayData]
display :: a -> IO Display
-- | these instances cause the image, html etc. which look like:
--
-- > DisplayData
-- > [DisplayData]
-- > IO [DisplayData]
-- > IO (IO DisplayData)
-- > Display
-- > [Display]
-- > IO [Display]
-- > IO (IO Display)
--
-- be run the IO and get rendered (if the frontend allows it) in the pretty
-- form.
instance IHaskellDisplay a => IHaskellDisplay (IO a) where
display = (display =<<)
instance IHaskellDisplay DisplayData where
display disp = return [disp]
instance IHaskellDisplay [DisplayData] where
instance IHaskellDisplay Display where
display = return
instance IHaskellDisplay DisplayData where
display disp = return $ Display [disp]
instance IHaskellDisplay a => IHaskellDisplay [a] where
display disps = do
displays <- mapM display disps
return $ ManyDisplay displays
-- | Encode many displays into a single one. All will be output.
many :: [Display] -> Display
many = ManyDisplay
-- | Generate a plain text display.
plain :: String -> DisplayData
plain = Display PlainText . Char.pack . rstrip
plain = DisplayData PlainText . Char.pack . rstrip
-- | Generate an HTML display.
html :: String -> DisplayData
html = Display MimeHtml . Char.pack
html = DisplayData MimeHtml . Char.pack
-- | Genreate an SVG display.
svg :: String -> DisplayData
svg = Display MimeSvg . Char.pack
svg = DisplayData MimeSvg . Char.pack
-- | Genreate a LaTeX display.
latex :: String -> DisplayData
latex = Display MimeLatex . Char.pack
latex = DisplayData MimeLatex . Char.pack
-- | Generate a PNG display of the given width and height. Data must be
-- provided in a Base64 encoded manner, suitable for embedding into HTML.
-- The @base64@ function may be used to encode data into this format.
png :: Width -> Height -> Base64 -> DisplayData
png width height = Display (MimePng width height)
png width height = DisplayData (MimePng width height)
-- | Generate a JPG display of the given width and height. Data must be
-- provided in a Base64 encoded manner, suitable for embedding into HTML.
-- The @base64@ function may be used to encode data into this format.
jpg :: Width -> Height -> Base64 -> DisplayData
jpg width height = Display (MimeJpg width height)
jpg width height = DisplayData (MimeJpg width height)
-- | Convert from a string into base 64 encoded data.
encode64 :: String -> Base64
......@@ -84,5 +95,5 @@ base64 = Base64.encode
-- | For internal use within IHaskell.
-- Serialize displays to a ByteString.
serializeDisplay :: [DisplayData] -> ByteString
serializeDisplay :: Display -> ByteString
serializeDisplay = Serialize.encode
This diff is collapsed.
......@@ -38,7 +38,7 @@ lintIdent = "lintIdentAEjlkQeh"
-- | Given parsed code chunks, perform linting and output a displayable
-- report on linting warnings and errors.
lint :: [Located CodeBlock] -> IO [DisplayData]
lint :: [Located CodeBlock] -> IO Display
lint blocks = do
let validBlocks = map makeValid blocks
fileContents = joinBlocks validBlocks
......@@ -50,8 +50,8 @@ lint blocks = do
suggestions <- catMaybes <$> map parseSuggestion <$> hlint [filename, "--quiet"]
return $
if null suggestions
then []
else
then Display []
else Display
[plain $ concatMap plainSuggestion suggestions, html $ htmlSuggestions suggestions]
where
-- Join together multiple valid file blocks into a single file.
......
......@@ -12,6 +12,7 @@ module IHaskell.IPython (
readInitInfo,
defaultConfFile,
getIHaskellDir,
getSandboxPackageConf,
nbconvert,
ViewFormat(..),
) where
......@@ -23,7 +24,7 @@ import System.Argv0
import System.Directory
import qualified Filesystem.Path.CurrentOS as FS
import Data.List.Utils (split)
import Data.String.Utils (rstrip)
import Data.String.Utils (rstrip, endswith)
import Text.Printf
import qualified System.IO.Strict as StrictIO
......@@ -122,6 +123,7 @@ nbconvert fmt name = void . shellyNoDir $ do
Just notebook ->
let viewArgs = case fmt of
Pdf -> ["--to=latex", "--post=pdf"]
Html -> ["--to=html", "--template=ihaskell"]
fmt -> ["--to=" ++ show fmt] in
void $ runIHaskell ipythonProfile "nbconvert" $ viewArgs ++ [fpToString notebook]
......@@ -391,3 +393,19 @@ getIHaskellPath = do
-- If it's actually a relative path, make it absolute.
cd <- liftIO getCurrentDirectory
return $ FS.encodeString $ FS.decodeString cd FS.</> f
getSandboxPackageConf :: IO (Maybe String)
getSandboxPackageConf = shellyNoDir $ do
myPath <- getIHaskellPath
let sandboxName = ".cabal-sandbox"
if not $ sandboxName`isInfixOf` myPath
then return Nothing
else do
let pieces = split "/" myPath
sandboxDir = intercalate "/" $ takeWhile (/= sandboxName) pieces ++ [sandboxName]
subdirs <- ls $ fpFromString sandboxDir
let confdirs = filter (endswith "packages.conf.d") $ map fpToString subdirs
case confdirs of
[] -> return Nothing
dir:_ ->
return $ Just dir
......@@ -20,12 +20,15 @@ module IHaskell.Types (
Width, Height,
FrontendType(..),
ViewFormat(..),
Display(..),
defaultKernelState,
extractPlain
) where
import ClassyPrelude
import qualified Data.ByteString.Char8 as Char
import Data.Serialize
import GHC.Generics
import Text.Read as Read hiding (pfail, String)
import Text.ParserCombinators.ReadP
......@@ -60,6 +63,12 @@ instance Read ViewFormat where
"md" -> return Markdown
_ -> pfail
-- | Wrapper for ipython-kernel's DisplayData which allows sending multiple
-- results from the same expression.
data Display = Display [DisplayData]
| ManyDisplay [Display]
deriving (Show, Typeable, Generic)
instance Serialize Display
-- | All state stored in the kernel between executions.
data KernelState = KernelState
......@@ -108,9 +117,9 @@ data EvaluationResult =
-- | An intermediate result which communicates what has been printed thus
-- far.
IntermediateResult {
outputs :: [DisplayData] -- ^ Display outputs.
outputs :: Display -- ^ Display outputs.
}
| FinalResult {
outputs :: [DisplayData], -- ^ Display outputs.
outputs :: Display, -- ^ Display outputs.
pagerOut :: String -- ^ Text to display in the IPython pager.
}
......@@ -252,7 +252,8 @@ replyTo interface req@ExecuteRequest{ getCode = code } replyHeader state = do
header <- dupHeader replyHeader ClearOutputMessage
send $ ClearOutput header True
sendOutput outs = do
sendOutput (ManyDisplay manyOuts) = mapM_ sendOutput manyOuts
sendOutput (Display outs) = do
header <- dupHeader replyHeader DisplayDataMessage
send $ PublishDisplayData header "haskell" outs
......
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