diff --git a/bower.json b/bower.json index baf73c3..21c8594 100644 --- a/bower.json +++ b/bower.json @@ -29,6 +29,7 @@ "purescript-validation": "^3.1.0", "purescript-profunctor": "^3.1.0", "purescript-numbers": "^5.0.0", - "purescript-these": "^3.0.0" + "purescript-these": "^3.0.0", + "purescript-number-input-halogen": "git://github.com/safareli/purescript-number-input-halogen.git#initial" } } diff --git a/example/index.html b/example/index.html index 6b2635b..95868f6 100644 --- a/example/index.html +++ b/example/index.html @@ -47,6 +47,12 @@ width: 500px; margin: 0px 4px; } + .Picker-input--length-3 { + width: 3.5em; + } + .Picker-input--length-2 { + width: 2.7em; + } diff --git a/src/Halogen/DatePicker/Component/Date.purs b/src/Halogen/DatePicker/Component/Date.purs index e0cc892..6bd08bb 100644 --- a/src/Halogen/DatePicker/Component/Date.purs +++ b/src/Halogen/DatePicker/Component/Date.purs @@ -26,8 +26,8 @@ import Halogen.Datepicker.Format.Date as F import Halogen.Datepicker.Internal.Choice as Choice import Halogen.Datepicker.Internal.Enums (MonthShort, Year2, Year4, setYear) import Halogen.Datepicker.Internal.Elements (textElement, PreChoiceConfig, renderChoice, renderNum) -import Halogen.Datepicker.Internal.Num as Num -import Halogen.Datepicker.Internal.Range (Range, bottomTop) +import NumberInput.Halogen.Component as Num +import NumberInput.Range (Range, bottomTop) import Halogen.Datepicker.Internal.Utils (mapParentHTMLQuery, foldSteps, componentProps, transitionState', pickerProps, mustBeMounted) import Halogen.HTML as HH @@ -126,7 +126,7 @@ buildDate format = do mkBuildStep = commandCata { text: \cmd → pure $ Just mempty , enum: \cmd → do - num ← queryNum cmd $ H.request (left <<< GetValue) + num ← queryNum cmd $ H.request Num.GetValue pure $ num <#> \n → Join $ Star $ \t → F.toSetter cmd n t , choice: \cmd → do num ← queryChoice cmd $ H.request (left <<< GetValue) @@ -152,7 +152,7 @@ propagateChange format date = for_ (unwrap format) $ commandCata { text: \cmd → pure unit , enum: \cmd → do let val = value date >>= F.toGetter cmd - queryNum cmd $ H.request $ left <<< SetValue val + queryNum cmd $ H.action $ Num.SetValue val , choice: \cmd → do let val = value date >>= F.toGetter cmd res ← queryChoice cmd $ H.request $ left <<< SetValue val diff --git a/src/Halogen/DatePicker/Component/Duration.purs b/src/Halogen/DatePicker/Component/Duration.purs index a351ca0..cfd179b 100644 --- a/src/Halogen/DatePicker/Component/Duration.purs +++ b/src/Halogen/DatePicker/Component/Duration.purs @@ -5,7 +5,7 @@ import Prelude import Data.Array (fold) import Data.Bifunctor (lmap) import Data.Either (Either(..)) -import Data.Functor.Coproduct (Coproduct, coproduct, right, left) +import Data.Functor.Coproduct (Coproduct, coproduct, right) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Interval (Duration) @@ -18,11 +18,11 @@ import Data.String (take) import Data.Traversable (for) import Data.Tuple (Tuple(..)) import Halogen as H -import Halogen.Datepicker.Component.Types (BasePickerQuery(..), PickerMessage(..), PickerQuery(..), PickerValue) +import Halogen.Datepicker.Component.Types (BasePickerQuery(..), PickerMessage, PickerQuery(..), PickerValue) import Halogen.Datepicker.Config (Config, defaultConfig) import Halogen.Datepicker.Format.Duration as F -import Halogen.Datepicker.Internal.Num as Num -import Halogen.Datepicker.Internal.Range (minRange) +import NumberInput.Halogen.Component as Num +import NumberInput.Range (minRange) import Halogen.Datepicker.Internal.Utils (mapParentHTMLQuery, foldSteps, componentProps, transitionState, asRight, mustBeMounted, pickerProps) import Halogen.Datepicker.Internal.Elements (toNumConf) import Halogen.HTML as HH @@ -68,9 +68,9 @@ renderCommand ∷ ∀ m. Config → F.Command → HTML m renderCommand config cmd = HH.li (componentProps config) [ HH.slot cmd - (Num.picker Num.numberHasNumberInputVal $ toNumConf config { title: show cmd, placeholder: take 1 (show cmd), range: minRange 0.0 }) + (Num.input Num.numberHasNumberInputVal $ toNumConf config { title: show cmd, placeholder: take 1 (show cmd), range: minRange 0.0 }) unit - (HE.input $ \(NotifyChange n) → UpdateCommand cmd n)] + (HE.input $ \(Num.NotifyChange n) → UpdateCommand cmd n)] getComponent ∷ F.Command → IsoDuration → Number getComponent cmd d = fromMaybe 0.0 $ F.toGetter cmd (unIsoDuration d) @@ -101,7 +101,7 @@ buildDuration format = do where mkBuildStep ∷ F.Command → DSL m BuildStep mkBuildStep cmd = do - num ← query cmd $ H.request (left <<< GetValue) + num ← query cmd $ H.request (Num.GetValue) pure $ num <#> F.toSetter cmd >>> Endo runStep ∷ BuildStep -> Maybe (Either Errors IsoDuration) runStep step = step <#> \(Endo f) -> mkIsoDuration $ f mempty @@ -121,7 +121,7 @@ propagateChange ∷ ∀ m . F.Format → State → DSL m Unit propagateChange format duration = do map fold $ for (unwrap format) \cmd → do let n = duration >>= asRight >>= unIsoDuration >>> F.toGetter cmd - query cmd $ H.request $ left <<< SetValue n + query cmd $ H.action $ Num.SetValue n query ∷ ∀ m. Slot → ChildQuery ~> DSL m query cmd q = H.query cmd q >>= mustBeMounted diff --git a/src/Halogen/DatePicker/Component/Time.purs b/src/Halogen/DatePicker/Component/Time.purs index 7d81537..b50fcc3 100644 --- a/src/Halogen/DatePicker/Component/Time.purs +++ b/src/Halogen/DatePicker/Component/Time.purs @@ -27,8 +27,8 @@ import Halogen.Datepicker.Format.Time as F import Halogen.Datepicker.Internal.Choice as Choice import Halogen.Datepicker.Internal.Enums (Hour12, Meridiem, Millisecond1, Millisecond2) import Halogen.Datepicker.Internal.Elements (textElement, PreChoiceConfig, renderChoice, renderNum) -import Halogen.Datepicker.Internal.Num as Num -import Halogen.Datepicker.Internal.Range (Range, bottomTop) +import NumberInput.Halogen.Component as Num +import NumberInput.Range (Range, bottomTop) import Halogen.Datepicker.Internal.Utils (mapParentHTMLQuery, componentProps, foldSteps, mustBeMounted, pickerProps, transitionState') import Halogen.HTML as HH @@ -132,7 +132,7 @@ buildTime format = do num ← queryChoice cmd $ H.request (left <<< GetValue) pure $ num <#> \n → Join $ Star $ \t → F.toSetter cmd n t _ → do - num ← queryNum cmd $ H.request (left <<< GetValue) + num ← queryNum cmd $ H.request (Num.GetValue) pure $ num <#> \n → Join $ Star $ \t → F.toSetter cmd n t @@ -155,7 +155,7 @@ propagateChange format time = for_ (unwrap format) \cmd → case cmd of Choice.valueMustBeInValues res _ → do let val = value time >>= F.toGetter cmd - queryNum cmd $ H.request $ left <<< SetValue val + queryNum cmd $ H.action $ Num.SetValue val queryChoice ∷ ∀ m. ChoiceSlot → ChoiceQuery ~> DSL m queryChoice s q = H.query' cpChoice s q >>= mustBeMounted diff --git a/src/Halogen/DatePicker/Internal/Elements.purs b/src/Halogen/DatePicker/Internal/Elements.purs index ed14bc4..4c04803 100644 --- a/src/Halogen/DatePicker/Internal/Elements.purs +++ b/src/Halogen/DatePicker/Internal/Elements.purs @@ -11,8 +11,8 @@ import Halogen.Component.ChildPath (ChildPath) import Halogen.Datepicker.Component.Types (PickerMessage(..)) import Halogen.Datepicker.Config (Config(..)) import Halogen.Datepicker.Internal.Choice as Choice -import Halogen.Datepicker.Internal.Num as Num -import Halogen.Datepicker.Internal.Range (Range) +import NumberInput.Halogen.Component as Num +import NumberInput.Range (Range) import Halogen.HTML as HH import Halogen.HTML.Events as HE import Halogen.HTML.Properties as HP @@ -46,8 +46,8 @@ renderNum cpNum update toSetter cmd mainConf preConf = conf = toNumConf mainConf preConf in HH.slot' cpNum cmd - (Num.picker Num.intHasNumberInputVal conf) unit - (HE.input $ \(NotifyChange n) → update $ \t → n >>= (_ `toSetter cmd` t)) + (Num.input Num.intHasNumberInputVal conf) unit + (HE.input $ \(Num.NotifyChange n) → update $ \t → n >>= (_ `toSetter cmd` t)) toChoiceConf ∷ ∀ a. Config diff --git a/src/Halogen/DatePicker/Internal/Num.purs b/src/Halogen/DatePicker/Internal/Num.purs deleted file mode 100644 index 7d9f86f..0000000 --- a/src/Halogen/DatePicker/Internal/Num.purs +++ /dev/null @@ -1,222 +0,0 @@ -module Halogen.Datepicker.Internal.Num - ( picker - , NumQuery - , Query - , QueryIn - , Config - , Input - , mkInputValue - , HasNumberInputVal - , numberHasNumberInputVal - , intHasNumberInputVal - , boundedEnumHasNumberInputVal ) - where - -import Prelude - -import CSS as CSS -import Control.Alternative (class Alternative, empty) -import Control.Monad.Except (runExcept) -import Control.MonadPlus (guard) -import DOM.Event.Event (Event) -import Data.Bifunctor (lmap) -import Data.Enum (class BoundedEnum, fromEnum, toEnum) -import Data.Foreign (readBoolean, readString, toForeign) -import Data.Foreign.Index (readProp) -import Data.Functor.Coproduct (Coproduct, coproduct, right) -import Data.Int as Int -import Data.Maybe (Maybe(..), fromMaybe, maybe) -import Data.Number as N -import Data.String (Pattern(..), length, stripSuffix) -import Data.Tuple (Tuple(..), fst) -import Halogen as H -import Halogen.Datepicker.Component.Types (BasePickerQuery(..), PickerMessage(..)) -import Halogen.Datepicker.Internal.Range (Range(..), isInRange, rangeMax, rangeMin) -import Halogen.Datepicker.Internal.Utils (asRight, mapComponentHTMLQuery) -import Halogen.HTML as HH -import Halogen.HTML.CSS as HCSS -import Halogen.HTML.Core (ClassName) -import Halogen.HTML.Events as HE -import Halogen.HTML.Properties as HP - - -type State val = InputValue val - -type Message val = PickerMessage (Input val) -type Input val = Maybe val - -type Query val = Coproduct (QueryIn val) (NumQuery val) -type QueryIn val = BasePickerQuery Unit (Input val) -data NumQuery val a = Update (InputValue val) a - -type DSL val = H.ComponentDSL (State val) (Query val) (Message val) -type HTML val = H.ComponentHTML (NumQuery val) - -type Config val = - { title ∷ String - , placeholder ∷ String - , range ∷ Range val - , root ∷ Array ClassName - , rootInvalid ∷ Array ClassName - , rootLength ∷ Int -> Array ClassName - } - -picker ∷ ∀ val m - . Ord val - ⇒ HasNumberInputVal val - → Config val - → H.Component HH.HTML (Query val) Unit (Message val) m -picker hasNumberInputVal conf = H.component - { initialState: const emptyNumberInputValue - , render: render hasNumberInputVal conf >>> mapComponentHTMLQuery right - , eval: coproduct (evalPicker hasNumberInputVal) evalNumber - , receiver: const Nothing - } - -render ∷ ∀ val. Ord val ⇒ HasNumberInputVal val → Config val → State val → HTML val -render hasNumberInputVal conf num = numberElement hasNumberInputVal conf num - -evalNumber ∷ ∀ val m . Eq val ⇒ NumQuery val ~> DSL val m -evalNumber (Update number next) = do - prevNumber ← H.get - H.put number - unless (number == prevNumber) $ H.raise (NotifyChange $ fst number) - pure next - -toMbString ∷ ∀ a. HasNumberInputVal a → Maybe a → Maybe String -toMbString hasNumberInputVal number = (Just $ maybe "" hasNumberInputVal.toValue number) - -evalPicker ∷ ∀ val m . HasNumberInputVal val → QueryIn val ~> DSL val m -evalPicker hasNumberInputVal (SetValue number next) = do - H.put $ Tuple number (toMbString hasNumberInputVal number) - pure $ next unit -evalPicker _ (GetValue next) = H.get <#> (fst >>> next) - - -type InputValue a = Tuple (Maybe a) (Maybe String) - -toString ∷ ∀ a. InputValue a → String -toString (Tuple _ mbStr) = fromMaybe "" mbStr - -mkInputValue ∷ ∀ a. HasNumberInputVal a → a → InputValue a -mkInputValue hasNumberInputVal n = Tuple (Just n) (Just $ hasNumberInputVal.toValue n) - -emptyNumberInputValue ∷ ∀ a. InputValue a -emptyNumberInputValue = Tuple Nothing (Just "") - -isInvalid ∷ ∀ a. InputValue a → Boolean -isInvalid (Tuple Nothing (Just "")) = false -isInvalid (Tuple Nothing (Just _)) = true -isInvalid (Tuple _ Nothing) = true -isInvalid _ = false - -isEmpty ∷ ∀ a. InputValue a → Boolean -isEmpty (Tuple _ (Just "")) = true -isEmpty _ = false - -showNum ∷ Number → String -showNum 0.0 = "0" -showNum n = let str = show n - in fromMaybe str (stripSuffix (Pattern ".0") str) - -numberElement ∷ ∀ val - . Ord val - ⇒ HasNumberInputVal val - → Config val - → InputValue val - → HTML val -numberElement hasNumberInputVal conf value = HH.input $ - [ HP.type_ HP.InputNumber - , HP.classes classes - , HP.title conf.title - , HP.placeholder conf.placeholder - , HP.value valueStr - , HE.onInput $ HE.input $ - inputValueFromEvent - >>> parseValidInput - >>> isInputInRange conf.range - >>> Update - ] - <> (toArray (rangeMin conf.range) <#> hasNumberInputVal.toNumber >>> HP.min) - <> (toArray (rangeMax conf.range) <#> hasNumberInputVal.toNumber >>> HP.max) - <> [styles] - where - toArray = maybe [] pure - -- Number and String value must comute (`map toValue (fromString x) == Just x`) - -- to avoid this issues: - -- * if user types `-0` we will parse it as `0` or - -- * if user types `001` we will parse it as `1` or - -- * if user types `0.1111111111111111111111` we will parse it as `0.1111111111111111` or - -- * if user types `1e1` we will parse it as `10` - parseValidInput ∷ InputValue String → InputValue val - parseValidInput = lmap $ (=<<) \str → do - val ← hasNumberInputVal.fromString str - guard (hasNumberInputVal.toValue val == str) - pure val - - valueStr = toString value - sizeClass = case conf.range of - MinMax minVal maxVal → - conf.rootLength (max - (length $ hasNumberInputVal.toValue minVal) - (length $ hasNumberInputVal.toValue maxVal) - ) - _ → [] - classes = conf.root - <> sizeClass - <> (guard (isInvalid value) *> conf.rootInvalid) - controlWidth = 0.75 - styles = HCSS.style do - case conf.range of - MinMax _ _ → pure unit - _ | isInvalid value → pure unit - _ | isEmpty value → CSS.width $ CSS.em 2.25 - _ → CSS.width $ CSS.em (Int.toNumber (length valueStr) * 0.5 + 1.0 + controlWidth) - - --- We need to validate if value is in range manually as for example, --- if `min = 0`, user still can enter `-1` in chrome. -isInputInRange ∷ ∀ a. Ord a ⇒ Range a → InputValue a → InputValue a -isInputInRange range val = lmap (_ >>= boolToAltPredicate (isInRange range)) val - -boolToAltPredicate ∷ ∀ a f. Alternative f ⇒ (a → Boolean) → a → f a -boolToAltPredicate f a = if f a then pure a else empty - -inputValueFromEvent ∷ Event → InputValue String -inputValueFromEvent event = let val = validValueFromEvent event - in Tuple val val - -validValueFromEvent ∷ Event → Maybe String -validValueFromEvent event = join $ asRight $ runExcept $ do - target ← readProp "target" $ toForeign event - validity ← readProp "validity" target - badInput ← readProp "badInput" validity >>= readBoolean - value ← readProp "value" target >>= readString - pure (if badInput then Nothing else Just value) - -type HasNumberInputVal a = - { fromString ∷ String → Maybe a - , toValue ∷ a → String - , toNumber ∷ a → Number - } - -numberHasNumberInputVal ∷ HasNumberInputVal Number -numberHasNumberInputVal = - { fromString: N.fromString - , toValue: showNum - , toNumber: id - } - -intHasNumberInputVal ∷ HasNumberInputVal Int -intHasNumberInputVal = - { fromString: numberHasNumberInputVal.fromString >=> Int.fromNumber - , toValue: show - , toNumber: Int.toNumber - } - -boundedEnumHasNumberInputVal ∷ ∀ a. BoundedEnum a ⇒ HasNumberInputVal a -boundedEnumHasNumberInputVal = - { fromString: intHasNumberInputVal.fromString >=> toEnum - , toValue: fromEnum >>> intHasNumberInputVal.toValue - , toNumber: fromEnum >>> intHasNumberInputVal.toNumber - } diff --git a/src/Halogen/DatePicker/Internal/Range.purs b/src/Halogen/DatePicker/Internal/Range.purs deleted file mode 100644 index 948da3b..0000000 --- a/src/Halogen/DatePicker/Internal/Range.purs +++ /dev/null @@ -1,42 +0,0 @@ -module Halogen.Datepicker.Internal.Range where - -import Prelude - -import Data.Enum (class BoundedEnum) -import Data.Maybe (Maybe(..)) - -data Range a = MinMax a a | Min a | Max a - -instance rangeFunctor ∷ Functor Range where - map f (MinMax a b) = MinMax (f a) (f b) - map f (Min a) = Min (f a) - map f (Max a) = Max (f a) - -minmaxRange ∷ ∀ a. a → a → Range a -minmaxRange = MinMax - -minRange ∷ ∀ a. a → Range a -minRange = Min - -maxRange ∷ ∀ a. a → Range a -maxRange = Max - -rangeMin ∷ Range ~> Maybe -rangeMin (MinMax m _) = Just m -rangeMin (Min m) = Just m -rangeMin _ = Nothing - -rangeMax ∷ Range ~> Maybe -rangeMax (MinMax _ m) = Just m -rangeMax (Max m) = Just m -rangeMax _ = Nothing - -isInRange ∷ ∀ a. Ord a ⇒ Range a → a → Boolean -isInRange range n = case range of - (Min min) → min <= n - (Max max) → max >= n - (MinMax min max) → min <= n && n <= max - - -bottomTop ∷ ∀ a. BoundedEnum a ⇒ Range a -bottomTop = minmaxRange bottom top