Add integer widgets

ihaskell-display/ihaskell-widgets/ihaskell-widgets.cabal

@@ -57,6 +57,11 @@ library
   other-modules:       IHaskell.Display.Widgets.Button
                        IHaskell.Display.Widgets.Bool.CheckBox
                        IHaskell.Display.Widgets.Bool.ToggleButton
+                       IHaskell.Display.Widgets.Int.IntText
+                       IHaskell.Display.Widgets.Int.BoundedInt.BoundedIntText
+                       IHaskell.Display.Widgets.Int.BoundedInt.IntProgress
+                       IHaskell.Display.Widgets.Int.BoundedInt.IntSlider
+                       IHaskell.Display.Widgets.Int.BoundedIntRange.IntRangeSlider
                        IHaskell.Display.Widgets.Image
                        IHaskell.Display.Widgets.Output
                        IHaskell.Display.Widgets.Selection.Dropdown
@@ -86,6 +91,7 @@ library
                      , vinyl >= 0.5
                      , vector -any
                      , singletons >= 0.9.0
+                     , scientific -any
 
                        -- Waiting for the next release
                      , ihaskell -any

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets.hs

@@ -5,6 +5,12 @@ import           IHaskell.Display.Widgets.Button as X
 import           IHaskell.Display.Widgets.Bool.CheckBox as X
 import           IHaskell.Display.Widgets.Bool.ToggleButton as X
 
+import           IHaskell.Display.Widgets.Int.IntText as X
+import           IHaskell.Display.Widgets.Int.BoundedInt.BoundedIntText as X
+import           IHaskell.Display.Widgets.Int.BoundedInt.IntProgress as X
+import           IHaskell.Display.Widgets.Int.BoundedInt.IntSlider as X
+import           IHaskell.Display.Widgets.Int.BoundedIntRange.IntRangeSlider as X
+
 import           IHaskell.Display.Widgets.Image as X
 
 import           IHaskell.Display.Widgets.Output as X

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Common.hs

@@ -59,6 +59,18 @@ singletons [d|
              | Icons
              | SelectedLabels
              | SelectedValues
+             | IntValue
+             | StepInt
+             | MaxInt
+             | MinInt
+             | IntPairValue
+             | LowerInt
+             | UpperInt
+             | Orientation
+             | ShowRange
+             | ReadOut
+             | SliderColor
+             | BarStyle
              deriving (Eq, Ord, Show)
              |]
 
@@ -142,6 +154,20 @@ instance ToJSON ButtonStyleValue where
   toJSON DangerButton = "danger"
   toJSON DefaultButton = ""
 
+-- | Pre-defined bar styles
+data BarStyleValue = SuccessBar
+                   | InfoBar
+                   | WarningBar
+                   | DangerBar
+                   | DefaultBar
+
+instance ToJSON BarStyleValue where
+  toJSON SuccessBar = "success"
+  toJSON InfoBar = "info"
+  toJSON WarningBar = "warning"
+  toJSON DangerBar = "danger"
+  toJSON DefaultBar = ""
+
 -- | Image formats for ImageWidget
 data ImageFormatValue = PNG
                       | SVG
@@ -159,5 +185,10 @@ instance ToJSON ImageFormatValue where
 -- | Options for selection widgets.
 data SelectionOptions = OptionLabels [Text] | OptionDict [(Text, Text)]
 
+-- | Orientation values.
+data OrientationValue = HorizontalOrientation
+                      | VerticalOrientation
 
-
+instance ToJSON OrientationValue where
+  toJSON HorizontalOrientation = "horizontal"
+  toJSON VerticalOrientation = "vertical"

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/BoundedInt/BoundedIntText.hs

+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+module IHaskell.Display.Widgets.Int.BoundedInt.BoundedIntText (
+  -- * The BoundedIntText Widget
+  BoundedIntTextWidget,
+  -- * Constructor
+  mkBoundedIntTextWidget) where
+
+-- To keep `cabal repl` happy when running from the ihaskell repo
+import           Prelude
+
+import           Control.Exception (throw, ArithException (LossOfPrecision))
+import           Control.Monad (when, join)
+import           Data.Aeson
+import qualified Data.HashMap.Strict as HM
+import           Data.IORef (newIORef)
+import qualified Data.Scientific as Sci
+import           Data.Text (Text)
+import           Data.Vinyl (Rec(..), (<+>))
+
+import           IHaskell.Display
+import           IHaskell.Eval.Widgets
+import           IHaskell.IPython.Message.UUID as U
+
+import           IHaskell.Display.Widgets.Types
+import           IHaskell.Display.Widgets.Common
+
+-- | 'BoundedIntTextWidget' represents an BoundedIntText widget from IPython.html.widgets.
+type BoundedIntTextWidget = IPythonWidget BoundedIntTextType
+
+-- | Create a new widget
+mkBoundedIntTextWidget :: IO BoundedIntTextWidget
+mkBoundedIntTextWidget = do
+  -- Default properties, with a random uuid
+  uuid <- U.random
+
+  let widgetState = WidgetState $ defaultBoundedIntWidget "IntTextView"
+
+  stateIO <- newIORef widgetState
+
+  let widget = IPythonWidget uuid stateIO
+      initData = object
+                   [ "model_name" .= str "WidgetModel"
+                   , "widget_class" .= str "IPython.BoundedIntText"
+                   ]
+
+  -- Open a comm for this widget, and store it in the kernel state
+  widgetSendOpen widget initData $ toJSON widgetState
+
+  -- Return the widget
+  return widget
+
+instance IHaskellDisplay BoundedIntTextWidget where
+  display b = do
+    widgetSendView b
+    return $ Display []
+
+instance IHaskellWidget BoundedIntTextWidget where
+  getCommUUID = uuid
+  comm widget (Object dict1) _ = do
+    let key1 = "sync_data" :: Text
+        key2 = "value" :: Text
+        Just (Object dict2) = HM.lookup key1 dict1
+        Just (Number value) = HM.lookup key2 dict2
+    newValue <- if abs value < 10 ^ 16
+                  then return (Sci.coefficient value)
+                  else throw LossOfPrecision
+    setField' widget SIntValue newValue

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/BoundedInt/IntProgress.hs

+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+module IHaskell.Display.Widgets.Int.BoundedInt.IntProgress (
+  -- * The IntProgress Widget
+  IntProgressWidget,
+  -- * Constructor
+  mkIntProgressWidget) where
+
+-- To keep `cabal repl` happy when running from the ihaskell repo
+import           Prelude
+
+import           Control.Exception (throw, ArithException (LossOfPrecision))
+import           Control.Monad (when, join)
+import           Data.Aeson
+import qualified Data.HashMap.Strict as HM
+import           Data.IORef (newIORef)
+import qualified Data.Scientific as Sci
+import           Data.Text (Text)
+import           Data.Vinyl (Rec(..), (<+>))
+
+import           IHaskell.Display
+import           IHaskell.Eval.Widgets
+import           IHaskell.IPython.Message.UUID as U
+
+import           IHaskell.Display.Widgets.Types
+import           IHaskell.Display.Widgets.Common
+
+-- | 'IntProgressWidget' represents an IntProgress widget from IPython.html.widgets.
+type IntProgressWidget = IPythonWidget IntProgressType
+
+-- | Create a new widget
+mkIntProgressWidget :: IO IntProgressWidget
+mkIntProgressWidget = do
+  -- Default properties, with a random uuid
+  uuid <- U.random
+
+  let boundedIntAttrs = defaultBoundedIntWidget "ProgressView"
+      progressAttrs = (SBarStyle =:: DefaultBar) :& RNil
+      widgetState = WidgetState $ boundedIntAttrs <+> progressAttrs
+
+  stateIO <- newIORef widgetState
+
+  let widget = IPythonWidget uuid stateIO
+      initData = object
+                   [ "model_name" .= str "WidgetModel"
+                   , "widget_class" .= str "IPython.IntProgress"
+                   ]
+
+  -- Open a comm for this widget, and store it in the kernel state
+  widgetSendOpen widget initData $ toJSON widgetState
+
+  -- Return the widget
+  return widget
+
+instance IHaskellDisplay IntProgressWidget where
+  display b = do
+    widgetSendView b
+    return $ Display []
+
+instance IHaskellWidget IntProgressWidget where
+  getCommUUID = uuid

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/BoundedInt/IntSlider.hs

+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+module IHaskell.Display.Widgets.Int.BoundedInt.IntSlider (
+  -- * The IntSlider Widget
+  IntSliderWidget,
+  -- * Constructor
+  mkIntSliderWidget) where
+
+-- To keep `cabal repl` happy when running from the ihaskell repo
+import           Prelude
+
+import           Control.Exception (throw, ArithException (LossOfPrecision))
+import           Control.Monad (when, join)
+import           Data.Aeson
+import qualified Data.HashMap.Strict as HM
+import           Data.IORef (newIORef)
+import qualified Data.Scientific as Sci
+import           Data.Text (Text)
+import           Data.Vinyl (Rec(..), (<+>))
+
+import           IHaskell.Display
+import           IHaskell.Eval.Widgets
+import           IHaskell.IPython.Message.UUID as U
+
+import           IHaskell.Display.Widgets.Types
+import           IHaskell.Display.Widgets.Common
+
+-- | 'IntSliderWidget' represents an IntSlider widget from IPython.html.widgets.
+type IntSliderWidget = IPythonWidget IntSliderType
+
+-- | Create a new widget
+mkIntSliderWidget :: IO IntSliderWidget
+mkIntSliderWidget = do
+  -- Default properties, with a random uuid
+  uuid <- U.random
+
+  let boundedIntAttrs = defaultBoundedIntWidget "IntSliderView"
+      sliderAttrs = (SOrientation =:: HorizontalOrientation)
+                 :& (SShowRange =:: False)
+                 :& (SReadOut =:: True)
+                 :& (SSliderColor =:: "")
+                 :& RNil
+      widgetState = WidgetState $ boundedIntAttrs <+> sliderAttrs
+
+  stateIO <- newIORef widgetState
+
+  let widget = IPythonWidget uuid stateIO
+      initData = object
+                   [ "model_name" .= str "WidgetModel"
+                   , "widget_class" .= str "IPython.IntSlider"
+                   ]
+
+  -- Open a comm for this widget, and store it in the kernel state
+  widgetSendOpen widget initData $ toJSON widgetState
+
+  -- Return the widget
+  return widget
+
+instance IHaskellDisplay IntSliderWidget where
+  display b = do
+    widgetSendView b
+    return $ Display []
+
+instance IHaskellWidget IntSliderWidget where
+  getCommUUID = uuid
+  comm widget (Object dict1) _ = do
+    let key1 = "sync_data" :: Text
+        key2 = "value" :: Text
+        Just (Object dict2) = HM.lookup key1 dict1
+        Just (Number value) = HM.lookup key2 dict2
+    newValue <- if abs value < 10 ^ 16
+                  then return (Sci.coefficient value)
+                  else throw LossOfPrecision
+    setField' widget SIntValue newValue

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/BoundedIntRange/IntRangeSlider.hs

+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+module IHaskell.Display.Widgets.Int.BoundedIntRange.IntRangeSlider (
+  -- * The IntRangeSlider Widget
+  IntRangeSliderWidget,
+  -- * Constructor
+  mkIntRangeSliderWidget) where
+
+-- To keep `cabal repl` happy when running from the ihaskell repo
+import           Prelude
+
+import           Control.Exception (throw, ArithException (LossOfPrecision))
+import           Control.Monad (when, join)
+import           Data.Aeson
+import qualified Data.HashMap.Strict as HM
+import           Data.IORef (newIORef)
+import qualified Data.Scientific as Sci
+import           Data.Text (Text)
+import qualified Data.Vector as V
+import           Data.Vinyl (Rec(..), (<+>))
+
+import           IHaskell.Display
+import           IHaskell.Eval.Widgets
+import           IHaskell.IPython.Message.UUID as U
+
+import           IHaskell.Display.Widgets.Types
+import           IHaskell.Display.Widgets.Common
+
+-- | 'IntRangeSliderWidget' represents an IntRangeSlider widget from IPython.html.widgets.
+type IntRangeSliderWidget = IPythonWidget IntRangeSliderType
+
+-- | Create a new widget
+mkIntRangeSliderWidget :: IO IntRangeSliderWidget
+mkIntRangeSliderWidget = do
+  -- Default properties, with a random uuid
+  uuid <- U.random
+
+  let boundedIntAttrs = defaultBoundedIntRangeWidget "IntSliderView"
+      sliderAttrs = (SOrientation =:: HorizontalOrientation)
+                 :& (SShowRange =:: True)
+                 :& (SReadOut =:: True)
+                 :& (SSliderColor =:: "")
+                 :& RNil
+      widgetState = WidgetState $ boundedIntAttrs <+> sliderAttrs
+
+  stateIO <- newIORef widgetState
+
+  let widget = IPythonWidget uuid stateIO
+      initData = object
+                   [ "model_name" .= str "WidgetModel"
+                   , "widget_class" .= str "IPython.IntRangeSlider"
+                   ]
+
+  -- Open a comm for this widget, and store it in the kernel state
+  widgetSendOpen widget initData $ toJSON widgetState
+
+  -- Return the widget
+  return widget
+
+instance IHaskellDisplay IntRangeSliderWidget where
+  display b = do
+    widgetSendView b
+    return $ Display []
+
+instance IHaskellWidget IntRangeSliderWidget where
+  getCommUUID = uuid
+  comm widget (Object dict1) _ = do
+    let key1 = "sync_data" :: Text
+        key2 = "value" :: Text
+        Just (Object dict2) = HM.lookup key1 dict1
+        Just (Array values) = HM.lookup key2 dict2
+        [x, y] = map (\(Number x) -> Sci.coefficient x) $ V.toList values
+    setField' widget SIntPairValue (x, y)

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/IntText.hs

+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+module IHaskell.Display.Widgets.Int.IntText (
+  -- * The IntText Widget
+  IntTextWidget,
+  -- * Constructor
+  mkIntTextWidget) where
+
+-- To keep `cabal repl` happy when running from the ihaskell repo
+import           Prelude
+
+import           Control.Exception (throw, ArithException (LossOfPrecision))
+import           Control.Monad (when, join)
+import           Data.Aeson
+import qualified Data.HashMap.Strict as HM
+import           Data.IORef (newIORef)
+import qualified Data.Scientific as Sci
+import           Data.Text (Text)
+import           Data.Vinyl (Rec(..), (<+>))
+
+import           IHaskell.Display
+import           IHaskell.Eval.Widgets
+import           IHaskell.IPython.Message.UUID as U
+
+import           IHaskell.Display.Widgets.Types
+import           IHaskell.Display.Widgets.Common
+
+-- | 'IntTextWidget' represents an IntText widget from IPython.html.widgets.
+type IntTextWidget = IPythonWidget IntTextType
+
+-- | Create a new widget
+mkIntTextWidget :: IO IntTextWidget
+mkIntTextWidget = do
+  -- Default properties, with a random uuid
+  uuid <- U.random
+
+  let widgetState = WidgetState $ defaultIntWidget "IntTextView"
+
+  stateIO <- newIORef widgetState
+
+  let widget = IPythonWidget uuid stateIO
+      initData = object ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.IntText"]
+
+  -- Open a comm for this widget, and store it in the kernel state
+  widgetSendOpen widget initData $ toJSON widgetState
+
+  -- Return the widget
+  return widget
+
+instance IHaskellDisplay IntTextWidget where
+  display b = do
+    widgetSendView b
+    return $ Display []
+
+instance IHaskellWidget IntTextWidget where
+  getCommUUID = uuid
+  comm widget (Object dict1) _ = do
+    let key1 = "sync_data" :: Text
+        key2 = "value" :: Text
+        Just (Object dict2) = HM.lookup key1 dict1
+        Just (Number value) = HM.lookup key2 dict2
+    newValue <- if abs value < 10 ^ 16
+                  then return (Sci.coefficient value)
+                  else throw LossOfPrecision
+    setField' widget SIntValue newValue

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Types.hs

@@ -79,6 +79,10 @@ type SelectionClass = DOMWidgetClass :++
    '[Options, SelectedValue, SelectedLabel, Disabled, Description, SelectionHandler]
 type MultipleSelectionClass = DOMWidgetClass :++
    '[Options, SelectedLabels, SelectedValues, Disabled, Description, SelectionHandler]
+type IntClass = DOMWidgetClass :++ '[IntValue, Disabled, Description]
+type BoundedIntClass = IntClass :++ '[StepInt, MinInt, MaxInt]
+type IntRangeClass = IntClass :++ '[IntPairValue, LowerInt, UpperInt]
+type BoundedIntRangeClass = IntRangeClass :++ '[StepInt, MinInt, MaxInt]
 
 -- Types associated with Fields.
 type family FieldType (f :: Field) :: * where
@@ -126,6 +130,18 @@ type family FieldType (f :: Field) :: * where
   FieldType Icons = [Text]
   FieldType SelectedLabels = [Text]
   FieldType SelectedValues = [Text]
+  FieldType IntValue = Integer
+  FieldType StepInt = Natural
+  FieldType MinInt = Int
+  FieldType MaxInt = Int
+  FieldType LowerInt = Int
+  FieldType UpperInt = Int
+  FieldType IntPairValue = (Integer, Integer)
+  FieldType Orientation = OrientationValue
+  FieldType ShowRange = Bool
+  FieldType ReadOut = Bool
+  FieldType SliderColor = Text
+  FieldType BarStyle = BarStyleValue
 
 -- Different types of widgets. Every widget in IPython has a corresponding WidgetType
 data WidgetType = ButtonType
@@ -142,6 +158,11 @@ data WidgetType = ButtonType
                 | SelectType
                 | ToggleButtonsType
                 | SelectMultipleType
+                | IntTextType
+                | BoundedIntTextType
+                | IntSliderType
+                | IntProgressType
+                | IntRangeSliderType
 
 -- Fields associated with a widget
 type family WidgetFields (w :: WidgetType) :: [Field] where
@@ -159,6 +180,11 @@ type family WidgetFields (w :: WidgetType) :: [Field] where
   WidgetFields SelectType = SelectionClass
   WidgetFields ToggleButtonsType = SelectionClass :++ '[Tooltips, Icons, ButtonStyle]
   WidgetFields SelectMultipleType = MultipleSelectionClass
+  WidgetFields IntTextType = IntClass
+  WidgetFields BoundedIntTextType = BoundedIntClass
+  WidgetFields IntSliderType = BoundedIntClass :++ '[Orientation, ShowRange, ReadOut, SliderColor]
+  WidgetFields IntProgressType = BoundedIntClass :++ '[BarStyle]
+  WidgetFields IntRangeSliderType = BoundedIntRangeClass :++ '[Orientation, ShowRange, ReadOut, SliderColor]
 
 -- Wrapper around a field
 newtype Attr (f :: Field) = Attr { _unAttr :: FieldType f }
@@ -216,6 +242,18 @@ instance ToPairs (Attr Tooltips) where toPairs (Attr x) = ["tooltips" .= toJSON
 instance ToPairs (Attr Icons) where toPairs (Attr x) = ["icons" .= toJSON x]
 instance ToPairs (Attr SelectedLabels) where toPairs (Attr x) = ["selected_labels" .= toJSON x]
 instance ToPairs (Attr SelectedValues) where toPairs (Attr x) = ["values" .= toJSON x]
+instance ToPairs (Attr IntValue) where toPairs (Attr x) = ["value" .= toJSON x]
+instance ToPairs (Attr StepInt) where toPairs (Attr x) = ["step" .= toJSON x]
+instance ToPairs (Attr MinInt) where toPairs (Attr x) = ["min" .= toJSON x]
+instance ToPairs (Attr MaxInt) where toPairs (Attr x) = ["max" .= toJSON x]
+instance ToPairs (Attr IntPairValue) where toPairs (Attr x) = ["value" .= toJSON x]
+instance ToPairs (Attr LowerInt) where toPairs (Attr x) = ["min" .= toJSON x]
+instance ToPairs (Attr UpperInt) where toPairs (Attr x) = ["max" .= toJSON x]
+instance ToPairs (Attr Orientation) where toPairs (Attr x) = ["orientation" .= toJSON x]
+instance ToPairs (Attr ShowRange) where toPairs (Attr x) = ["_range" .= toJSON x]
+instance ToPairs (Attr ReadOut) where toPairs (Attr x) = ["readout" .= toJSON x]
+instance ToPairs (Attr SliderColor) where toPairs (Attr x) = ["slider_color" .= toJSON x]
+instance ToPairs (Attr BarStyle) where toPairs (Attr x) = ["bar_style" .= toJSON x]
 
 -- | Store the value for a field, as an object parametrized by the Field
 (=::) :: sing f -> FieldType f -> Attr f
@@ -293,6 +331,38 @@ defaultMultipleSelectionWidget viewName = defaultDOMWidget viewName <+> mulSelAt
                    :& (SSelectionHandler =:: return ())
                    :& RNil
 
+-- | A record representing a widget of the _Int class from IPython
+defaultIntWidget :: FieldType ViewName -> Rec Attr IntClass
+defaultIntWidget viewName = defaultDOMWidget viewName <+> intAttrs
+  where intAttrs = (SIntValue =:: 0)
+                :& (SDisabled =:: False)
+                :& (SDescription =:: "")
+                :& RNil
+
+-- | A record representing a widget of the _BoundedInt class from IPython
+defaultBoundedIntWidget :: FieldType ViewName -> Rec Attr BoundedIntClass
+defaultBoundedIntWidget viewName = defaultIntWidget viewName <+> boundedIntAttrs
+  where boundedIntAttrs = (SStepInt =:: 1)
+                       :& (SMinInt =:: 0)
+                       :& (SMaxInt =:: 100)
+                       :& RNil
+
+-- | A record representing a widget of the _BoundedInt class from IPython
+defaultIntRangeWidget :: FieldType ViewName -> Rec Attr IntRangeClass
+defaultIntRangeWidget viewName = defaultIntWidget viewName <+> rangeAttrs
+  where rangeAttrs = (SIntPairValue =:: (25, 75))
+                  :& (SLowerInt =:: 0)
+                  :& (SUpperInt =:: 100)
+                  :& RNil
+
+-- | A record representing a widget of the _BoundedIntRange class from IPython
+defaultBoundedIntRangeWidget :: FieldType ViewName -> Rec Attr BoundedIntRangeClass
+defaultBoundedIntRangeWidget viewName = defaultIntRangeWidget viewName <+> boundedIntRangeAttrs
+  where boundedIntRangeAttrs = (SStepInt =:: 1)
+                            :& (SMinInt =:: 0)
+                            :& (SMaxInt =:: 100)
+                            :& RNil
+
 newtype WidgetState w = WidgetState { _getState :: Rec Attr (WidgetFields w) }
 
 -- All records with ToPair instances for their Attrs will automatically have a toJSON instance now.
@@ -326,9 +396,8 @@ str :: String -> String
 str = id
 
 -- | Send zero values as empty strings, which stands for default value in the frontend.
+-- Sending non-zero naturals as strings causes issues in the frontend. Specifically, addition
+-- becomes string concatenation which creates problems in {Int|Float}RangeSlider.
 instance ToJSON Natural where
   toJSON 0 = String ""
-  toJSON n = String . pack $ show n
-
-
-
+  toJSON n = Number . fromInteger $ toInteger n