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