Added layout widget

ihaskell-display/ihaskell-widgets/README.md

@@ -19,4 +19,8 @@ jupyter nbconvert *.ipynb --to notebook --inplace --clear-output
 - [ ] Validate the JSON implementation of widgets against the MsgSpec schema
 - [ ] Create integration tests for the widgets
 - [ ] Make the `output` widget work
-- [ ] Processing of widget messages concurrently
\ No newline at end of file
+- [ ] Processing of widget messages concurrently
+- [ ] Make the layout widget values more 'Haskelian': Instead of checking if the string is valid at runtime, make some types so it's checked at compile-time
+- [ ] Add some "utils" work:
+    - [ ] Create media widget from file
+    - [ ] Get the selected label from a selection value
\ No newline at end of file

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

@@ -58,6 +58,7 @@ library
   -- Modules exported by the library.
   exposed-modules:     IHaskell.Display.Widgets
                        IHaskell.Display.Widgets.Interactive
+                       IHaskell.Display.Widgets.Layout
 
   -- Modules included in this library but not exported.
   other-modules:       IHaskell.Display.Widgets.Button
@@ -106,6 +107,10 @@ library
                        IHaskell.Display.Widgets.String.Text
                        IHaskell.Display.Widgets.String.TextArea
 
+                       IHaskell.Display.Widgets.Layout.Common
+                       IHaskell.Display.Widgets.Layout.LayoutWidget
+                       IHaskell.Display.Widgets.Layout.Types
+
                        IHaskell.Display.Widgets.Types
                        IHaskell.Display.Widgets.Common
                        IHaskell.Display.Widgets.Singletons

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

@@ -33,6 +33,7 @@ pattern ModelModuleVersion = S.SModelModuleVersion
 pattern ModelName = S.SModelName
 pattern DisplayHandler = S.SDisplayHandler
 pattern DOMClasses = S.SDOMClasses
+pattern Layout = S.SLayout
 pattern Width = S.SWidth
 pattern Height = S.SHeight
 pattern Description = S.SDescription
@@ -75,10 +76,7 @@ pattern ReadOutFormat = S.SReadOutFormat
 pattern BarStyle = S.SBarStyle
 pattern ChangeHandler = S.SChangeHandler
 pattern Children = S.SChildren
-pattern OverflowX = S.SOverflowX
-pattern OverflowY = S.SOverflowY
 pattern BoxStyle = S.SBoxStyle
-pattern Flex = S.SFlex
 pattern Pack = S.SPack
 pattern Align = S.SAlign
 pattern Titles = S.STitles
@@ -121,36 +119,6 @@ newtype PixCount = PixCount Integer
 instance ToJSON PixCount where
   toJSON (PixCount x) = toJSON . pack $ show x ++ "px"
 
--- | Pre-defined border styles
-data BorderStyleValue = NoBorder
-                      | HiddenBorder
-                      | DottedBorder
-                      | DashedBorder
-                      | SolidBorder
-                      | DoubleBorder
-                      | GrooveBorder
-                      | RidgeBorder
-                      | InsetBorder
-                      | OutsetBorder
-                      | InitialBorder
-                      | InheritBorder
-                      | DefaultBorder
-
-instance ToJSON BorderStyleValue where
-  toJSON NoBorder = "none"
-  toJSON HiddenBorder = "hidden"
-  toJSON DottedBorder = "dotted"
-  toJSON DashedBorder = "dashed"
-  toJSON SolidBorder = "solid"
-  toJSON DoubleBorder = "double"
-  toJSON GrooveBorder = "groove"
-  toJSON RidgeBorder = "ridge"
-  toJSON InsetBorder = "inset"
-  toJSON OutsetBorder = "outset"
-  toJSON InitialBorder = "initial"
-  toJSON InheritBorder = "inherit"
-  toJSON DefaultBorder = ""
-
 -- | Font style values
 data FontStyleValue = NormalFont
                     | ItalicFont
@@ -269,23 +237,6 @@ instance ToJSON OrientationValue where
   toJSON HorizontalOrientation = "horizontal"
   toJSON VerticalOrientation = "vertical"
 
-data OverflowValue = VisibleOverflow
-                   | HiddenOverflow
-                   | ScrollOverflow
-                   | AutoOverflow
-                   | InitialOverflow
-                   | InheritOverflow
-                   | DefaultOverflow
-
-instance ToJSON OverflowValue where
-  toJSON VisibleOverflow = "visible"
-  toJSON HiddenOverflow = "hidden"
-  toJSON ScrollOverflow = "scroll"
-  toJSON AutoOverflow = "auto"
-  toJSON InitialOverflow = "initial"
-  toJSON InheritOverflow = "inherit"
-  toJSON DefaultOverflow = ""
-
 data BoxStyleValue = SuccessBox
                    | InfoBox
                    | WarningBox

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

+module IHaskell.Display.Widgets.Layout (module X) where
+
+import IHaskell.Display.Widgets.Layout.Common as X
+import IHaskell.Display.Widgets.Layout.Types as X
+import IHaskell.Display.Widgets.Layout.LayoutWidget as X
\ No newline at end of file

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

+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE AutoDeriveTypeable #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-- There are lots of pattern synpnyms, and little would be gained by adding
+-- the type signatures.
+{-# OPTIONS_GHC -fno-warn-missing-pattern-synonym-signatures #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
+module IHaskell.Display.Widgets.Layout.Common where
+
+import           Data.Aeson
+import           Data.Aeson.Types (emptyObject)
+import           Data.HashMap.Strict as HM
+import           Data.Text (pack, Text)
+import           Data.Typeable (Typeable)
+
+import           IHaskell.Display (IHaskellWidget)
+import           IHaskell.Eval.Widgets (widgetSendClose)
+
+import qualified IHaskell.Display.Widgets.Singletons as S
+
+pattern AlignContent = S.SLAlignContent
+pattern AlignItems = S.SLAlignItems
+pattern AlignSelf = S.SLAlignSelf
+pattern Border = S.SLBorder
+pattern Bottom = S.SLBottom
+pattern Display = S.SLDisplay
+pattern Flex = S.SLFlex
+pattern FlexFlow = S.SLFlexFlow
+pattern GridArea = S.SLGridArea
+pattern GridAutoColumns = S.SLGridAutoColumns
+pattern GridAutoFlow = S.SLGridAutoFlow
+pattern GridAutoRows = S.SLGridAutoRows
+pattern GridColumn = S.SLGridColumn
+pattern GridGap = S.SLGridGap
+pattern GridRow = S.SLGridRow
+pattern GridTemplateAreas = S.SLGridTemplateAreas
+pattern GridTemplateColumns = S.SLGridTemplateColumns
+pattern GridTemplateRows = S.SLGridTemplateRows
+pattern Height = S.SLHeight
+pattern JustifyContent = S.SLJustifyContent
+pattern JustifyItems = S.SLJustifyItems
+pattern Left = S.SLLeft
+pattern Margin = S.SLMargin
+pattern MaxHeight = S.SLMaxHeight
+pattern MaxWidth = S.SLMaxWidth
+pattern MinHeight = S.SLMinHeight
+pattern MinWidth = S.SLMinWidth
+pattern Order = S.SLOrder
+pattern Overflow = S.SLOverflow
+pattern OverflowX = S.SLOverflowX
+pattern OverflowY = S.SLOverflowY
+pattern Padding = S.SLPadding
+pattern Right = S.SLRight
+pattern Top = S.SLTop
+pattern Visibility = S.SLVisibility
+pattern Width = S.SLWidth
+
+-- TODO: This should be implemented with static type checking, so it's
+-- easier to verify at compile-time. "The Haskell Way".
+-- But a lot of these fields have common values. ¿Maybe doing some kind
+-- of singleton for the CSS fields? ¿Maybe appending the type like
+-- InheritOverflow / InheritVisible / InheritGrid...
+-- In the meantime we'll use arrays of strings and some runtime verification
+cssProps :: [String]
+cssProps = ["inherit", "initial", "unset"]
+alignContentProps = ["flex-start", "flex-end", "center", "space-between", "space-around", "space-evenly", "stretch"] ++ cssProps
+alignItemProps =  ["flex-start", "flex-end", "center", "baseline", "stretch"] ++ cssProps
+alignSelfProps = ["auto", "flex-start", "flex-end", "center", "baseline", "stretch"] ++ cssProps
+gridAutoFlowProps = ["column", "row", "row dense", "column dense"] ++ cssProps
+justifyContentProps = ["flex-start", "flex-end", "center", "space-between", "space-around"] ++ cssProps
+justifyItemsProps = ["flex-start", "flex-end", "center"] ++ cssProps
+overflowProps = ["visible", "hidden", "scroll", "auto"] ++ cssProps
+visibilityProps = ["visible", "hidden"] ++ cssProps
\ No newline at end of file

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

+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
+
+module IHaskell.Display.Widgets.Layout.LayoutWidget
+  ( -- * The Layout Widget
+    Layout
+    -- * Create a new Layout
+  , mkLayout
+  ) where
+
+-- To keep `cabal repl` happy when running from the ihaskell repo
+import           Prelude
+
+import           Control.Monad (void)
+
+import           Data.Aeson
+import           Data.IORef (newIORef)
+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.Layout.Types
+import           IHaskell.Display.Widgets.Layout.Common
+
+-- | A 'Layout' represents a Layout from IPython.html.widgets.
+type Layout = IPythonWidget 'LayoutType
+
+-- | Create a new Layout
+mkLayout :: IO Layout
+mkLayout = do
+  -- Default properties, with a random uuid
+  wid <- U.random
+
+  let layoutState = WidgetState defaultLayoutWidget
+
+  stateIO <- newIORef layoutState
+
+  let layout = IPythonWidget wid stateIO
+
+  -- Open a comm for this widget, and store it in the kernel state
+  widgetSendOpen layout $ toJSON layoutState
+
+  -- Return the Layout widget
+  return layout
+
+instance IHaskellWidget Layout where
+  getCommUUID = uuid
\ No newline at end of file

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

@@ -18,6 +18,8 @@
 
 module IHaskell.Display.Widgets.Singletons where
 
+import           Data.Kind
+
 #if MIN_VERSION_singletons(3,0,0)
 import           Data.Singletons.Base.TH
 #elif MIN_VERSION_singletons(2,4,0)
@@ -39,6 +41,7 @@ singletons
              | ModelName
              | DisplayHandler
              | DOMClasses
+             | Layout
              | Width
              | Height
              | Description
@@ -81,10 +84,7 @@ singletons
              | BarStyle
              | ChangeHandler
              | Children
-             | OverflowX
-             | OverflowY
              | BoxStyle
-             | Flex
              | Pack
              | Align
              | Titles
@@ -116,5 +116,44 @@ singletons
              | Timestamp
              | Buttons
              | Axes
+             -- Now the ones for layout
+             -- Every layout property comes with an L before the name to avoid conflict
+             -- The patterns from Layout.Common remove that leading L
+             | LAlignContent
+             | LAlignItems
+             | LAlignSelf
+             | LBorder
+             | LBottom
+             | LDisplay
+             | LFlex
+             | LFlexFlow
+             | LGridArea
+             | LGridAutoColumns
+             | LGridAutoFlow
+             | LGridAutoRows
+             | LGridColumn
+             | LGridGap
+             | LGridRow
+             | LGridTemplateAreas
+             | LGridTemplateColumns
+             | LGridTemplateRows
+             | LHeight
+             | LJustifyContent
+             | LJustifyItems
+             | LLeft
+             | LMargin
+             | LMaxHeight
+             | LMaxWidth
+             | LMinHeight
+             | LMinWidth
+             | LOrder
+             | LOverflow
+             | LOverflowX
+             | LOverflowY
+             | LPadding
+             | LRight
+             | LTop
+             | LVisibility
+             | LWidth
              deriving (Eq, Ord, Show)
   |]