Formatting + Remove cruft

- Reformat according to hindent
- Remove String.hs

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

@@ -7,4 +7,4 @@ import           IHaskell.Display.Widgets.String.Latex as X
 import           IHaskell.Display.Widgets.String.Text as X
 import           IHaskell.Display.Widgets.String.TextArea as X
 
-import           IHaskell.Display.Widgets.Common as X (ButtonStyle (..))
+import           IHaskell.Display.Widgets.Common as X (ButtonStyle(..))

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

@@ -40,7 +40,7 @@ import           IHaskell.Eval.Widgets
 import qualified IHaskell.IPython.Message.UUID as U
 import           IHaskell.Types (WidgetMethod(..))
 
-import           IHaskell.Display.Widgets.Common (ButtonStyle (..))
+import           IHaskell.Display.Widgets.Common (ButtonStyle(..))
 
 -- | A 'Button' represents a Button from IPython.html.widgets.
 data Button =

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

 {-# LANGUAGE OverloadedStrings #-}
 
 module IHaskell.Display.Widgets.Common (
-    -- * Predefined button styles
-    ButtonStyle(..),
-    ) where
+-- * Predefined button styles
+ButtonStyle(..)) where
 
-import Data.Aeson (ToJSON (..))
+import           Data.Aeson (ToJSON(..))
 
 -- | Pre-defined button-styles
 data ButtonStyle = Primary

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

-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE OverloadedStrings #-}
-module IHaskell.Display.Widgets.String (
-    -- * The String Widgets
-    HTMLWidget,
-    LatexWidget,
-    TextWidget,
-    TextAreaWidget,
-    -- * Create a new button
-    mkButton,
-    -- * Set button properties
-    setStrWidgetButtonStyle,
-    setStrWidgetText,
-    -- * Get button properties
-    getStrWidgetButtonStyle,
-    getStrWidgetText,
-    ) where
-
--- To keep `cabal repl` happy when running from the ihaskell repo
-import           Prelude
-
-import           Control.Monad (when)
-import           Data.Aeson (ToJSON, Value(..), object, toJSON, (.=))
-import           Data.Aeson.Types (Pair)
-import           Data.HashMap.Strict as Map
-import           Data.IORef
-import           Data.Text (Text)
-import qualified Data.Text as T
-import           System.IO.Unsafe (unsafePerformIO)
-
-import           IHaskell.Display
-import           IHaskell.Eval.Widgets
-import qualified IHaskell.IPython.Message.UUID as U
-
-import           IHaskell.Display.Widgets.Common (ButtonStyle (..))
-
-data ViewName = HTMLView | LatexView | TextView | TextareaView
-
-data StringWidget =
-       StringWidget
-         { uuid :: U.UUID
-         , strWidgetType :: StrWidgetType
-         , value :: IORef String
-         , description :: IORef Text
-         , disabled :: IORef Bool
-         , placeholder :: IORef String
-         , buttonStyle :: IORef ButtonStyle
-         }
-
--- | Create a new string widget
-mkStringWidget :: StrWidgetType -> IO StringWidget
-mkStringWidget widgetType = do
-  -- Default properties, with a random uuid
-  commUUID <- U.random
-  wType <- newIORef widgetType
-  val <- newIORef ""
-  desc <- newIORef ""
-  dis <- newIORef False
-  placeholder <- newIORef "Enter your text here..."
-  bst <- newIORef None
-
-  let b = StringWidget
-        { uuid = commUUID
-        , strWidgetType = wType
-        , value = val
-        , description = desc
-        , disabled = dis
-        , buttonStyle = bst
-        }
-
-  let initData = object [ "model_name" .= str "WidgetModel"
-                        , "widget_class" .= getViewName widgetType
-                        ]
-
-  -- Open a comm for this widget, and store it in the kernel state
-  widgetSendOpen b initData (toJSON b)
-
-  -- Return the string widget
-  return b
-
--- | Send an update msg for a widget, with custom json. Make it easy to update fragments of the
--- state, by accepting a Pair instead of a Value.
-update :: StringWidget -> [Pair] -> IO ()
-update b v = widgetSendUpdate b . toJSON . object $ v
-
--- | Modify attributes of a widget, stored inside it as IORefs
-modify :: StringWidget -> (StringWidget -> IORef a) -> a -> IO ()
-modify b attr val = writeIORef (attr b) val
-
--- | Set the button style
-setStrWidgetButtonStyle :: StringWidget -> ButtonStyle -> IO ()
-setStrWidgetButtonStyle b bst = do
-  modify b buttonStyle bst
-  update b ["button_style" .= bst]
-
--- | Set the widget text
-setStrWidgetText :: StringWidget -> Text -> IO ()
-setStrWidgetText b txt = do
-  modify b description txt
-  update b ["description" .= txt]
-
--- | Get the button style
-getStrWidgetButtonStyle :: Button -> IO ButtonStyle
-getStrWidgetButtonStyle = readIORef . buttonStyle
-
--- | Get the widget text
-getStrWidgetText :: Button -> IO Text
-getStrWidgetText = readIORef . description
-
-instance ToJSON StringWidget where
-  toJSON StringWidget {wType = strWidgetType} =
-    object
-      [ "_view_name" .= toJSON . getViewName $ wType
-      , "visible" .= True
-      , "_css" .= object []
-      , "msg_throttle" .= (3 :: Int)
-      , "disabled" .= get disabled b
-      , "description" .= get description b
-      , "tooltip" .= get tooltip b
-      , "button_style" .= get buttonStyle b
-      ]
-    where
-      get x y = unsafePerformIO . readIORef . x $ y
-
-instance IHaskellDisplay StringWidget where
-  display b = do
-    widgetSendView b
-    return $ Display []
-
-instance IHaskellWidget Button where
-  getCommUUID = uuid
-  comm widget (Object dict1) _ = do
-    let key1 = "content" :: Text
-        key2 = "event" :: Text
-        Just (Object dict2) = Map.lookup key1 dict1
-        Just (String event) = Map.lookup key2 dict2
-    when (event == "click") $ triggerClick widget
-
-str :: String -> String
-str = id

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

@@ -31,7 +31,7 @@ import           IHaskell.Display
 import           IHaskell.Eval.Widgets
 import qualified IHaskell.IPython.Message.UUID as U
 
-import           IHaskell.Display.Widgets.Common (ButtonStyle (..))
+import           IHaskell.Display.Widgets.Common (ButtonStyle(..))
 
 data HTMLWidget =
        HTMLWidget
@@ -50,16 +50,9 @@ mkHTMLWidget = do
   des <- newIORef ""
   plc <- newIORef ""
 
-  let b = HTMLWidget
-            { uuid = commUUID
-            , value = val
-            , description = des
-            , placeholder = plc
-            }
+  let b = HTMLWidget { uuid = commUUID, value = val, description = des, placeholder = plc }
 
-  let initData = object [ "model_name" .= str "WidgetModel"
-                        , "widget_class" .= str "IPython.HTML"
-                        ]
+  let initData = object ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.HTML"]
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen b initData (toJSON b)

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

@@ -33,7 +33,7 @@ import           IHaskell.Display
 import           IHaskell.Eval.Widgets
 import qualified IHaskell.IPython.Message.UUID as U
 
-import           IHaskell.Display.Widgets.Common (ButtonStyle (..))
+import           IHaskell.Display.Widgets.Common (ButtonStyle(..))
 
 data LatexWidget =
        LatexWidget
@@ -62,9 +62,7 @@ mkLatexWidget = do
         , width = width
         }
 
-  let initData = object [ "model_name" .= str "WidgetModel"
-                        , "widget_class" .= str "IPython.Latex"
-                        ]
+  let initData = object ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Latex"]
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen b initData (toJSON b)

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

@@ -35,7 +35,7 @@ import           IHaskell.Display
 import           IHaskell.Eval.Widgets
 import qualified IHaskell.IPython.Message.UUID as U
 
-import           IHaskell.Display.Widgets.Common (ButtonStyle (..))
+import           IHaskell.Display.Widgets.Common (ButtonStyle(..))
 
 data TextWidget =
        TextWidget
@@ -57,16 +57,14 @@ mkTextWidget = do
   sh <- newIORef $ const $ return ()
 
   let b = TextWidget
-            { uuid = commUUID
-            , value = val
-            , description = des
-            , placeholder = plc
-            , submitHandler = sh
-            }
+        { uuid = commUUID
+        , value = val
+        , description = des
+        , placeholder = plc
+        , submitHandler = sh
+        }
 
-  let initData = object [ "model_name" .= str "WidgetModel"
-                        , "widget_class" .= str "IPython.Text"
-                        ]
+  let initData = object ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Text"]
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen b initData (toJSON b)
@@ -147,19 +145,20 @@ instance IHaskellDisplay TextWidget where
 
 instance IHaskellWidget TextWidget where
   getCommUUID = uuid
-  -- Two possibilities:
-  -- 1. content -> event -> "submit"
-  -- 2. sync_data -> value -> <new_value>
+  -- Two possibilities: 1. content -> event -> "submit" 2. sync_data -> value -> <new_value>
   comm tw (Object dict1) _ =
     case Map.lookup "sync_data" dict1 of
-      Just (Object dict2) -> case Map.lookup "value" dict2 of
-        Just (String val) -> setTextValue tw val
-        Nothing -> return ()
-      Nothing -> case Map.lookup "content" dict1 of
-        Just (Object dict2) -> case Map.lookup "event" dict2 of
-          Just (String event) -> when (event == "submit") $ triggerSubmit tw
+      Just (Object dict2) ->
+        case Map.lookup "value" dict2 of
+          Just (String val) -> setTextValue tw val
+          Nothing           -> return ()
+      Nothing ->
+        case Map.lookup "content" dict1 of
+          Just (Object dict2) ->
+            case Map.lookup "event" dict2 of
+              Just (String event) -> when (event == "submit") $ triggerSubmit tw
+              Nothing             -> return ()
           Nothing -> return ()
-        Nothing -> return ()
 
 str :: String -> String
 str = id

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

@@ -31,7 +31,7 @@ import           IHaskell.Display
 import           IHaskell.Eval.Widgets
 import qualified IHaskell.IPython.Message.UUID as U
 
-import           IHaskell.Display.Widgets.Common (ButtonStyle (..))
+import           IHaskell.Display.Widgets.Common (ButtonStyle(..))
 
 data TextAreaWidget =
        TextAreaWidget
@@ -50,16 +50,10 @@ mkTextAreaWidget = do
   des <- newIORef ""
   plc <- newIORef ""
 
-  let b = TextAreaWidget
-            { uuid = commUUID
-            , value = val
-            , description = des
-            , placeholder = plc
-            }
+  let b = TextAreaWidget { uuid = commUUID, value = val, description = des, placeholder = plc }
 
-  let initData = object [ "model_name" .= str "WidgetModel"
-                        , "widget_class" .= str "IPython.Textarea"
-                        ]
+  let initData = object
+                   ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Textarea"]
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen b initData (toJSON b)