mirror of
https://github.com/fjvallarino/monomer.git
synced 2024-09-11 12:05:35 +03:00
Release 1.4.0.0 (#135)
* Make ColorPicker's sample color use rounded corners * Bump version to 1.4.0.0 * Fix Haddock links
This commit is contained in:
parent
90153a32b9
commit
dc3b889ad0
@ -1,4 +1,4 @@
|
||||
## 1.4.0.0 (in development)
|
||||
## 1.4.0.0
|
||||
|
||||
### Breaking changes
|
||||
|
||||
|
@ -5,7 +5,7 @@ cabal-version: 1.12
|
||||
-- see: https://github.com/sol/hpack
|
||||
|
||||
name: monomer
|
||||
version: 1.3.0.0
|
||||
version: 1.4.0.0
|
||||
synopsis: A GUI library for writing native Haskell applications.
|
||||
description: Monomer is an easy to use, cross platform, GUI library for writing native
|
||||
Haskell applications.
|
||||
|
@ -1,5 +1,5 @@
|
||||
name: monomer
|
||||
version: 1.3.0.0
|
||||
version: 1.4.0.0
|
||||
github: fjvallarino/monomer
|
||||
license: BSD3
|
||||
author: Francisco Vallarino
|
||||
|
@ -34,7 +34,7 @@ Given two values, usually model, checks if merge is required for a given widget.
|
||||
The first parameter usually corresponds to the current 'WidgetEnv', the second
|
||||
to the old value/model, and the third to the new/model.
|
||||
|
||||
This is used, for example, by 'composite' and 'box'.
|
||||
This is used, for example, by _composite_ and _box_.
|
||||
-}
|
||||
class CmbMergeRequired t w s | t -> w s where
|
||||
mergeRequired :: (w -> s -> s -> Bool) -> t
|
||||
@ -43,12 +43,12 @@ class CmbMergeRequired t w s | t -> w s where
|
||||
Listener for the validation status of a user input field using a lens.
|
||||
|
||||
Allows associating a flag to know if the input of a field with validation
|
||||
settings is valid. This can be used with 'textField ,'numericField', 'dateField'
|
||||
and 'timeField'.
|
||||
settings is valid. This can be used with _textField_, _numericField_,
|
||||
_dateField_ and _timeField_.
|
||||
|
||||
The flag can be used for styling the component according to the current status.
|
||||
Beyond styling, its usage is needed for validation purposes. Taking
|
||||
'numericField' as an example, one can bind a 'Double' record field to it and set
|
||||
_numericField_ as an example, one can bind a 'Double' record field to it and set
|
||||
a valid range from 0 to 100. When the user inputs 100, the record field will
|
||||
reflect the correct value. If the user adds a 0 (the numericField showing 1000),
|
||||
the record field will still have 100 because it's the last valid value. Since
|
||||
@ -383,11 +383,11 @@ for this:
|
||||
|
||||
- 'IgnoreChildrenEvents': parent widgets always have the priority. If a widget
|
||||
returns this 'WidgetRequest' during event handling, its children widgets
|
||||
response will be ignored. For example, the 'keystroke' widget can be
|
||||
response will be ignored. For example, the _keystroke_ widget can be
|
||||
configured to return this when a keystroke combination matches.
|
||||
- 'IgnoreParentEvents': if no parent widget requested 'IgnoreChildrenEvents', a
|
||||
widget can respond with 'IgnoreParentEvents' to have its response being the
|
||||
only one taking place. This is used, for example, by the 'textArea' widget to
|
||||
only one taking place. This is used, for example, by the _textArea_ widget to
|
||||
handle the tab key; without this, the default handler would pass focus to the
|
||||
next widget down the line.
|
||||
|
||||
@ -674,7 +674,7 @@ class CmbStyleActive t where
|
||||
{-|
|
||||
Disabled style combinator, mainly used infix with widgets.
|
||||
|
||||
Used when the 'nodeEnabled' attribute has been set to False.
|
||||
Used when the _nodeEnabled_ attribute has been set to False.
|
||||
-}
|
||||
class CmbStyleDisabled t where
|
||||
-- | Merges the new disabled style states with the existing ones.
|
||||
|
@ -31,19 +31,19 @@ import Monomer.Helper
|
||||
import qualified Monomer.Core.Lens as L
|
||||
|
||||
-- | Returns the 'Path' associated to a given 'WidgetKey', if any. The search is
|
||||
-- restricted to the parent 'Composite'.
|
||||
-- restricted to the parent _Composite_.
|
||||
pathFromKey :: WidgetEnv s e -> WidgetKey -> Maybe Path
|
||||
pathFromKey wenv key = fmap (^. L.info . L.path) node where
|
||||
node = Map.lookup key (wenv ^. L.widgetKeyMap)
|
||||
|
||||
-- | Returns the 'WidgetId' associated to a given 'WidgetKey', if any. The
|
||||
-- search is restricted to the parent 'Composite'.
|
||||
-- search is restricted to the parent _Composite_.
|
||||
widgetIdFromKey :: WidgetEnv s e -> WidgetKey -> Maybe WidgetId
|
||||
widgetIdFromKey wenv key = fmap (^. L.info . L.widgetId) node where
|
||||
node = Map.lookup key (wenv ^. L.widgetKeyMap)
|
||||
|
||||
-- | Returns the 'WidgetNodeInfo' associated to the given 'WidgetKey', if any.
|
||||
-- The search is restricted to the parent 'Composite'.
|
||||
-- The search is restricted to the parent _Composite_.
|
||||
nodeInfoFromKey :: WidgetEnv s e -> WidgetKey -> Maybe WidgetNodeInfo
|
||||
nodeInfoFromKey wenv key = path >>= nodeInfoFromPath wenv where
|
||||
path = pathFromKey wenv key
|
||||
|
@ -201,7 +201,7 @@ data WidgetRequest s e
|
||||
-- in order to reduce CPU usage. Widgets are responsible for requesting
|
||||
-- rendering at points of interest. Mouse (except mouse move) and keyboard
|
||||
-- events automatically generate render requests, but the result of a
|
||||
-- 'WidgetTask' or 'WidgetProducer' does not.
|
||||
-- 'RunTask' or 'RunProducer' does not.
|
||||
| RenderOnce
|
||||
-- | Useful if a widget requires periodic rendering. An optional maximum
|
||||
-- number of frames can be provided.
|
||||
|
@ -39,6 +39,7 @@ isActionEvent SDL.KeyboardEvent{} = True
|
||||
isActionEvent SDL.TextInputEvent{} = True
|
||||
isActionEvent _ = False
|
||||
|
||||
-- | Configuration options for converting from an SDL event to a 'SystemEvent'.
|
||||
data ConvertEventsCfg = ConvertEventsCfg {
|
||||
_cecOs :: Text, -- ^ The host operating system.
|
||||
_cecDpr :: Double, -- ^ Device pixel rate.
|
||||
|
@ -37,10 +37,11 @@ import Monomer.Graphics.Types (GlyphPos(..))
|
||||
|
||||
#include "fontmanager.h"
|
||||
|
||||
-- | Vector of 4 strict elements
|
||||
-- | Vector of 4 strict elements.
|
||||
data V4 a = V4 !a !a !a !a
|
||||
deriving (Show, Read, Eq, Ord)
|
||||
|
||||
-- | Bounds of a block of text.
|
||||
newtype Bounds
|
||||
= Bounds (V4 CFloat)
|
||||
deriving (Show, Read, Eq, Ord)
|
||||
@ -62,6 +63,7 @@ instance Storable Bounds where
|
||||
pokeElemOff p' 2 c
|
||||
pokeElemOff p' 3 d
|
||||
|
||||
-- | Position of a glyph in a text string.
|
||||
data GlyphPosition = GlyphPosition {
|
||||
-- | Pointer of the glyph in the input string.
|
||||
str :: !(Ptr CChar),
|
||||
@ -98,9 +100,11 @@ instance Storable GlyphPosition where
|
||||
|
||||
{#pointer *FMGglyphPosition as GlyphPositionPtr -> GlyphPosition#}
|
||||
|
||||
-- | Reads Bounds from a pointer.
|
||||
peekBounds :: Ptr CFloat -> IO Bounds
|
||||
peekBounds = peek . castPtr
|
||||
|
||||
-- | Allocates space for Bounds.
|
||||
allocaBounds :: (Ptr CFloat -> IO b) -> IO b
|
||||
allocaBounds f = alloca (\(p :: Ptr Bounds) -> f (castPtr p))
|
||||
|
||||
|
@ -10,7 +10,7 @@ Utility functions to retrieve the Unicode code point of a Remix Font using its
|
||||
representative name. These code points can be used in labels or buttons to show
|
||||
icons instead of regular text.
|
||||
|
||||
Make sure to load the remixicon.ttf font in your application and set 'textFont'
|
||||
Make sure to load the remixicon.ttf font in your application and set _textFont_
|
||||
in the corresponding widget.
|
||||
|
||||
Existing icons can be browsed in https://remixicon.com.
|
||||
|
@ -53,6 +53,7 @@ data RenderMsg s e
|
||||
| MsgRemoveImage Text
|
||||
| forall i . MsgRunInRender (TChan i) (IO i)
|
||||
|
||||
-- | Result from attempting to set up the secondary rendering thread.
|
||||
data RenderSetupResult
|
||||
= RenderSetupSingle
|
||||
| RenderSetupMulti
|
||||
|
@ -218,7 +218,7 @@ Configuration options for composite:
|
||||
- 'onResize': event to raise when the size of the widget changes.
|
||||
- 'onChange': event to raise when the model changes. The value passed to the
|
||||
provided event is the previous version of the model. The current version of
|
||||
the model is always available as a parameter in the `handleEvent` function.
|
||||
the model is always available as a parameter in the _handleEvent_ function.
|
||||
- 'onChangeReq': 'WidgetRequest' to generate when the model changes.
|
||||
- 'onEnabledChange': event to raise when the enabled status changes.
|
||||
- 'onVisibleChange': event to raise when the visibility changes.
|
||||
|
@ -25,6 +25,7 @@ module Monomer.Widgets.Container (
|
||||
-- * Configuration
|
||||
ContainerGetBaseStyle,
|
||||
ContainerGetCurrentStyle,
|
||||
ContainerCreateContainerFromModel,
|
||||
ContainerUpdateCWenvHandler,
|
||||
ContainerInitHandler,
|
||||
ContainerInitPostHandler,
|
||||
|
@ -38,6 +38,7 @@ customConfirm = confirm ConfirmAcceptEvent ConfirmCancelEvent where
|
||||
module Monomer.Widgets.Containers.Confirm (
|
||||
-- * Configuration
|
||||
ConfirmCfg,
|
||||
InnerConfirmEvt,
|
||||
-- * Constructors
|
||||
confirm,
|
||||
confirm_,
|
||||
@ -110,28 +111,34 @@ instance CmbCancelCaption ConfirmCfg where
|
||||
_cfcCancel = Just t
|
||||
}
|
||||
|
||||
newtype ConfirmEvt e
|
||||
{-|
|
||||
Wraps the user event to be able to implement custom events and still be able to
|
||||
report to its parent.
|
||||
|
||||
Previously used, now kept for reference.
|
||||
-}
|
||||
newtype InnerConfirmEvt e
|
||||
= ConfirmParentEvt e
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Creates a confirm dialog with the provided content.
|
||||
confirm
|
||||
:: (WidgetModel s, WidgetEvent e)
|
||||
=> e -- ^ The accept button event.
|
||||
-> e -- ^ The cancel button event.
|
||||
-> WidgetNode () (ConfirmEvt e) -- ^ The content to display in the dialog.
|
||||
-> WidgetNode s e -- ^ The created dialog.
|
||||
=> e -- ^ The accept button event.
|
||||
-> e -- ^ The cancel button event.
|
||||
-> WidgetNode () (InnerConfirmEvt e) -- ^ Content to display in the dialog.
|
||||
-> WidgetNode s e -- ^ The created dialog.
|
||||
confirm acceptEvt cancelEvt dialogBody = newNode where
|
||||
newNode = confirm_ acceptEvt cancelEvt def dialogBody
|
||||
|
||||
-- | Creates an alert dialog with the provided content. Accepts config.
|
||||
confirm_
|
||||
:: (WidgetModel s, WidgetEvent e)
|
||||
=> e -- ^ The accept button event.
|
||||
-> e -- ^ The cancel button event.
|
||||
-> [ConfirmCfg] -- ^ The config options for the dialog.
|
||||
-> WidgetNode () (ConfirmEvt e) -- ^ The content to display in the dialog.
|
||||
-> WidgetNode s e -- ^ The created dialog.
|
||||
=> e -- ^ The accept button event.
|
||||
-> e -- ^ The cancel button event.
|
||||
-> [ConfirmCfg] -- ^ The config options for the dialog.
|
||||
-> WidgetNode () (InnerConfirmEvt e) -- ^ Content to display in the dialog.
|
||||
-> WidgetNode s e -- ^ The created dialog.
|
||||
confirm_ acceptEvt cancelEvt configs dialogBody = newNode where
|
||||
config = mconcat configs
|
||||
createUI = buildUI (const dialogBody) acceptEvt cancelEvt config
|
||||
@ -141,19 +148,19 @@ confirm_ acceptEvt cancelEvt configs dialogBody = newNode where
|
||||
-- | Creates an alert dialog with a text message as content.
|
||||
confirmMsg
|
||||
:: (WidgetModel s, WidgetEvent e)
|
||||
=> Text -- ^ The message to display in the dialog.
|
||||
-> e -- ^ The accept button event.
|
||||
-> e -- ^ The cancel button event.
|
||||
=> Text -- ^ The message to display in the dialog.
|
||||
-> e -- ^ The accept button event.
|
||||
-> e -- ^ The cancel button event.
|
||||
-> WidgetNode s e -- ^ The created dialog.
|
||||
confirmMsg msg acceptEvt cancelEvt = confirmMsg_ msg acceptEvt cancelEvt def
|
||||
|
||||
-- | Creates an alert dialog with a text message as content. Accepts config.
|
||||
confirmMsg_
|
||||
:: (WidgetModel s, WidgetEvent e)
|
||||
=> Text -- ^ The message to display in the dialog.
|
||||
-> e -- ^ The accept button event.
|
||||
-> e -- ^ The cancel button event.
|
||||
-> [ConfirmCfg] -- ^ The config options for the dialog.
|
||||
=> Text -- ^ The message to display in the dialog.
|
||||
-> e -- ^ The accept button event.
|
||||
-> e -- ^ The cancel button event.
|
||||
-> [ConfirmCfg] -- ^ The config options for the dialog.
|
||||
-> WidgetNode s e -- ^ The created dialog.
|
||||
confirmMsg_ message acceptEvt cancelEvt configs = newNode where
|
||||
config = mconcat configs
|
||||
@ -173,13 +180,13 @@ mergeReqs wenv newNode oldNode parentModel oldModel model = reqs where
|
||||
|
||||
buildUI
|
||||
:: (WidgetModel s, WidgetEvent ep)
|
||||
=> (WidgetEnv s (ConfirmEvt ep) -> WidgetNode s (ConfirmEvt ep))
|
||||
=> (WidgetEnv s (InnerConfirmEvt ep) -> WidgetNode s (InnerConfirmEvt ep))
|
||||
-> ep
|
||||
-> ep
|
||||
-> ConfirmCfg
|
||||
-> WidgetEnv s (ConfirmEvt ep)
|
||||
-> WidgetEnv s (InnerConfirmEvt ep)
|
||||
-> s
|
||||
-> WidgetNode s (ConfirmEvt ep)
|
||||
-> WidgetNode s (InnerConfirmEvt ep)
|
||||
buildUI dialogBody pAcceptEvt pCancelEvt config wenv model = mainTree where
|
||||
acceptEvt = ConfirmParentEvt pAcceptEvt
|
||||
cancelEvt = ConfirmParentEvt pCancelEvt
|
||||
@ -211,10 +218,10 @@ buildUI dialogBody pAcceptEvt pCancelEvt config wenv model = mainTree where
|
||||
mainTree = keystroke [("Esc", cancelEvt)] confirmBox
|
||||
|
||||
handleEvent
|
||||
:: WidgetEnv s (ConfirmEvt ep)
|
||||
-> WidgetNode s (ConfirmEvt ep)
|
||||
:: WidgetEnv s (InnerConfirmEvt ep)
|
||||
-> WidgetNode s (InnerConfirmEvt ep)
|
||||
-> s
|
||||
-> ConfirmEvt ep
|
||||
-> [EventResponse s (ConfirmEvt ep) sp ep]
|
||||
-> InnerConfirmEvt ep
|
||||
-> [EventResponse s (InnerConfirmEvt ep) sp ep]
|
||||
handleEvent wenv node model evt = case evt of
|
||||
ConfirmParentEvt pevt -> [Report pevt]
|
||||
|
@ -72,12 +72,19 @@ data ScrollType
|
||||
| ScrollBoth
|
||||
deriving (Eq, Show)
|
||||
|
||||
{-|
|
||||
Information provided in the 'onChange' event.
|
||||
|
||||
The currently visible viewport is affected by the position of the scroll bars,
|
||||
their size and any other parent widget that restricts the visible viewport
|
||||
(e.g., another scroll).
|
||||
-}
|
||||
data ScrollStatus = ScrollStatus {
|
||||
scrollDeltaX :: Double,
|
||||
scrollDeltaY :: Double,
|
||||
scrollRect :: Rect,
|
||||
scrollVpSize :: Size,
|
||||
scrollChildSize :: Size
|
||||
scrollDeltaX :: Double, -- ^ Displacement in the x axis.
|
||||
scrollDeltaY :: Double, -- ^ Displacement in the y axis.
|
||||
scrollRect :: Rect, -- ^ The viewport assigned to the scroll widget.
|
||||
scrollVpSize :: Size, -- ^ The currently visible viewport.
|
||||
scrollChildSize :: Size -- ^ The total size of the child widget.
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance Default ScrollStatus where
|
||||
|
@ -54,7 +54,7 @@ Configuration options for button:
|
||||
|
||||
- 'ignoreParentEvts': whether to ignore all other responses to the click or
|
||||
keypress that triggered the button, and only keep this button's response.
|
||||
Useful when the button is child of a 'keystroke' widget.
|
||||
Useful when the button is child of a _keystroke_ widget.
|
||||
- 'trimSpaces': whether to remove leading/trailing spaces in the caption.
|
||||
- 'ellipsis': if ellipsis should be used for overflown text.
|
||||
- 'multiline': if text may be split in multiple lines.
|
||||
@ -220,7 +220,7 @@ Creates a button without forcing an event to be provided. The other constructors
|
||||
use this version, adding an 'onClick' handler in configs.
|
||||
|
||||
Using this constructor directly can be helpful in cases where the event to be
|
||||
raised belongs in a 'Composite' above in the widget tree, outside the scope of
|
||||
raised belongs in a _Composite_ above in the widget tree, outside the scope of
|
||||
the Composite that contains the button. This parent Composite can be reached by
|
||||
sending a message ('SendMessage') to its 'WidgetId' using 'onClickReq'.
|
||||
-}
|
||||
|
@ -20,6 +20,7 @@ colorPicker colorLens
|
||||
module Monomer.Widgets.Singles.ColorPicker (
|
||||
-- * Configuration
|
||||
ColorPickerCfg,
|
||||
ColorPickerEvt,
|
||||
-- * Constructors
|
||||
colorPicker,
|
||||
colorPicker_,
|
||||
@ -126,11 +127,12 @@ instance CmbOnChangeReq (ColorPickerCfg s e) s e Color where
|
||||
_cpcOnChangeReq = [req]
|
||||
}
|
||||
|
||||
-- | Internal events for the 'colorPicker' widget.
|
||||
data ColorPickerEvt
|
||||
= PickerFocus Path
|
||||
| PickerBlur Path
|
||||
| ColorChanged Int
|
||||
| AlphaChanged Double
|
||||
| PickerColorChanged Int
|
||||
| PickerAlphaChanged Double
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Creates a color picker using the given lens.
|
||||
@ -192,8 +194,10 @@ buildUI
|
||||
buildUI config wenv model = mainTree where
|
||||
showAlpha = fromMaybe False (_cpcShowAlpha config)
|
||||
colorSample = zstack [
|
||||
patternImage 2 10 (rgb 255 255 255) (rgb 150 150 150),
|
||||
filler `styleBasic` [bgColor model]
|
||||
patternImage 2 10 (rgb 255 255 255) (rgb 150 150 150)
|
||||
`styleBasic` [radius 4],
|
||||
filler
|
||||
`styleBasic` [bgColor model, radius 4]
|
||||
] `styleBasic` [width 32]
|
||||
|
||||
compRow lensCol evt lbl minV maxV = hstack [
|
||||
@ -208,8 +212,8 @@ buildUI config wenv model = mainTree where
|
||||
`styleBasic` [width 40, padding 0, textAscender, textRight]
|
||||
]
|
||||
|
||||
colorRow lens lbl = compRow lens ColorChanged lbl 0 255
|
||||
alphaRow lens lbl = compRow lens AlphaChanged lbl 0 1
|
||||
colorRow lens lbl = compRow lens PickerColorChanged lbl 0 255
|
||||
alphaRow lens lbl = compRow lens PickerAlphaChanged lbl 0 1
|
||||
|
||||
mainTree = hstack_ [sizeReqUpdater clearExtra] [
|
||||
vstack [
|
||||
@ -238,8 +242,8 @@ handleEvent cfg wenv node model evt = case evt of
|
||||
| not (isNodeParentOfPath node prev) -> reportFocus prev
|
||||
PickerBlur next
|
||||
| not (isNodeParentOfPath node next) -> reportBlur next
|
||||
ColorChanged _ -> reportChange
|
||||
AlphaChanged _ -> reportChange
|
||||
PickerColorChanged _ -> reportChange
|
||||
PickerAlphaChanged _ -> reportChange
|
||||
_ -> []
|
||||
where
|
||||
report reqs = RequestParent <$> reqs
|
||||
|
@ -34,9 +34,10 @@ Handles mouse wheel and shift + vertical drag to increase/decrease days.
|
||||
module Monomer.Widgets.Singles.DateField (
|
||||
-- * Configuration
|
||||
DateFieldCfg,
|
||||
DateFieldFormat,
|
||||
FormattableDate,
|
||||
DayConverter(..),
|
||||
DateTextConverter,
|
||||
DateTextConverter(..),
|
||||
-- * Constructors
|
||||
dateField,
|
||||
dateField_,
|
||||
@ -71,13 +72,14 @@ import Monomer.Widgets.Singles.Base.InputField
|
||||
import qualified Monomer.Lens as L
|
||||
import qualified Monomer.Widgets.Util.Parser as P
|
||||
|
||||
data DateFormat
|
||||
-- | Available formats for 'dateField'.
|
||||
data DateFieldFormat
|
||||
= FormatDDMMYYYY
|
||||
| FormatYYYYMMDD
|
||||
| FormatMMDDYYYY
|
||||
deriving (Eq, Show)
|
||||
|
||||
defaultDateFormat :: DateFormat
|
||||
defaultDateFormat :: DateFieldFormat
|
||||
defaultDateFormat = FormatDDMMYYYY
|
||||
|
||||
defaultDateDelim :: Char
|
||||
@ -95,11 +97,14 @@ instance DayConverter Day where
|
||||
convertFromDay = id
|
||||
convertToDay = Just
|
||||
|
||||
-- | Converts a 'Day' instance to and from 'Text'.
|
||||
{-|
|
||||
Converts a 'Day' instance to and from 'Text'. Implementing this typeclass
|
||||
is not necessary for instances of 'DayConverter'.
|
||||
-}
|
||||
class DateTextConverter a where
|
||||
dateAcceptText :: DateFormat -> Char -> Maybe a -> Maybe a -> Text -> (Bool, Bool, Maybe a)
|
||||
dateFromText :: DateFormat -> Char -> Text -> Maybe a
|
||||
dateToText :: DateFormat -> Char -> a -> Text
|
||||
dateAcceptText :: DateFieldFormat -> Char -> Maybe a -> Maybe a -> Text -> (Bool, Bool, Maybe a)
|
||||
dateFromText :: DateFieldFormat -> Char -> Text -> Maybe a
|
||||
dateToText :: DateFieldFormat -> Char -> a -> Text
|
||||
dateFromDay :: Day -> a
|
||||
dateToDay :: a -> Maybe Day
|
||||
|
||||
@ -166,7 +171,7 @@ data DateFieldCfg s e a = DateFieldCfg {
|
||||
_dfcValid :: Maybe (WidgetData s Bool),
|
||||
_dfcValidV :: [Bool -> e],
|
||||
_dfcDateDelim :: Maybe Char,
|
||||
_dfcDateFormat :: Maybe DateFormat,
|
||||
_dfcDateFormat :: Maybe DateFieldFormat,
|
||||
_dfcMinValue :: Maybe a,
|
||||
_dfcMaxValue :: Maybe a,
|
||||
_dfcWheelRate :: Maybe Double,
|
||||
@ -484,7 +489,7 @@ handleMove config state rate value dy = result where
|
||||
|
||||
dateFromTextSimple
|
||||
:: (DayConverter a, FormattableDate a)
|
||||
=> DateFormat
|
||||
=> DateFieldFormat
|
||||
-> Char
|
||||
-> Text
|
||||
-> Maybe a
|
||||
@ -499,7 +504,7 @@ dateFromTextSimple format delim text = newDate where
|
||||
| otherwise -> fromGregorianValid (fromIntegral n1) n2 n3
|
||||
newDate = tmpDate >>= dateFromDay
|
||||
|
||||
dateToTextSimple :: FormattableDate a => DateFormat -> Char -> a -> Text
|
||||
dateToTextSimple :: FormattableDate a => DateFieldFormat -> Char -> a -> Text
|
||||
dateToTextSimple format delim val = result where
|
||||
converted = dateToDay val
|
||||
(year, month, day) = toGregorian (fromJust converted)
|
||||
@ -516,7 +521,7 @@ dateToTextSimple format delim val = result where
|
||||
| format == FormatMMDDYYYY = tmonth <> sep <> tday <> sep <> tyear
|
||||
| otherwise = tyear <> sep <> tmonth <> sep <> tday
|
||||
|
||||
acceptTextInput :: DateFormat -> Char -> Text -> Bool
|
||||
acceptTextInput :: DateFieldFormat -> Char -> Text -> Bool
|
||||
acceptTextInput format delim text = isRight (A.parseOnly parser text) where
|
||||
numP = A.digit *> ""
|
||||
delimP = A.char delim *> ""
|
||||
|
@ -33,7 +33,7 @@ module Monomer.Widgets.Singles.NumericField (
|
||||
-- * Configuration
|
||||
NumericFieldCfg,
|
||||
FormattableNumber,
|
||||
NumericTextConverter,
|
||||
NumericTextConverter(..),
|
||||
-- * Constructors
|
||||
numericField,
|
||||
numericField_,
|
||||
@ -67,7 +67,10 @@ import Monomer.Widgets.Singles.Base.InputField
|
||||
import qualified Monomer.Lens as L
|
||||
import qualified Monomer.Widgets.Util.Parser as P
|
||||
|
||||
-- | Converts a numeric instance to and from 'Text'.
|
||||
{-|
|
||||
Converts a numeric instance to and from 'Text'. Implementing this typeclass
|
||||
is not necessary for instances of 'FromFractional'.
|
||||
-}
|
||||
class NumericTextConverter a where
|
||||
numericAcceptText :: Maybe a -> Maybe a -> Int -> Text -> (Bool, Bool, Maybe a)
|
||||
numericFromText :: Text -> Maybe a
|
||||
|
@ -279,6 +279,10 @@ optionButtonD_ caption option widgetData configs = optionButtonNode where
|
||||
optionButtonNode = defaultWidgetNode wtype widget
|
||||
& L.info . L.focusable .~ True
|
||||
|
||||
{-|
|
||||
Helper function for creating a button associated to a value. Used by
|
||||
_optionButton_ and _toggleButton_.
|
||||
-}
|
||||
makeOptionButton
|
||||
:: OptionButtonValue a
|
||||
=> Lens' ThemeState StyleState
|
||||
|
@ -34,7 +34,9 @@ module Monomer.Widgets.Singles.TimeField (
|
||||
-- * Configuration
|
||||
TimeFieldCfg,
|
||||
FormattableTime,
|
||||
TimeFieldFormat,
|
||||
TimeOfDayConverter(..),
|
||||
TimeTextConverter(..),
|
||||
-- * Constructors
|
||||
timeField,
|
||||
timeField_,
|
||||
@ -67,12 +69,13 @@ import Monomer.Widgets.Singles.Base.InputField
|
||||
import qualified Monomer.Lens as L
|
||||
import qualified Monomer.Widgets.Util.Parser as P
|
||||
|
||||
data TimeFormat
|
||||
-- | Available formats for 'timeField'.
|
||||
data TimeFieldFormat
|
||||
= FormatHHMM
|
||||
| FormatHHMMSS
|
||||
deriving (Eq, Show)
|
||||
|
||||
defaultTimeFormat :: TimeFormat
|
||||
defaultTimeFormat :: TimeFieldFormat
|
||||
defaultTimeFormat = FormatHHMM
|
||||
|
||||
defaultTimeDelim :: Char
|
||||
@ -90,11 +93,14 @@ instance TimeOfDayConverter TimeOfDay where
|
||||
convertFromTimeOfDay = id
|
||||
convertToTimeOfDay = Just
|
||||
|
||||
-- | Converts a 'TimeOfDay' instance to and from 'Text'.
|
||||
{-|
|
||||
Converts a 'TimeOfDay' instance to and from 'Text'. Implementing this typeclass
|
||||
is not necessary for instances of 'TimeOfDayConverter'.
|
||||
-}
|
||||
class TimeTextConverter a where
|
||||
timeAcceptText :: TimeFormat -> Maybe a -> Maybe a -> Text -> (Bool, Bool, Maybe a)
|
||||
timeFromText :: TimeFormat -> Text -> Maybe a
|
||||
timeToText :: TimeFormat -> a -> Text
|
||||
timeAcceptText :: TimeFieldFormat -> Maybe a -> Maybe a -> Text -> (Bool, Bool, Maybe a)
|
||||
timeFromText :: TimeFieldFormat -> Text -> Maybe a
|
||||
timeToText :: TimeFieldFormat -> a -> Text
|
||||
timeFromTimeOfDay' :: TimeOfDay -> a
|
||||
timeToTimeOfDay' :: a -> Maybe TimeOfDay
|
||||
|
||||
@ -158,7 +164,7 @@ data TimeFieldCfg s e a = TimeFieldCfg {
|
||||
_tfcCaretMs :: Maybe Millisecond,
|
||||
_tfcValid :: Maybe (WidgetData s Bool),
|
||||
_tfcValidV :: [Bool -> e],
|
||||
_tfcTimeFormat :: Maybe TimeFormat,
|
||||
_tfcTimeFormat :: Maybe TimeFieldFormat,
|
||||
_tfcMinValue :: Maybe a,
|
||||
_tfcMaxValue :: Maybe a,
|
||||
_tfcWheelRate :: Maybe Double,
|
||||
@ -459,7 +465,7 @@ handleMove config state rate value dy = result where
|
||||
|
||||
timeFromTextSimple
|
||||
:: (TimeOfDayConverter a, FormattableTime a)
|
||||
=> TimeFormat
|
||||
=> TimeFieldFormat
|
||||
-> Text
|
||||
-> Maybe a
|
||||
timeFromTextSimple format text = newTime where
|
||||
@ -474,7 +480,7 @@ timeFromTextSimple format text = newTime where
|
||||
| otherwise -> makeTimeOfDayValid n1 n2 (fromIntegral n3)
|
||||
newTime = tmpTime >>= timeFromTimeOfDay'
|
||||
|
||||
timeToTextSimple :: FormattableTime a => TimeFormat -> a -> Text
|
||||
timeToTextSimple :: FormattableTime a => TimeFieldFormat -> a -> Text
|
||||
timeToTextSimple format val = result where
|
||||
sep = T.singleton defaultTimeDelim
|
||||
converted = timeToTimeOfDay' val
|
||||
@ -490,7 +496,7 @@ timeToTextSimple format val = result where
|
||||
| format == FormatHHMM = thh <> sep <> tmm
|
||||
| otherwise = thh <> sep <> tmm <> sep <> tss
|
||||
|
||||
acceptTextInput :: TimeFormat -> Text -> Bool
|
||||
acceptTextInput :: TimeFieldFormat -> Text -> Bool
|
||||
acceptTextInput format text = isRight (A.parseOnly parser text) where
|
||||
numP = A.digit *> ""
|
||||
delimP = A.char defaultTimeDelim *> ""
|
||||
|
Loading…
Reference in New Issue
Block a user