Add date and time inputs, closes #15

Author: sharkdp

bower.json

@@ -17,11 +17,12 @@
   },
   "dependencies": {
     "purescript-foldable-traversable": "^1.0.0",
-    "purescript-dom": "^1.0.0",
-    "purescript-signal": "^6.0.0",
+    "purescript-dom": "^2.0.0",
+    "purescript-signal": "^6.1.0",
     "purescript-canvas": "^1.0.0",
     "purescript-drawing": "^1.0.0",
     "purescript-smolder": "^4.0.0",
-    "purescript-nonempty": "^1.0.0"
+    "purescript-nonempty": "^1.0.0",
+    "purescript-datetime": "^1.0.0"
   }
 }

html/index.html

@@ -215,6 +215,19 @@ <h3>Example 16: Using other Signal functions (here: since)</h3>
         <div id="controls16"></div>
         <div id="output16"></div>
 
+        <h3>Example 17: Date input</h3>
+<pre>
+ui = showDiff &lt;$&gt; date &quot;Date 1&quot; (fromMaybe bottom date1)
+              &lt;*&gt; date &quot;Date 2&quot; (fromMaybe bottom date2)
+  where
+    date1 = canonicalDate &lt;$&gt; toEnum 1986 &lt;*&gt; toEnum 7 &lt;*&gt; toEnum 3
+    date2 = canonicalDate &lt;$&gt; toEnum 2016 &lt;*&gt; toEnum 8 &lt;*&gt; toEnum 5
+    showDiff d1 d2 = &quot;Days between the dates: &quot; &lt;&gt;
+                     show (round $ abs $ unDays $ diff d1 d2)
+</pre>
+        <div id="controls17"></div>
+        <div id="output17"></div>
+
         <script type="text/javascript" src="main.js"></script>
     </body>
 </html>

src/Flare.js

@@ -327,4 +327,48 @@ exports.cColor = createComponent("color",
   }
 );
 
+function padNumber(num) {
+  var str = num.toString();
+  if (str.length == 1) {
+    str = "0" + str;
+  }
+  return str;
+}
+
+exports.cDate = createComponent("date",
+  function(initial) {
+    var input = document.createElement("input");
+    input.type = "date";
+    input.value = initial.year.toString() + "-" +
+                  padNumber(initial.month) + "-" +
+                  padNumber(initial.day);
+    return input;
+  },
+  "input",
+  function(t, initial) {
+    var parts = t.value.split("-");
+    return { year: parseInt(parts[0], 10),
+             month: parseInt(parts[1], 10),
+             day: parseInt(parts[2])
+           };
+  }
+);
+
+exports.cTime = createComponent("time",
+  function(initial) {
+    var input = document.createElement("input");
+    input.type = "time";
+    input.value = padNumber(initial.hours.toString()) + ":" +
+                  padNumber(initial.minutes.toString());
+    return input;
+  },
+  "input",
+  function(t, initial) {
+    var parts = t.value.split(":");
+    return { hours: parseInt(parts[0], 10),
+             minutes: parseInt(parts[1], 10)
+           };
+  }
+);
+
 // vim: ts=2:sw=2

src/Flare.purs

@@ -31,6 +31,10 @@ module Flare
   , radioGroup_
   , color
   , color_
+  , date
+  , date_
+  , time
+  , time_
   , fieldset
   , applyUIFlipped
   , (<**>)
@@ -53,6 +57,10 @@ import Data.Maybe.First (First(..), runFirst)
 import Data.Monoid (class Monoid, mempty)
 import Data.Foldable (class Foldable, traverse_, foldMap)
 import Data.Traversable (class Traversable, traverse)
+import Data.Enum (toEnum, fromEnum)
+import Data.Date (Date, exactDate)
+import Data.Date as Date
+import Data.Time (Time(..))
 
 import Control.Apply (lift2)
 import Control.Monad.Eff (Eff)
@@ -130,6 +138,12 @@ foreign import cSelect :: forall a. Array a -> (a -> String) -> CreateComponent
 foreign import cRadioGroup :: forall a. Array a -> (a -> String) -> CreateComponent a
 foreign import cColor :: CreateComponent String
 
+type DateRec = { year :: Int, month :: Int, day :: Int }
+type TimeRec = { hours :: Int, minutes :: Int }
+
+foreign import cDate :: CreateComponent DateRec
+foreign import cTime :: CreateComponent TimeRec
+
 -- | Set up the HTML element for a given component and create the corresponding
 -- | signal channel.
 createUI :: forall e a. (CreateComponent a) -> Label -> a -> UI e a
@@ -279,6 +293,40 @@ color label default = (fromMaybe default <<< fromHexString) <$>
 color_ :: forall e. Color -> UI e Color
 color_ = color ""
 
+-- | Creates a date input field from a label and default `Date`.
+date :: forall e. Label -> Date -> UI e Date
+date label default = (fromMaybe default <<< toDate) <$>
+                        createUI cDate label { year: fromEnum (Date.year default)
+                                             , month: fromEnum (Date.month default)
+                                             , day: fromEnum (Date.day default)
+                                             }
+  where
+    toDate :: DateRec -> Maybe Date
+    toDate { year, month, day } = do
+      y <- toEnum year
+      m <- toEnum month
+      d <- toEnum day
+      exactDate y m d
+
+-- | Like `date`, but without a label.
+date_ :: forall e. Date -> UI e Date
+date_ = date ""
+
+-- | Creates a time input field from a label and default `Time`.
+time :: forall e. Label -> Time -> UI e Time
+time label default = (fromMaybe default <<< toTime) <$>
+                       createUI cTime label { hours: 0, minutes: 30 }
+  where
+    toTime :: TimeRec -> Maybe Time
+    toTime { hours, minutes } = Time <$> toEnum hours
+                                     <*> toEnum minutes
+                                     <*> toEnum 0
+                                     <*> toEnum 0
+
+-- | Like `time`, but without a label.
+time_ :: forall e. Time -> UI e Time
+time_ = time ""
+
 foreign import toFieldset :: Label -> Array Element -> Element
 
 -- | Group the components of a UI inside a fieldset element with a given title.

test/Main.purs

@@ -6,11 +6,14 @@ import Control.Monad.Eff (Eff)
 import Control.Apply (lift2)
 import Data.Array (cons, (..), length, zipWith)
 import Data.NonEmpty ((:|))
-import Data.Maybe (maybe)
+import Data.Maybe (maybe, fromMaybe)
 import Data.Monoid (mempty)
+import Data.Enum (toEnum)
 import Data.Foldable (foldMap, sum)
-import Data.Int (toNumber)
+import Data.Int (toNumber, round)
 import Data.Traversable (traverse)
+import Data.Date (canonicalDate, diff)
+import Data.Time.Duration (unDays)
 import Math (pow, sin, cos, pi, abs)
 
 import DOM (DOM)
@@ -27,7 +30,8 @@ import Text.Smolder.HTML.Attributes as A
 
 import Flare (UI, runFlareShow, runFlareWith, runFlare, button, liftSF, buttons,
               foldp, select, intSlider, numberSlider, string, intSlider_,
-              boolean_, lift, color, number_, int_, string_, number, (<**>))
+              boolean_, lift, color, number_, int_, string_, number, (<**>),
+              date)
 import Flare.Drawing (Color, Drawing, runFlareDrawing, rgb, hsl, cssStringHSLA,
                       path, lineWidth, black, outlineColor, outlined, fillColor,
                       filled, circle)
@@ -218,6 +222,16 @@ light on = H.with H.div arg mempty
 ui16 :: forall e. UI e H.Markup
 ui16 = light <$> liftSF (since 1000.0) (button "Switch on" unit unit)
 
+-- Example 17
+
+ui17 :: forall e. UI e String
+ui17 = showDiff <$> date "Date 1" (fromMaybe bottom date1)
+                <*> date "Date 2" (fromMaybe bottom date2)
+  where
+    date1 = canonicalDate <$> toEnum 1986 <*> toEnum 7 <*> toEnum 3
+    date2 = canonicalDate <$> toEnum 2016 <*> toEnum 8 <*> toEnum 5
+    showDiff d1 d2 = "Days between the dates: " <> show (round $ abs $ unDays $ diff d1 d2)
+
 
 -- Render everything to the DOM
 
@@ -239,3 +253,4 @@ main = do
   runFlareWith    "controls14a"     inner  ui14
   runFlareShow    "controls15"  "output15" ui15
   runFlareHTML    "controls16"  "output16" ui16
+  runFlare        "controls17"  "output17" ui17