packages feed

d3js (empty) → 0.1.0.0

raw patch · 10 files changed

+616/−0 lines, 10 filesdep +basedep +mtldep +randomsetup-changed

Dependencies added: base, mtl, random, text

Files

+ D3JS.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE OverloadedStrings, GADTs, NoImplicitPrelude, ExistentialQuantification, FlexibleInstances #-}++-- |You only need to import this module to use this library.+-- This module exports all modules except "D3JS.Example"+module D3JS (+	module D3JS.Type+	, module D3JS.Func+	, module D3JS.Syntax+	, module D3JS.Reify+	, module D3JS.Chart+) where++import D3JS.Type+import D3JS.Func+import D3JS.Syntax+import D3JS.Reify+import D3JS.Chart
+ D3JS/Chart.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE OverloadedStrings,MultiParamTypeClasses,NoImplicitPrelude #-}++-- |This modules provides high-level functions for drawing common charts, such as bar charts and scatter plots.+--  Those functions also exemplify how to compose primitive functions to achieve complex drawing.+--  This module will be expanded in the near future.+module D3JS.Chart where++import D3JS.Type+import D3JS.Func+import D3JS.Syntax+import D3JS.Reify++import Prelude hiding ((.),id)+import Control.Category+import Data.Text (Text)+import qualified Data.Text as T++-- | box parent (w,h) makes an SVG container in a parent element with dimension w x h.+box :: Selector ->  (Double,Double) -> St (Var' Selection)+box parent (w,h) = do+	assign+		$ ((d3Root+			>>> select parent+			>>> func "append" [PText "svg"]+			>>> width w+			>>> height h+			>>> style "background" "#eef") :: Chain () Selection)++bars :: Int -> Double -> Data1D -> Var' Selection -> St ()+bars n width ps (Var' elem) = do+	let bar_w = width / (fromIntegral n)+	v <- assign $ Val' (mkRectData bar_w ps)+	execute $+		(Val elem :: Chain () Selection)+		>>> addRect v+		>>> fill "red"++scatter :: Data2D -> Var' Selection -> St (Var' (SelData Data2D))+scatter ps (Var' elem) = do+	v <- assign $ Val' ps+	cs <- assign $+		(Val elem :: Chain () Selection)+		>>> addCircles v+	return cs++-- | Add rectangles with an array of objects {x: x, y: y, width: w , height: h}+addRect :: Sel2 a => Var' RectData -> Chain a (SelData RectData)+addRect dat =+	selectAll "rect" >>> dataD3 dat >>> enter >>> appendD3 "rect"+	>>> attr "x" (funcExp _x)+	>>> attr "y" (funcExp _y)+	>>> attr "width" (funcExp $ Field "width" DataParam)+	>>> attr "height" (funcExp $ Field "height" DataParam)++mkRectData :: Double -> Data1D -> RectData+mkRectData bar_width (Data1D ps) =+	RectData $ flip map (zip ps [0..])$ \(v,i) ->+		(bar_width*i,300-v,bar_width*0.95,v)+++addCircles :: Sel2 a => Var' Data2D -> Chain a (SelData Data2D)+addCircles dat = +	selectAll "circle"+		>>> dataD3 dat+		>>> enter+		>>> appendD3 "circle"+		>>> attrt "class" "p"+		>>> attrd "r" 3+		>>> fill "blue"+		>>> attr "cx" (funcExp idx0)+		>>> attr "cy" (funcExp idx1)++-- | disappear delay duration+disappear :: (Sel2 a) => Double -> Double -> Var' a -> St ()+disappear delay_ duration var = do+	execute $+		Val'' var+		>>> transition' duration+		>>> attrd "r" 10+		>>> delay (PDouble delay_)+		>>> style "opacity" "0"++addFrame :: Sel2 a => (Double,Double) -> (Double,Double) -> Var' a -> St ()+addFrame (w,h) (w2,h2) box = do+	let dx = (w-w2)/2+	let dy = (h-h2)/2+	let sx = w2/w+	let sy = h2/h+	execute $+		Val'' box+		>>> selectAll ".p"  -- means data points.+		>>> transform' dx dy sx sy 0+	v <- assign $ Val' $ RectData [(dx,dy,w2,h2)]+	execute $+		Val'' box+		>>> addRect v+		>>> fill "none"+		>>> attrt "stroke" "black"+		>>> attrd "stroke-width" 1++data RectData = RectData [(Double,Double,Double,Double)] -- x,y,width,height+instance Reifiable RectData where+	reify (RectData vs) = surround $ T.intercalate "," $+		flip map vs $+			(\(x,y,w,h) -> T.concat ["{x:",show' x,",y:",show' y,",width:",show' w,",height:",show' h,"}"])++instance Assignable RectData where+	newVar = newVar' "dat"++
+ D3JS/Example.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE OverloadedStrings #-}++module D3JS.Example (+	test1+	, test2+	, test3+	, writeToHtml+) where++import D3JS++import Data.Text (Text)+import qualified Data.Text as T +import qualified Data.Text.IO as T+import Control.Monad+import System.Random++-- * Examples++-- | Scatter plot with a frame. Generate 'test1.html' file.+test1, test2, test3 :: IO ()+test1 = do+	ps <- rand2D 100+	writeToHtml "test1.html" (graph1 ps)++-- | Scatter plot with dissolving transition. Generate 'generated.js' file.+test2 = do+	ps <- rand2D 100+	writeToHtml "test2.html" (graph2 ps)++-- | Bar chart. Generate 'generated.js' file.+test3 = do+	ps <- replicateM 10 $ getStdRandom (randomR (100,300))+	writeToHtml "test3.html" (graph3 ps)++graph1,graph2 :: [(Double,Double)] -> St ()+graph3 :: [Double] -> St ()++graph1 ps = do+	let dim = (300,300)+	elem <- box "#div1" dim+	scatter (Data2D ps) elem+	addFrame dim (250,250) elem ++graph2 ps = box "#div1" (300,300) >>= scatter (Data2D ps) >>= disappear 500 1000++graph3 ps = do+	elem <- box "#div1" (300,300)+	bars 10 300 (Data1D ps) elem++rand2D :: Int -> IO [(Double,Double)]+rand2D n = do+	xs <- replicateM n $ getStdRandom (randomR (1,300))+	ys <- replicateM n $ getStdRandom (randomR (1,300))+	return (zip xs ys)++-- | Output a single excutable HTML file with embedded JS code.+writeToHtml :: (Reifiable a) => FilePath -> a -> IO ()+writeToHtml path a = T.writeFile path $ T.concat ["<html> <head><body> <div id='div1'></div> <script src='http://d3js.org/d3.v3.min.js' charset='utf-8'></script> <script charset='utf-8'>\n",reify a,"\n</script> </body> </html>"]+
+ D3JS/Func.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE OverloadedStrings #-}++-- |This module defines original functions of D3.js, as well as some low-level helper functions.+module D3JS.Func where++import D3JS.Type++import Data.List+import Data.Text (Text)+import qualified Data.Text as T ++import Prelude hiding ((.),id)+import Control.Category++-- * Selection++-- | d3 object in D3.js+d3Root :: Chain () Selection+d3Root = Val "d3"++-- | select() in D3.js+select :: Selector -> Chain Selection Selection+select = funct1 "select"++-- | selectAll()+selectAll :: Sel2 a => Selector -> Chain a Selection+selectAll = funct1 "selectAll"++-- * Data manipulation++-- | data() in D3.js. Assigns new data to selection.+dataD3 :: Var' r -> Chain Selection (SelData r)+dataD3 (Var' d) = func "data" [ParamVar d]++-- | enter()+enter :: Chain (SelData r) (SelData r)+enter = func "enter" []++-- | exit()+exit :: (Sel a) => Chain a a+exit = func "exit" []++-- | append()+appendD3 :: Text -> Chain (SelData a) (SelData a)+appendD3 = funct1 "append"++-- * Attributes and styles++attr :: Text -> JSParam -> Chain a a+attr key val = func' "attr" [PText key, val]++attrf :: Text -> JSParam -> Chain a a+attrf key val = func' "attr" [PText key, val]++attrt :: Text -> Text -> Chain a a+attrt key val = attr key (PText val)++attrd :: Text -> Double -> Chain a a+attrd key val = attr key (PDouble val)++style :: Text -> Text -> Chain a a+style key val = func' "style" [PText key, PText val]++-- | classed(). Take a list of classes as an argument.+classed :: [Text] -> Chain a a+classed kls = func' "classed" [PText (T.intercalate " " kls)]++property :: Text -> Text -> Chain a a+property key val = func' "property" [PText key, PText val]++text :: Text -> Chain a a+text val = func' "text" [PText val]++html :: Text -> Chain a a+html val = func' "html" [PText val]++width :: Double -> Chain a a+width v = attr "width" (PDouble v)++height :: Double -> Chain a a+height v = attr "height" (PDouble v)++transform = attrt "transform"++transform' :: Double -> Double -> Double -> Double -> Double -> Chain a a+transform' tx ty sx sy r =+	attrt "transform" $+		T.concat ["translate(",f tx, " ",f ty,") scale(",f sx, " ", f sy, ") rotate(",f r, ")"]+	where+		f v = T.pack $ show v++opacity :: Sel a => Double -> Chain a a+opacity = attrd "fill-opacity"++fill :: Sel a => Text -> Chain a a+fill = style "fill"++-- * Transitions++-- | transition()+transition :: (Sel2 a) => Chain a Transition+transition = func "transition" []++-- | trasition().delay(time)+transition' :: (Sel2 a) => Double -> Chain a Transition+transition' d = transition >>> funcd1 "duration" d++-- | delay()+delay :: JSParam -> Chain Transition Transition+delay v = func "delay" [v]++-- * Helper functions for Chain a b type++func :: FuncName -> [JSParam] -> Chain a b+func name params = Func $ JSFunc name params++funct1 name t = func name [PText t]++funcd1 name v = func name [PDouble v]++-- |Function that does not change type in a method chain.+func' :: FuncName -> [JSParam] -> Chain a a+func' = func++funcTxt :: Text -> JSParam+funcTxt = PFunc . FuncTxt++funcExp = PFunc . FuncExp
+ D3JS/Reify.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE OverloadedStrings, GADTs, FlexibleInstances #-}++module D3JS.Reify where++import Data.Text (Text)+import qualified Data.Text as T++import D3JS.Type++instance Reifiable Var where+	reify t = t++instance Reifiable (Chain a b) where+	reify (Val name) = name+	reify (Val' v) = reify v+	reify (Val'' (Var' n)) = n+	reify (Concat Nil g) = reify g+	reify (Concat f g) = T.concat [reify g,".",reify f] -- method chain flows from left to right, so flips f and g.+	reify (Func f) = reify f+	reify Nil = ""++-- instance Reifiable D3Root where+--	reify D3Root = "d3"++instance Reifiable Data1D where+	reify (Data1D ps) = surround $ T.intercalate "," $ map show' ps++instance Reifiable Data2D where+	reify (Data2D ps) = surround $ T.intercalate "," $ map (\(x,y) -> T.concat ["[",show' x,",",show' y,"]"]) ps++instance Reifiable (JSFunc a c b) where+	reify (JSFunc name params) = T.concat [name,"(",T.intercalate "," $ map reify params,")"]++instance Reifiable JSParam where+	reify (ParamVar name) = name+	reify (PText t) = T.concat ["\"",t,"\""]+	reify (PDouble d) = show' d+	reify (PFunc (FuncTxt t)) = t+	reify (PFunc (FuncExp f)) = T.concat["function(d){return ",reify f,";}"]+++instance Reifiable (NumFunc r) where+	reify DataParam = "d"+	reify (Index i ns) = T.concat [reify ns,"[",show' i,"]"]+	reify (Field name obj) = T.concat [reify obj,".",name]+	-- Stub: incomplete!!+++show' :: (Show a) => a -> Text+show' = T.pack . show++surround s = T.concat ["[",s,"]"]
+ D3JS/Syntax.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE OverloadedStrings,MultiParamTypeClasses,FlexibleInstances,ExistentialQuantification,TypeSynonymInstances #-}++module D3JS.Syntax where++import Data.Text (Text)+import qualified Data.Text as T++import D3JS.Type+import D3JS.Reify++import Control.Monad.RWS++-- | St (which means Statement) monad represents JavaScript statements.+-- "D3JS.Chart" uses St monad extensively.+type St r =  RWS () Text Int r++getUniqueNum :: St Int+getUniqueNum = do+	n <- get+	put (n+1)+	return n++instance Reifiable (St r) where+	reify st =+		let (a,s,w) = runRWS st () 0+		in w++-- Run a chain without assignment.+execute :: Chain () b -> St ()+execute chain = tell $ T.concat [reify chain,";\n"]++-- | d[0] as a user-defined function.+idx0 = Index 0 DataParam++-- | d[1] as a user-defined function.+idx1 = Index 1 DataParam++-- | d.x as a user-defined function.+_x = Field "x" DataParam++-- | d.y as a user-defined function.+_y = Field "y" DataParam++class Assignable a where+	newVar :: St (Var' a)++	assign :: Chain () a -> St (Var' a)+	assign chain = do+		v@(Var' n) <- newVar+		tell $ T.concat ["var ",n," = ",reify chain,";\n"]+		return v++instance Assignable Data2D where+	newVar = newVar' "dat"++instance Assignable (SelData Data2D) where+	newVar = newVar' "sel_dat"++instance Assignable Selection where+	newVar = newVar' "sel"++newVar' :: Text -> St (Var' a)+newVar' baseName = getUniqueNum >>= (return . Var' . T.append baseName . show')+
+ D3JS/Type.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE OverloadedStrings, GADTs, NoImplicitPrelude, ExistentialQuantification, FlexibleInstances #-}++module D3JS.Type where++import Data.Text (Text)+import qualified Data.Text as T++import Prelude hiding ((.),id)+import Control.Category ++-- * Types++-- |This represents a method chain with an initial type of `a` and a final type of `b`+-- Chains are composable by functions in "Control.Category" module.+-- See "D3JS.Chart" for examples.+data Chain a b where+	Val :: Var -> Chain () b+	Val' :: (Reifiable b) => b -> Chain () b+	Val'' :: Var' b -> Chain () b+	Func :: JSFunc a params b -> Chain a b+	Concat :: Chain c b -> Chain a c -> Chain a b+	Nil :: Chain a a++-- | Chain a b behaves just like (a -> b).+-- Val Var is the starting point of chain (= constant),+-- and Nil is the termination of chain.+instance Category Chain where+	id = Nil+	(.) = Concat++type Var = Text++type Selector = Text++-- data D3Root = D3Root++data Data1D = Data1D [Double]+data Data2D = Data2D [(Double,Double)]++data Selection = Selection++data SelData a = SelData+data Transition = Transition  -- this is just used as a tag for chaining functions with a type.++-- |Instances of Reifiable can generate a JavaScript code fragment.+class Reifiable a where+	reify :: a -> Text++-- |Used just as a tag for typing method chains. Used in "D3JS.Func".+class Sel a+instance Sel Selection+instance Sel (SelData a)++-- |Used just as a tag for typing method chains. Used in "D3JS.Func".+class Sel2 a+instance Sel2 Selection+instance Sel2 (SelData a)+instance Sel2 (Chain () b)++++-- * For internal use++-- | Function call+data JSFunc a c b = JSFunc FuncName [JSParam]  -- name and params++type FuncName = Text++-- | Parameter for a function call+data JSParam = ParamVar Var | PText Text | PDouble Double | PFunc FuncDef++-- | Function definition used for a callback.+data FuncDef = FuncTxt Text | forall r. FuncExp (NumFunc r)++-- | Representation of JavaScript function for a callback.+data NumFunc r where+	NInt :: Int -> NumFunc Int+	NDouble :: Double -> NumFunc Double+	Add :: NumFunc r -> NumFunc r -> NumFunc r+	Subt :: NumFunc r -> NumFunc r -> NumFunc r+	Mult :: NumFunc r -> NumFunc r -> NumFunc r+	Div :: NumFunc r -> NumFunc r -> NumFunc r+	Index :: Int -> NumFunc [r] -> NumFunc r+	Field :: Text -> NumFunc a -> NumFunc r+	NVar :: Var -> NumFunc r+	DataParam :: NumFunc r++-- |This should not be used directly by users. Users should use 'assign' to get a variable instead.+data Var' dat = Var' Var  -- typed variables+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Nebuta++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Nebuta nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ d3js.cabal view
@@ -0,0 +1,63 @@+name:                d3js+version:             0.1.0.0+synopsis:            Declarative visualization on a web browser with DSL approach.+description:+  A library for visualization on a web browser. This works as a DSL that generates JavaScript source code working with D3.js (http://d3js.org/) library.+  .+  You can compose operations with a typed DSL with Haskell's abstraction power.+  .+  This is still an alpha version, and the structure may be changed in the near future.+  .+  * A simplest example: drawing a bar chart+  .+  > import Control.Monad+  > import qualified Data.Text as T+  > import D3JS+  >+  > test :: Int -> IO ()+  > test n = T.writeFile "generated.js" $ reify (box "#div1" (300,300) >>= bars n 300 (Data1D [100,20,80,60,120]))+  .+  You can just put the JavaScript file in an HTML file like the following to show a chart.+  .+  > <html>+  > <head>+  >   <title>Chart</title>+  > </head>+  > <body>+  >   <div id='div1'></div>+  >   <script charset='utf-8' src='http://d3js.org/d3.v3.min.js'></script>+  >   <script charset='utf-8' src='generated.js'></script>+  > </body>+  > </html>+  .+  See "D3JS.Example" for more examples.++homepage:            https://github.com/nebuta/d3js-haskell+license:             BSD3+license-file:        LICENSE+author:              Nebuta+maintainer:          nebuta.office@gmail.com+-- copyright:           +category:            Graphics+build-type:          Simple+-- extra-source-files:  +stability: Experimental+cabal-version:       >=1.10++library+  exposed-modules:+                       D3JS+                       D3JS.Type+                       D3JS.Func+                       D3JS.Syntax+                       D3JS.Chart+                       D3JS.Reify+                       D3JS.Example+  -- other-modules:       +  -- other-extensions:    +  build-depends:       base >=4.6 && <4.7+                       , mtl+                       , text+                       , random+  -- hs-source-dirs:      +  default-language:    Haskell2010