diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,2 +1,5 @@ +- 0.2.0.0 + * Using the Text.DocL.Javascript module instead of aeson + (since not everything we want to ship to C3.js is JSON encodable). - 0.1.1.0 * Bumped blaze-html dependency to <0.9. diff --git a/src/Text/DocL.hs b/src/Text/DocL.hs --- a/src/Text/DocL.hs +++ b/src/Text/DocL.hs @@ -30,10 +30,11 @@ Column, col, col', plot, plot', rawPlot, -- * Utilities - linspace + linspace, + -- * Re-exports from "Text.DocL.Javascript" + (/:), javascript ) where -import Data.Aeson (ToJSON, object, toJSON, (.=)) import Data.Foldable import Data.HashMap.Strict (insert, unionWith) import Data.Monoid @@ -41,15 +42,15 @@ import Data.String (IsString (..)) import Text.Blaze.Html.Renderer.Utf8 (renderHtml) import Text.Blaze.Html5 ((!)) +import Text.DocL.Javascript -import qualified Text.Markdown as Markdown -import qualified Data.Aeson as Aeson +import qualified Data.ByteString.Lazy as B import qualified System.IO as IO import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A -import qualified Data.ByteString.Lazy as B +import qualified Text.Markdown as Markdown -data Node = Chart Aeson.Value | Html H.Html +data Node = Chart [Prop] | Html H.Html -- | Base type representing a document. This type allows composition via the -- 'Monoid' instance. @@ -59,19 +60,14 @@ -- details. data Column a = Column { _header :: String - , _extract :: a -> Aeson.Value + , _extract :: a -> Obj } --- | Deep merge of two 'Aeson.Value's. Used to merge in options in 'plot''. -merge :: Aeson.Value -> Aeson.Value -> Aeson.Value -merge (Aeson.Object x) (Aeson.Object y) = Aeson.Object $ unionWith merge x y -merge _ x = x - -- | Polymorphic version of 'col'. This allows, for instance, 'Int' and 'String' -- values to be used in plots. It is up to the caller to ensure that the values -- make sense to . -col' :: ToJSON b => String -> (a -> b) -> Column a -col' h f = Column h (toJSON . f) +col' :: ToObj b => String -> (a -> b) -> Column a +col' h f = Column h (toObj . f) -- | Data sets are supplied to 'plot' as a collection of elements of type /a/. -- This function sets up a 'Column', which knows how to extract one 'Double' @@ -95,38 +91,38 @@ -- Plots the data in /ds/ using the column /x/ for the values on the /x/-axis -- and with one line on the plot for each column in /ys/. See also 'col'. plot :: Foldable f => f a -> Column a -> [Column a] -> Doc -plot d x ys = plot' d x ys (Aeson.Object mempty) +plot d x ys = plot' d x ys [] --- | Same as 'plot', but takes a final argument which should be a "Data.Aeson" --- object. This is merged with the configuration object supplied to --- . This allows the caller to customize the plot. +-- | Same as 'plot', but takes a final argument which is merged with the +-- configuration object supplied to . This allows the +-- caller to customize the plot. -- -- @ -- -- Plot x² vs x with the points hidden. -- plot' [1..10] (col "x" id) [col "x²" $ \\x -> x*x] $ --- object ["point" .= object ["show" .= False]] +-- ["point" //: ["show" //: False]] -- @ -- -- See for the many properties that can be used -- here. -plot' :: Foldable f => f a -> Column a -> [Column a] -> Aeson.Value -> Doc -plot' d x ys options = rawPlot $ merge obj options +plot' :: Foldable f => f a -> Column a -> [Column a] -> [Prop] -> Doc +plot' d x ys options = rawPlot $ obj ++ options where - obj = object - [ "data" .= object - [ "rows" .= (toJSON (_header x : map _header ys) : map f (toList d)) - , "x" .= _header x + obj = + [ "data" /: + [ "rows" /: (toObj (_header x : map _header ys) : map f (toList d)) + , "x" /: _header x ] ] - f p = toJSON $ map (`_extract` p) (x:ys) + f p = toObj $ map (`_extract` p) (x:ys) --- | This function sends the supplied json object directly to +-- | This function sends an object with the supplied properties directly to -- . This is the do-it-yourself option which exposes all -- of . The object receives a -- property, -- targeting a @\@ tag placed appropriately. -rawPlot :: Aeson.ToJSON a => a -> Doc -rawPlot = Doc . singleton . Chart . Aeson.toJSON +rawPlot :: [Prop] -> Doc +rawPlot = Doc . singleton . Chart -- | Creates a 'Doc' representing raw html. html :: H.Html -> Doc @@ -162,15 +158,14 @@ H.body $ foldMap f (zip [(0::Int)..] $ toList doc) f (_, (Html t)) = t - f (i, (Chart v)) = divTag <> scriptTag + f (i, (Chart props)) = divTag <> scriptTag where name = "plot" <> show i divTag = H.div ! A.id (fromString name) $ mempty - (Aeson.Object obj) = v - obj' = insert "bindto" (fromString $ "#" <> name) obj - json = H.unsafeLazyByteString $ Aeson.encode obj' + obj = props ++ ["bindto" /: ("#" ++ name)] + js = encode $ toObj obj scriptTag = H.script ! A.type_ "text/javascript" $ - H.preEscapedToMarkup $ "c3.generate(" <> json <> ");" + H.preEscapedToMarkup $ "\nc3.generate(" <> js <> ");\n" -- | If the file exists, it will be overwritten. renderToFile :: FilePath -> Doc -> IO () diff --git a/src/Text/DocL/Javascript.hs b/src/Text/DocL/Javascript.hs new file mode 100644 --- /dev/null +++ b/src/Text/DocL/Javascript.hs @@ -0,0 +1,136 @@ +module Text.DocL.Javascript ( +-- * Rationale +-- | This is basically a JSON encoding library, however it goes beyond JSON by +-- allowing raw javascript to be used as a value. This allows, for instance, +-- function calls and anonymous functions to be placed in the data when used in +-- a javascript context. This is needed to expose some options in +-- , e.g. customizing tick formatting. + +-- * The 'Obj' type + Obj, + ToObj (..), +-- * Constructing javascript types + Prop, (/:), javascript, +-- * Encoding + encode, +-- * Miscellanea + merge + ) where + +import Data.Char (isControl, ord) +import Data.Foldable hiding (elem) +import Data.List (intersperse) +import Data.Monoid +import Data.String (IsString (..)) +import Data.Text.Lazy (Text) +import Text.Printf (printf) + +import qualified Data.HashMap.Strict as Map +import qualified Data.Text.Lazy as T +import qualified Data.Text.Lazy.Builder as B + +-- | A key\/value pair created with the '/:'-operator. +-- +-- A list of type ['Prop'] can be converted to an object using 'toObj'. If the +-- list contains duplicate keys, then 'merge' is used to combine the values. +-- +-- >>> toObj ["legs" /: 4, "ears" /: "floppy"] +-- {"ears":"floppy","legs":4} +data Prop = Prop Text Obj + +-- | Represents a javascript object or scalar value. +data Obj = Obj (Map.HashMap Text Obj) | List [Obj] | Scalar Text + +instance IsString Obj where + fromString = toObj + +-- | /'show' x/ returns /x/ encoded. +instance Show Obj where + show = T.unpack . encode + +-- | Class of types that can be converted to an 'Obj'. +class ToObj a where + -- | Converts to an 'Obj'. + toObj :: a -> Obj + + -- | Only for writing instances. This function serves the same role as + -- 'showList' + toObjList :: [a] -> Obj + toObjList = List . map toObj + +-- | A ['Prop'] becomes a javascript object. +instance ToObj Prop where + toObj x = toObj [x] + toObjList = Obj . Map.fromListWith merge . map (\(Prop k v) -> (k, v)) + +-- | Becomes a javascript array. +instance ToObj a => ToObj [a] where + toObj = toObjList + +-- | Constructs a 'Prop'. +-- +-- >>> toObj ["tail" /: True, "nose" /: "wet"] +-- {"nose":"wet","tail":true} +(/:) :: ToObj a => String -> a -> Prop +k /: v = Prop (fromString k) $ toObj v + +-- | /'merge' x y/ returns /y/ unless both /x/ and /y/ are javascript objects, +-- in which case the properties of the two are merged using 'merge' recursively +-- for duplicate keys. +merge :: Obj -> Obj -> Obj +merge (Obj x) (Obj y) = Obj $ Map.unionWith merge x y +merge _ x = x + +-- | Raw unescaped javascript. +-- +-- >>> toObj ["speak" /: javascript "function(){alert('Woof!');}"] +-- {"speak":function(){alert('Woof!');}} +javascript :: String -> Obj +javascript = Scalar . fromString + +-- | 'ToObj' is the identity for an 'Obj' value. +instance ToObj Obj where + toObj = id + +instance ToObj Double where + -- This trivial implementation even handles NaN and Infinity correctly. + toObj = Scalar . fromString . show +instance ToObj Int where + toObj = Scalar . fromString . show +instance ToObj Integer where + toObj = Scalar . fromString . show + +-- | Becomes a javascript /null/ object +instance ToObj () where + toObj () = Scalar "null" + +instance ToObj Bool where + toObj x = Scalar $ if x then "true" else "false" + +-- | A 'String' becomes a javascript string literal. +instance ToObj Char where + toObj c = toObj [c] + toObjList xs = Scalar . B.toLazyText $ "\"" <> foldMap esc xs <> "\"" + where + mustEscape = "\"\\>\n\r\x2028\x2029" + esc x = + if isControl x || elem x mustEscape + then fromString . printf "\\u%04x" $ ord x + else B.singleton x + +-- | Becomes a javascript string literal. +instance ToObj Text where + toObj = toObj . T.unpack + +-- | Encode an 'Obj' to a lazy 'Text'. +encode :: Obj -> Text +encode = B.toLazyText . encode' + +encode' :: Obj -> B.Builder +encode' obj = case obj of + Scalar x -> B.fromLazyText x + List xs -> "[" <> commas (map encode' xs) <> "]" + Obj m -> "{" <> commas (map f $ Map.toList m) <> "}" + where + commas = fold . intersperse "," + f (k, v) = encode' (toObj k) <> ":" <> encode' v diff --git a/text-and-plots.cabal b/text-and-plots.cabal --- a/text-and-plots.cabal +++ b/text-and-plots.cabal @@ -1,5 +1,5 @@ name: text-and-plots -version: 0.1.1.0 +version: 0.2.0.0 synopsis: EDSL to create HTML documents with plots based on the C3.js library. description: @@ -8,6 +8,7 @@ for an introduction. homepage: https://github.com/andersjel/haskell-text-and-plots +bug-reports: https://github.com/andersjel/haskell-text-and-plots/issues license: MIT license-file: LICENSE author: Anders Jellinggaard @@ -16,7 +17,7 @@ category: Text build-type: Simple cabal-version: >=1.10 -Extra-source-files: +extra-source-files: CHANGELOG source-repository head @@ -26,19 +27,20 @@ source-repository this type: git location: git://github.com/andersjel/haskell-text-and-plots.git - tag: v0.1.1.0 + tag: v0.2.0.0 library exposed-modules: Text.DocL + Text.DocL.Javascript build-depends: - aeson >=0.8.0.0 && <0.9, base >=4.7.0.0 && <4.8, blaze-html >=0.7.0.0 && <0.9, bytestring >=0.10.4.0 && <0.11, containers >=0.5.5.1 && <0.6, markdown >=0.1.7.1 && <0.2, - unordered-containers >=0.2.3.3 && <0.3 + unordered-containers >=0.2.3.3 && <0.3, + text >=1.2.0.2 && <1.3 hs-source-dirs: src default-language: Haskell2010 default-extensions: