Commit e42e509f authored by Sumit Sahrawat's avatar Sumit Sahrawat

Formatting fixes

parent b2888da8
......@@ -41,7 +41,6 @@ import IHaskell.Display.Widgets.String.Text as X
import IHaskell.Display.Widgets.String.TextArea as X
import IHaskell.Display.Widgets.Common as X
import IHaskell.Display.Widgets.Types as X (setField, getField, properties,
triggerDisplay, triggerChange, triggerClick,
triggerSelection, triggerSubmit,
ChildWidget(..))
import IHaskell.Display.Widgets.Types as X (setField, getField, properties, triggerDisplay,
triggerChange, triggerClick, triggerSelection,
triggerSubmit, ChildWidget(..))
......@@ -4,10 +4,10 @@
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Bool.Valid (
-- * The Valid Widget
ValidWidget,
-- * Constructor
mkValidWidget) where
-- * The Valid Widget
ValidWidget,
-- * Constructor
mkValidWidget) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
......
......@@ -3,12 +3,11 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Box.PlaceProxy (
-- * The PlaceProxy widget
PlaceProxy,
-- * Constructor
mkPlaceProxy) where
-- * The PlaceProxy widget
PlaceProxy,
-- * Constructor
mkPlaceProxy) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
......
......@@ -5,9 +5,9 @@
module IHaskell.Display.Widgets.Box.Proxy (
-- * The Proxy widget
ProxyWidget,
-- * Constructor
mkProxyWidget) where
ProxyWidget,
-- * Constructor
mkProxyWidget) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
......
......@@ -13,7 +13,7 @@ import Data.Singletons.TH
-- Widget properties
singletons
[d|
data Field = ViewModule
| ViewName
| ModelModule
......
......@@ -128,7 +128,7 @@ type BoxClass = DOMWidgetClass :++ '[S.Children, S.OverflowX, S.OverflowY, S.Box
type SelectionContainerClass = BoxClass :++ '[S.Titles, S.SelectedIndex, S.ChangeHandler]
-- Types associated with Fields.
type family FieldType (f :: Field) :: * where
FieldType S.ViewModule = Text
FieldType S.ViewName = Text
......@@ -266,7 +266,7 @@ data WidgetType = ButtonType
| TabType
-- Fields associated with a widget
type family WidgetFields (w :: WidgetType) :: [Field] where
WidgetFields ButtonType =
DOMWidgetClass :++
......@@ -312,7 +312,8 @@ type family WidgetFields (w :: WidgetType) :: [Field] where
'[S.Orientation, S.ShowRange, S.ReadOut, S.SliderColor]
WidgetFields BoxType = BoxClass
WidgetFields ProxyType = WidgetClass :++ '[S.Child]
WidgetFields PlaceProxyType = WidgetFields ProxyType :++ '[S.Selector]
WidgetFields PlaceProxyType =
WidgetFields ProxyType :++ '[S.Selector]
WidgetFields FlexBoxType =
BoxClass :++ '[S.Orientation, S.Flex, S.Pack, S.Align]
WidgetFields AccordionType = SelectionContainerClass
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment