Skip to content

G
gargantext-ihaskell
Commit 80aa284d authored by Andrew Gibiansky's avatar Andrew Gibiansky
Browse files
Options

Reformat ihaskell display packages

parent c53f70d8
Hide whitespace changes
Inline Side-by-side
Showing with 269 additions and 240 deletions
ihaskell-display/ihaskell-aeson/IHaskell/Display/Aeson.hs
View file @ 80aa284d
{-# LANGUAGE NoImplicitPrelude, TypeSynonymInstances, QuasiQuotes #-} {-# LANGUAGE NoImplicitPrelude, TypeSynonymInstances, QuasiQuotes #-}
module IHaskell.Display.Aeson () where module IHaskell.Display.Aeson () where
import ClassyPrelude import ClassyPrelude
import Data.Textual.Encoding import Data.Textual.Encoding
import Data.Aeson import Data.Aeson
import Data.Aeson.Encode.Pretty import Data.Aeson.Encode.Pretty
import Data.String.Here import Data.String.Here
import IHaskell.Display import IHaskell.Display
instance IHaskellDisplay Value where instance IHaskellDisplay Value where
display renderable = return $ Display [plain json, html dom] display renderable = return $ Display [plain json, html dom]
where where
json = unpack $ decodeUtf8 $ encodePretty renderable json = unpack $ decodeUtf8 $ encodePretty renderable
dom = [i|<div class="highlight-code" id="javascript">${json}</div>|] dom = [i|<div class="highlight-code" id="javascript">${json}</div>|]
ihaskell-display/ihaskell-basic/IHaskell/Display/Basic.hs
View file @ 80aa284d
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
module IHaskell.Display.Basic () where module IHaskell.Display.Basic () where
import IHaskell.Display import IHaskell.Display
import Text.Printf import Text.Printf
instance Show a => IHaskellDisplay (Maybe a) where instance Show a => IHaskellDisplay (Maybe a) where
display just = return $ Display [stringDisplay, htmlDisplay] display just = return $ Display [stringDisplay, htmlDisplay]
where where
stringDisplay = plain (show just) stringDisplay = plain (show just)
htmlDisplay = html str htmlDisplay = html str
str = case just of str =
Nothing -> "<span style='color: red; font-weight: bold;'>Nothing</span>" case just of
Just x -> printf "<span style='color: green; font-weight: bold;'>Just</span><span style='font-family: monospace;'>%s</span>" (show x) 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)
ihaskell-display/ihaskell-blaze/IHaskell/Display/Blaze.hs
View file @ 80aa284d
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
module IHaskell.Display.Blaze () where module IHaskell.Display.Blaze () where
import IHaskell.Display import IHaskell.Display
import Text.Printf import Text.Printf
import Text.Blaze.Html import Text.Blaze.Html
import Text.Blaze.Renderer.Pretty import Text.Blaze.Renderer.Pretty
import Text.Blaze.Internal import Text.Blaze.Internal
import Control.Monad import Control.Monad
instance IHaskellDisplay (MarkupM a) where instance IHaskellDisplay (MarkupM a) where
display val = return $ Display [stringDisplay, htmlDisplay] display val = return $ Display [stringDisplay, htmlDisplay]
where where
str = renderMarkup (void val) str = renderMarkup (void val)
stringDisplay = plain str stringDisplay = plain str
htmlDisplay = html str htmlDisplay = html str
ihaskell-display/ihaskell-charts/IHaskell/Display/Charts.hs
View file @ 80aa284d
{-# LANGUAGE NoImplicitPrelude, CPP #-} {-# LANGUAGE NoImplicitPrelude, CPP #-}
module IHaskell.Display.Charts () where module IHaskell.Display.Charts () where
import ClassyPrelude import ClassyPrelude
import System.Directory import System.Directory
import Data.Default.Class import Data.Default.Class
import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Renderable
import Graphics.Rendering.Chart.Backend.Cairo import Graphics.Rendering.Chart.Backend.Cairo
import qualified Data.ByteString.Char8 as Char import qualified Data.ByteString.Char8 as Char
import System.IO.Unsafe import System.IO.Unsafe
import IHaskell.Display import IHaskell.Display
width :: Width width :: Width
width = 450 width = 450
...@@ -22,8 +23,8 @@ instance IHaskellDisplay (Renderable a) where ...@@ -22,8 +23,8 @@ instance IHaskellDisplay (Renderable a) where
display renderable = do display renderable = do
pngDisp <- chartData renderable PNG pngDisp <- chartData renderable PNG
-- We can add `svg svgDisplay` to the output of `display`, -- We can add `svg svgDisplay` to the output of `display`, but SVGs are not resizable in the IPython
-- but SVGs are not resizable in the IPython notebook. -- notebook.
svgDisp <- chartData renderable SVG svgDisp <- chartData renderable SVG
return $ Display [pngDisp, svgDisp] return $ Display [pngDisp, svgDisp]
...@@ -34,17 +35,17 @@ chartData renderable format = do ...@@ -34,17 +35,17 @@ chartData renderable format = do
-- Write the PNG image. -- Write the PNG image.
let filename = ".ihaskell-chart.png" let filename = ".ihaskell-chart.png"
opts = def{_fo_format = format, _fo_size = (width, height)} opts = def { _fo_format = format, _fo_size = (width, height) }
toFile = renderableToFile opts mkFile opts filename renderable
-- Convert to base64.
imgData <- readFile $ fpFromString filename
return $
case format of
PNG -> png width height $ base64 imgData
SVG -> svg $ Char.unpack imgData
#if MIN_VERSION_Chart_cairo(1,3,0) #if MIN_VERSION_Chart_cairo(1,3,0)
toFile filename renderable mkFile opts filename renderable = renderableToFile opts filename renderable
#else #else
toFile renderable filename mkFile opts filename renderable = renderableToFile opts renderable filename
#endif #endif
-- Convert to base64.
imgData <- readFile $ fpFromString filename
return $ case format of
PNG -> png width height $ base64 imgData
SVG -> svg $ Char.unpack imgData
ihaskell-display/ihaskell-diagrams/IHaskell/Display/Diagrams.hs
View file @ 80aa284d
{-# LANGUAGE NoImplicitPrelude, TypeSynonymInstances, FlexibleInstances #-} {-# LANGUAGE NoImplicitPrelude, TypeSynonymInstances, FlexibleInstances #-}
module IHaskell.Display.Diagrams (diagram, animation) where module IHaskell.Display.Diagrams (diagram, animation) where
import ClassyPrelude import ClassyPrelude
import System.Directory import System.Directory
import qualified Data.ByteString.Char8 as Char import qualified Data.ByteString.Char8 as Char
import System.IO.Unsafe import System.IO.Unsafe
import Diagrams.Prelude import Diagrams.Prelude
import Diagrams.Backend.Cairo import Diagrams.Backend.Cairo
import IHaskell.Display import IHaskell.Display
import IHaskell.Display.Diagrams.Animation import IHaskell.Display.Diagrams.Animation
instance IHaskellDisplay (QDiagram Cairo R2 Any) where instance IHaskellDisplay (QDiagram Cairo R2 Any) where
display renderable = do display renderable = do
...@@ -36,11 +37,13 @@ diagramData renderable format = do ...@@ -36,11 +37,13 @@ diagramData renderable format = do
-- Convert to base64. -- Convert to base64.
imgData <- readFile $ fpFromString filename imgData <- readFile $ fpFromString filename
let value = case format of let value =
PNG -> png (floor imgWidth) (floor imgHeight) $ base64 imgData case format of
SVG -> svg $ Char.unpack imgData PNG -> png (floor imgWidth) (floor imgHeight) $ base64 imgData
SVG -> svg $ Char.unpack imgData
return value return value
where where
extension SVG = "svg" extension SVG = "svg"
extension PNG = "png" extension PNG = "png"
......
ihaskell-display/ihaskell-diagrams/IHaskell/Display/Diagrams/Animation.hs
View file @ 80aa284d
{-# LANGUAGE NoImplicitPrelude, TypeSynonymInstances, FlexibleInstances #-} {-# LANGUAGE NoImplicitPrelude, TypeSynonymInstances, FlexibleInstances #-}
module IHaskell.Display.Diagrams.Animation (animation) where module IHaskell.Display.Diagrams.Animation (animation) where
import ClassyPrelude hiding (filename) import ClassyPrelude hiding (filename)
import Diagrams.Prelude import Diagrams.Prelude
import Diagrams.Backend.Cairo import Diagrams.Backend.Cairo
import Diagrams.Backend.Cairo.CmdLine (GifOpts (..)) import Diagrams.Backend.Cairo.CmdLine (GifOpts(..))
import Diagrams.Backend.CmdLine (DiagramOpts (..), mainRender) import Diagrams.Backend.CmdLine (DiagramOpts(..), mainRender)
import IHaskell.Display import IHaskell.Display
instance IHaskellDisplay (QAnimation Cairo R2 Any) where instance IHaskellDisplay (QAnimation Cairo R2 Any) where
display renderable = do display renderable = do
gif <- animationData renderable gif <- animationData renderable
return $ Display [html $ "<img src=\"data:image/gif;base64," return $ Display [html $ "<img src=\"data:image/gif;base64,"
++ gif ++ "\" />"] ++ gif ++ "\" />"]
animationData :: Animation Cairo R2 -> IO String animationData :: Animation Cairo R2 -> IO String
animationData renderable = do animationData renderable = do
...@@ -37,16 +38,12 @@ animationData renderable = do ...@@ -37,16 +38,12 @@ animationData renderable = do
-- Write the image. -- Write the image.
let filename = ".ihaskell-diagram.gif" let filename = ".ihaskell-diagram.gif"
diagOpts = DiagramOpts { diagOpts = DiagramOpts
_width = Just . ceiling $ imgWidth { _width = Just . ceiling $ imgWidth
, _height = Just . ceiling $ imgHeight , _height = Just . ceiling $ imgHeight
, _output = filename , _output = filename
} }
gifOpts = GifOpts { gifOpts = GifOpts { _dither = True, _noLooping = False, _loopRepeat = Nothing }
_dither = True
, _noLooping = False
, _loopRepeat = Nothing
}
mainRender (diagOpts, gifOpts) frameSet mainRender (diagOpts, gifOpts) frameSet
-- Convert to ascii represented base64 encoding -- Convert to ascii represented base64 encoding
......
ihaskell-display/ihaskell-hatex/IHaskell/Display/Hatex.hs
View file @ 80aa284d
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
-- | Provides 'IHaskellDisplay' instances for 'LaTeX' and 'LaTeXT'. -- | Provides 'IHaskellDisplay' instances for 'LaTeX' and 'LaTeXT'.
module IHaskell.Display.Hatex () where module IHaskell.Display.Hatex () where
import IHaskell.Display import IHaskell.Display
import Text.LaTeX import Text.LaTeX
import qualified Data.Text as T import qualified Data.Text as T
instance IHaskellDisplay LaTeX where instance IHaskellDisplay LaTeX where
display = display . IHaskell.Display.latex . T.unpack . render display = display . IHaskell.Display.latex . T.unpack . render
instance (a ~ (), IO ~ io) => IHaskellDisplay (LaTeXT io a) where instance (a ~ (), IO ~ io) => IHaskellDisplay (LaTeXT io a) where
display ma = display =<< execLaTeXT ma display ma = display =<< execLaTeXT ma
ihaskell-display/ihaskell-juicypixels/IHaskell/Display/Juicypixels.hs
View file @ 80aa284d
{-# LANGUAGE NoImplicitPrelude, TypeSynonymInstances, FlexibleInstances #-} {-# LANGUAGE NoImplicitPrelude, TypeSynonymInstances, FlexibleInstances #-}
module IHaskell.Display.Juicypixels
( module IHaskell.Display module IHaskell.Display.Juicypixels (module IHaskell.Display, module Codec.Picture) where
, module Codec.Picture
) where import Codec.Picture
import ClassyPrelude
import Codec.Picture import IHaskell.Display
import ClassyPrelude import System.Directory
import IHaskell.Display import System.IO.Unsafe
import System.Directory
import System.IO.Unsafe
-- instances -- instances
instance IHaskellDisplay DynamicImage where display = displayImageAsJpg instance IHaskellDisplay DynamicImage where
instance IHaskellDisplay (Image Pixel8) where display = displayImageAsJpg . ImageY8 display = displayImageAsJpg
instance IHaskellDisplay (Image Pixel16) where display = displayImageAsJpg . ImageY16
instance IHaskellDisplay (Image PixelF) where display = displayImageAsJpg . ImageYF instance IHaskellDisplay (Image Pixel8) where
instance IHaskellDisplay (Image PixelYA8) where display = displayImageAsJpg . ImageYA8 display = displayImageAsJpg . ImageY8
instance IHaskellDisplay (Image PixelYA16) where display = displayImageAsJpg . ImageYA16
instance IHaskellDisplay (Image PixelRGB8) where display = displayImageAsJpg . ImageRGB8 instance IHaskellDisplay (Image Pixel16) where
instance IHaskellDisplay (Image PixelRGB16) where display = displayImageAsJpg . ImageRGB16 display = displayImageAsJpg . ImageY16
instance IHaskellDisplay (Image PixelRGBF) where display = displayImageAsJpg . ImageRGBF
instance IHaskellDisplay (Image PixelRGBA8) where display = displayImageAsJpg . ImageRGBA8 instance IHaskellDisplay (Image PixelF) where
instance IHaskellDisplay (Image PixelRGBA16) where display = displayImageAsJpg . ImageRGBA16 display = displayImageAsJpg . ImageYF
instance IHaskellDisplay (Image PixelYCbCr8) where display = displayImageAsJpg . ImageYCbCr8
instance IHaskellDisplay (Image PixelCMYK8) where display = displayImageAsJpg . ImageCMYK8 instance IHaskellDisplay (Image PixelYA8) where
instance IHaskellDisplay (Image PixelCMYK16) where display = displayImageAsJpg . ImageCMYK16 display = displayImageAsJpg . ImageYA8
instance IHaskellDisplay (Image PixelYA16) where
display = displayImageAsJpg . ImageYA16
instance IHaskellDisplay (Image PixelRGB8) where
display = displayImageAsJpg . ImageRGB8
instance IHaskellDisplay (Image PixelRGB16) where
display = displayImageAsJpg . ImageRGB16
instance IHaskellDisplay (Image PixelRGBF) where
display = displayImageAsJpg . ImageRGBF
instance IHaskellDisplay (Image PixelRGBA8) where
display = displayImageAsJpg . ImageRGBA8
instance IHaskellDisplay (Image PixelRGBA16) where
display = displayImageAsJpg . ImageRGBA16
instance IHaskellDisplay (Image PixelYCbCr8) where
display = displayImageAsJpg . ImageYCbCr8
instance IHaskellDisplay (Image PixelCMYK8) where
display = displayImageAsJpg . ImageCMYK8
instance IHaskellDisplay (Image PixelCMYK16) where
display = displayImageAsJpg . ImageCMYK16
-- main rendering function -- main rendering function
displayImageAsJpg :: DynamicImage -> IO Display displayImageAsJpg :: DynamicImage -> IO Display
displayImageAsJpg renderable = do displayImageAsJpg renderable = do
switchToTmpDir switchToTmpDir
...@@ -40,30 +65,30 @@ displayImageAsJpg renderable = do ...@@ -40,30 +65,30 @@ displayImageAsJpg renderable = do
-- The type DynamicImage does not have a function to extract width and height -- The type DynamicImage does not have a function to extract width and height
imWidth :: DynamicImage -> Int imWidth :: DynamicImage -> Int
imWidth img = w imWidth img = w
where (w, h) = imWidthHeight img where
(w, h) = imWidthHeight img
imHeight :: DynamicImage -> Int imHeight :: DynamicImage -> Int
imHeight img = h imHeight img = h
where (w, h) = imWidthHeight img where
(w, h) = imWidthHeight img
-- Helper functions to pattern match on the DynamicImage Constructors -- Helper functions to pattern match on the DynamicImage Constructors
imWidthHeight :: DynamicImage -> (Int, Int) imWidthHeight :: DynamicImage -> (Int, Int)
imWidthHeight (ImageY8 im) = imWH im imWidthHeight (ImageY8 im) = imWH im
imWidthHeight (ImageY16 im) = imWH im imWidthHeight (ImageY16 im) = imWH im
imWidthHeight (ImageYF im) = imWH im imWidthHeight (ImageYF im) = imWH im
imWidthHeight (ImageYA8 im) = imWH im imWidthHeight (ImageYA8 im) = imWH im
imWidthHeight (ImageYA16 im) = imWH im imWidthHeight (ImageYA16 im) = imWH im
imWidthHeight (ImageRGB8 im) = imWH im imWidthHeight (ImageRGB8 im) = imWH im
imWidthHeight (ImageRGB16 im) = imWH im imWidthHeight (ImageRGB16 im) = imWH im
imWidthHeight (ImageRGBF im) = imWH im imWidthHeight (ImageRGBF im) = imWH im
imWidthHeight (ImageRGBA8 im) = imWH im imWidthHeight (ImageRGBA8 im) = imWH im
imWidthHeight (ImageRGBA16 im) = imWH im imWidthHeight (ImageRGBA16 im) = imWH im
imWidthHeight (ImageYCbCr8 im) = imWH im imWidthHeight (ImageYCbCr8 im) = imWH im
imWidthHeight (ImageCMYK8 im) = imWH im imWidthHeight (ImageCMYK8 im) = imWH im
imWidthHeight (ImageCMYK16 im) = imWH im imWidthHeight (ImageCMYK16 im) = imWH im
imWH :: (Image a) -> (Int, Int) imWH :: (Image a) -> (Int, Int)
imWH im = (imageWidth im, imageHeight im) imWH im = (imageWidth im, imageHeight im)
ihaskell-display/ihaskell-magic/IHaskell/Display/Magic.hs
View file @ 80aa284d
{-# LANGUAGE ViewPatterns, TypeSynonymInstances, FlexibleInstances #-} {-# LANGUAGE ViewPatterns, TypeSynonymInstances, FlexibleInstances #-}
module IHaskell.Display.Magic () where module IHaskell.Display.Magic () where
import IHaskell.Display import IHaskell.Display
import Magic import Magic
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B import qualified Data.ByteString.Unsafe as B
import qualified Data.ByteString.Base64 as Base64 import qualified Data.ByteString.Base64 as Base64
import qualified Data.ByteString.Char8 as Char import qualified Data.ByteString.Char8 as Char
import qualified Data.ByteString.UTF8 as B import qualified Data.ByteString.UTF8 as B
import Text.Read import Text.Read
import Data.Char import Data.Char
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding as T
import IHaskell.IPython.Types (MimeType(MimeSvg)) import IHaskell.IPython.Types (MimeType(MimeSvg))
import Data.ByteString.UTF8 import Data.ByteString.UTF8
instance IHaskellDisplay T.Text where instance IHaskellDisplay T.Text where
display = display . T.encodeUtf8 display = display . T.encodeUtf8
instance IHaskellDisplay B.ByteString where instance IHaskellDisplay B.ByteString where
display x = do display x = do
m <- magicOpen [] m <- magicOpen []
magicLoadDefault m magicLoadDefault m
f <- B.unsafeUseAsCStringLen x (magicCString m) f <- B.unsafeUseAsCStringLen x (magicCString m)
return $ Display [withClass (parseMagic f) x] return $ Display [withClass (parseMagic f) x]
b64 :: B.ByteString -> String b64 :: B.ByteString -> String
b64 = Char.unpack . Base64.encode b64 = Char.unpack . Base64.encode
...@@ -34,7 +35,7 @@ withClass :: MagicClass -> B.ByteString -> DisplayData ...@@ -34,7 +35,7 @@ withClass :: MagicClass -> B.ByteString -> DisplayData
withClass SVG = DisplayData MimeSvg . T.decodeUtf8 withClass SVG = DisplayData MimeSvg . T.decodeUtf8
withClass (PNG w h) = png w h . T.decodeUtf8 . Base64.encode withClass (PNG w h) = png w h . T.decodeUtf8 . Base64.encode
withClass JPG = jpg 400 300 . T.decodeUtf8 . Base64.encode withClass JPG = jpg 400 300 . T.decodeUtf8 . Base64.encode
withClass HTML = html . B.toString withClass HTML = html . B.toString
withClass LaTeX = latex . B.toString withClass LaTeX = latex . B.toString
withClass _ = plain . B.toString withClass _ = plain . B.toString
...@@ -54,17 +55,20 @@ JPG ...@@ -54,17 +55,20 @@ JPG
-} -}
parseMagic :: String -> MagicClass parseMagic :: String -> MagicClass
parseMagic f = case words f of parseMagic f =
"SVG" : _ -> SVG case words f of
"PNG" : _image : _data : "SVG":_ -> SVG
(readMaybe -> Just w) : _x : "PNG":_image:_data:(readMaybe -> Just w):_x:(readMaybe . takeWhile isDigit -> Just h):_ -> PNG w
(readMaybe . takeWhile isDigit -> Just h) : _ -> PNG w h h
"LaTeX" : _ -> LaTeX "LaTeX":_ -> LaTeX
"HTML" : _ -> HTML "HTML":_ -> HTML
"JPEG" : _ -> JPG "JPEG":_ -> JPG
_ -> Unknown _ -> Unknown
data MagicClass = data MagicClass = SVG
SVG | PNG Int Int | JPG | HTML | LaTeX | Unknown | PNG Int Int
deriving Show | JPG
| HTML
| LaTeX
| Unknown
deriving Show
ihaskell-display/ihaskell-parsec/IHaskell/Display/Parsec.hs
View file @ 80aa284d
{-# LANGUAGE NoImplicitPrelude, TypeSynonymInstances, QuasiQuotes, FlexibleInstances, OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude, TypeSynonymInstances, QuasiQuotes, FlexibleInstances, OverloadedStrings #-}
module IHaskell.Display.Parsec () where module IHaskell.Display.Parsec () where
import ClassyPrelude hiding (fromList) import ClassyPrelude hiding (fromList)
import System.Random import System.Random
import Data.String.Here import Data.String.Here
import Data.HashMap.Strict as Map import Data.HashMap.Strict as Map
import Text.Parsec (parse, sourceLine, sourceColumn) import Text.Parsec (parse, sourceLine, sourceColumn)
import Text.Parsec.String (Parser) import Text.Parsec.String (Parser)
import Text.Parsec.Error (errorPos, ParseError) import Text.Parsec.Error (errorPos, ParseError)
import Data.Aeson import Data.Aeson
import IHaskell.Display import IHaskell.Display
instance Show a => IHaskellDisplay (Parser a) where instance Show a => IHaskellDisplay (Parser a) where
display renderable = return $ many [Display [javascript js], Display [html dom]] display renderable = return $ many [Display [javascript js], Display [html dom]]
where where
dom = [hereFile|widget.html|] dom = [hereFile|widget.html|]
js = [hereFile|widget.js|] js = [hereFile|widget.js|]
...@@ -25,25 +26,21 @@ data ParseText = ParseText String ...@@ -25,25 +26,21 @@ data ParseText = ParseText String
instance FromJSON ParseText where instance FromJSON ParseText where
parseJSON (Object v) = ParseText <$> v .: "text" parseJSON (Object v) = ParseText <$> v .: "text"
parseJSON _ = fail "Expecting object" parseJSON _ = fail "Expecting object"
-- | Output of parsing. -- | Output of parsing.
instance Show a => ToJSON (Either ParseError a) where instance Show a => ToJSON (Either ParseError a) where
toJSON (Left err) = object [ toJSON (Left err) = object
"status" .= ("error" :: String), [ "status" .= ("error" :: String)
"line" .= sourceLine (errorPos err), , "line" .= sourceLine (errorPos err)
"col" .= sourceColumn (errorPos err), , "col" .= sourceColumn (errorPos err)
"msg" .= show err , "msg" .= show err
] ]
toJSON (Right result) = object [ toJSON (Right result) = object ["status" .= ("success" :: String), "result" .= show result]
"status" .= ("success" :: String),
"result" .= show result
]
instance Show a => IHaskellWidget (Parser a) where instance Show a => IHaskellWidget (Parser a) where
-- Name for this widget. -- Name for this widget.
targetName _ = "parsec" targetName _ = "parsec"
-- When we rece -- When we rece
comm widget (Object dict) publisher = do comm widget (Object dict) publisher = do
let key = "text" :: Text let key = "text" :: Text
......
ihaskell-display/ihaskell-rlangqq/IHaskell/Display/Rlangqq.hs
View file @ 80aa284d
{-# OPTIONS_GHC -fno-warn-missing-fields #-} {-# OPTIONS_GHC -fno-warn-missing-fields #-}
{-# LANGUAGE TupleSections, TemplateHaskell #-} {-# LANGUAGE TupleSections, TemplateHaskell #-}
module IHaskell.Display.Rlangqq
( module RlangQQ, module IHaskell.Display.Rlangqq (
module RlangQQ,
rDisp, rDisp,
rDisplayAll, rDisplayAll,
rOutputParsed, rOutputParsed,
rOutput, rOutput,
getPlotNames, getPlotNames,
getCaptions, getCaptions,
) where ) where
import RlangQQ import RlangQQ
import RlangQQ.ParseKnitted import RlangQQ.ParseKnitted
import System.Directory import System.Directory
import System.FilePath import System.FilePath
import Data.Maybe import Data.Maybe
import Data.List import Data.List
import Text.Read import Text.Read
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as Char import qualified Data.ByteString.Char8 as Char
import qualified Data.ByteString.Base64 as Base64 import qualified Data.ByteString.Base64 as Base64
import IHaskell.Display import IHaskell.Display
import IHaskell.Display.Blaze () -- to confirm it's installed import IHaskell.Display.Blaze () -- to confirm it's installed
import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as H import qualified Text.Blaze.Html5.Attributes as H
import Data.Monoid import Data.Char
import Data.Char import Control.Monad
import Control.Monad import Data.Ord
import Data.Ord import Data.List.Split
import Data.List.Split import Text.XFormat.Show hiding ((<>))
import Text.XFormat.Show hiding ((<>)) import Control.Applicative
import Control.Applicative import Control.Concurrent
import Control.Concurrent import Data.Monoid
import Data.Monoid import Data.Typeable
import Data.Typeable
import Control.Concurrent.STM import Control.Concurrent.STM
import Language.Haskell.TH.Quote import Language.Haskell.TH.Quote
-- | same as 'RlangQQ.r', but displays plots at the end too -- | same as 'RlangQQ.r', but displays plots at the end too
rDisp = QuasiQuoter { quoteExp = \s -> [| do rDisp = QuasiQuoter { quoteExp = \s -> [|do
result <- $(quoteExp r s) result <- $(quoteExp r s)
p <- rDisplayAll p <- rDisplayAll
printDisplay p printDisplay p
return result return result|] }
|] }
rOutput :: IO [Int] rOutput :: IO [Int]
rOutput = do rOutput = do
fs <- mapMaybe (readMaybe <=< stripPrefix "raw" <=< stripSuffix ".md") fs <- mapMaybe (readMaybe <=< stripPrefix "raw" <=< stripSuffix ".md")
<$> getDirectoryContents "Rtmp" <$> getDirectoryContents "Rtmp"
fs' <- forM fs $ \f -> (,f) <$> getModificationTime (showf ("Rtmp/raw"%Int%".md") f) fs' <- forM fs $ \f -> (,f) <$> getModificationTime (showf ("Rtmp/raw" % Int % ".md") f)
return $ map snd $ sortBy (flip (comparing fst)) fs' return $ map snd $ sortBy (flip (comparing fst)) fs'
-- | like 'stripPrefix' except on the end -- | like 'stripPrefix' except on the end
...@@ -62,35 +61,33 @@ rOutputParsed :: IO [KnitInteraction] ...@@ -62,35 +61,33 @@ rOutputParsed :: IO [KnitInteraction]
rOutputParsed = do rOutputParsed = do
ns <- rOutput ns <- rOutput
case ns of case ns of
[] -> return [] [] -> return []
n : _ -> parseKnitted <$> readFile (showf ("Rtmp/raw"%Int%".md") n) n:_ -> parseKnitted <$> readFile (showf ("Rtmp/raw" % Int % ".md") n)
getPlotNames :: IO [String] getPlotNames :: IO [String]
getPlotNames = do getPlotNames = do
interactions <- rOutputParsed interactions <- rOutputParsed
return [ p | KnitInteraction _ is <- interactions, KnitImage _ p <- is ] return [p | KnitInteraction _ is <- interactions
, KnitImage _ p <- is]
getCaptions :: IO [String] getCaptions :: IO [String]
getCaptions = do getCaptions = do
interactions <- rOutputParsed interactions <- rOutputParsed
return [ c | KnitInteraction _ is <- interactions, return
KnitImage c _ <- is, [c | KnitInteraction _ is <- interactions
not (isBoringCaption c) ] , KnitImage c _ <- is
, not (isBoringCaption c)]
-- | true when the caption name looks like one knitr will automatically -- | true when the caption name looks like one knitr will automatically generate
-- generate
isBoringCaption :: String -> Bool isBoringCaption :: String -> Bool
isBoringCaption s = maybe False isBoringCaption s = maybe False (all isDigit) (stripPrefix "plot of chunk unnamed-chunk-" s)
(all isDigit)
(stripPrefix "plot of chunk unnamed-chunk-" s)
rDisplayAll :: IO Display rDisplayAll :: IO Display
rDisplayAll = do rDisplayAll = do
ns <- rOutputParsed ns <- rOutputParsed
imgs <- sequence [ displayInteraction o | KnitInteraction _ os <- ns, o <- os] imgs <- sequence [displayInteraction o | KnitInteraction _ os <- ns
display (mconcat imgs) , o <- os]
display (mconcat imgs)
displayInteraction :: KnitOutput -> IO Display displayInteraction :: KnitOutput -> IO Display
displayInteraction (KnitPrint c) = display (plain c) displayInteraction (KnitPrint c) = display (plain c)
...@@ -99,10 +96,11 @@ displayInteraction (KnitError c) = display (plain c) ...@@ -99,10 +96,11 @@ displayInteraction (KnitError c) = display (plain c)
displayInteraction (KnitAsIs c) = display (plain c) displayInteraction (KnitAsIs c) = display (plain c)
displayInteraction (KnitImage cap img) = do displayInteraction (KnitImage cap img) = do
let caption let caption
| isBoringCaption cap = mempty | isBoringCaption cap = mempty
| otherwise = H.p (H.toMarkup cap) | otherwise = H.p (H.toMarkup cap)
encoded <- Base64.encode <$> B.readFile img encoded <- Base64.encode <$> B.readFile img
display $ H.img H.! H.src (H.unsafeByteStringValue display $ H.img H.! H.src
-- assumes you use the default device which is png (H.unsafeByteStringValue
(Char.pack "data:image/png;base64," <> encoded)) -- assumes you use the default device which is png
<> caption (Char.pack "data:image/png;base64," <> encoded))
<> caption
ihaskell-display/ihaskell-static-canvas/src/IHaskell/Display/StaticCanvas.hs
View file @ 80aa284d
...@@ -23,10 +23,7 @@ getUniqueName = do ...@@ -23,10 +23,7 @@ getUniqueName = do
putMVar uniqueCounter val' putMVar uniqueCounter val'
return $ pack $ "ihaskellStaticCanvasUniqueID" ++ show val return $ pack $ "ihaskellStaticCanvasUniqueID" ++ show val
data Canvas = Canvas { width :: Int data Canvas = Canvas { width :: Int, height :: Int, canvas :: CanvasFree () }
, height :: Int
, canvas :: CanvasFree ()
}
instance IHaskellDisplay Canvas where instance IHaskellDisplay Canvas where
display cnv = do display cnv = do
......
ihaskell-display/ihaskell-widgets/IHaskell/Display/Widgets.hs
View file @ 80aa284d
{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
module IHaskell.Display.Widgets () where module IHaskell.Display.Widgets () where
import ClassyPrelude import ClassyPrelude
import Data.Aeson import Data.Aeson
import IHaskell.Widgets import IHaskell.Widgets
import IHaskell.Display import IHaskell.Display
data WidgetName = ButtonWidget data WidgetName = ButtonWidget
...@@ -17,18 +18,19 @@ instance ToJSON WidgetName where ...@@ -17,18 +18,19 @@ instance ToJSON WidgetName where
toJSON ButtonWidget = "ButtonView" toJSON ButtonWidget = "ButtonView"
instance ToJSON WidgetMessage where instance ToJSON WidgetMessage where
toJSON DisplayWidget = object [ "method" .= str "display" ] toJSON DisplayWidget = object ["method" .= str "display"]
toJSON (InitialState name) = object [ toJSON (InitialState name) = object
"method" .= str "update", [ "method" .= str "update"
"state" .= object [ , "state" .= object
"_view_name" .= name, [ "_view_name" .= name
"visible" .= True, , "visible" .= True
"_css" .= object [], , "_css" .= object []
"msg_throttle" .= (3 :: Int), , "msg_throttle" .= (3 :: Int)
"disabled" .= False, , "disabled" .= False
"description" .= str "Button" , "description" .= str "Button"
] ]
] ]
str :: String -> String str :: String -> String
str = id str = id
...@@ -40,12 +42,11 @@ data ParseText = ParseText String ...@@ -40,12 +42,11 @@ data ParseText = ParseText String
instance FromJSON ParseText where instance FromJSON ParseText where
parseJSON (Object v) = ParseText <$> v .: "text" parseJSON (Object v) = ParseText <$> v .: "text"
parseJSON _ = fail "Expecting object" parseJSON _ = fail "Expecting object"
instance IHaskellWidget Slider where instance IHaskellWidget Slider where
-- Name for this widget. -- Name for this widget.
targetName _ = "WidgetModel" targetName _ = "WidgetModel"
-- Start by sending messages to set up the widget. -- Start by sending messages to set up the widget.
open widget send = do open widget send = do
putStrLn "Sending widgets!" putStrLn "Sending widgets!"
......
ihaskell-display/ihaskell-widgets/IHaskell/Widgets.hs
View file @ 80aa284d
module IHaskell.Widgets ( module IHaskell.Widgets (Slider(..)) where
Slider(..)
) where
data Slider = Slider data Slider = Slider
verify_formatting.py
View file @ 80aa284d
...@@ -44,14 +44,15 @@ except: ...@@ -44,14 +44,15 @@ except:
# Find all the source files # Find all the source files
sources = [] sources = []
for source_dir in ["src", "ipython-kernel"]: for source_dir in ["src", "ipython-kernel", "ihaskell-display"]:
for root, dirnames, filenames in os.walk(source_dir): for root, dirnames, filenames in os.walk(source_dir):
# Skip cabal dist directories # Skip cabal dist directories
if "dist" in root: if "dist" in root:
continue continue
for filename in filenames: for filename in filenames:
if filename.endswith(".hs"): # Take Haskell files, but ignore the Cabal Setup.hs
if filename.endswith(".hs") and filename != "Setup.hs":
sources.append(os.path.join(root, filename)) sources.append(os.path.join(root, filename))
......
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