API-3333 Support Default Time

Makefile

@@ -25,10 +25,12 @@ PACKAGE_LOCK := $(ROOT_DIR)/package-lock.json
 
 FORMAT_SRC_PURS_TIDY_STAMP := $(BUILD_DIR)/.format-src-purs-tidy-stamp
 FORMAT_TEST_PURS_TIDY_STAMP := $(BUILD_DIR)/.format-test-purs-tidy-stamp
+FORMAT_UI_GUIDE_PURS_TIDY_STAMP := $(BUILD_DIR)/.format-ui-guide-purs-tidy-stamp
 
 FORMAT_DEPENDENCIES := \
 	$(FORMAT_SRC_PURS_TIDY_STAMP) \
-	$(FORMAT_TEST_PURS_TIDY_STAMP)
+	$(FORMAT_TEST_PURS_TIDY_STAMP) \
+	$(FORMAT_UI_GUIDE_PURS_TIDY_STAMP)
 
 # Colors for printing
 CYAN := \033[0;36m
@@ -88,6 +90,10 @@ $(FORMAT_TEST_PURS_TIDY_STAMP): $(TEST_FILES) $(NODE_MODULES_STAMP) | $(BUILD)
 	$(PURS_TIDY) $(PURS_TIDY_CMD) $(TEST_DIR)
 	@touch $@
 
+$(FORMAT_UI_GUIDE_PURS_TIDY_STAMP): $(TEST_FILES) $(NODE_MODULES_STAMP) | $(BUILD)
+	$(PURS_TIDY) $(PURS_TIDY_CMD) $(UI_GUIDE_DIR)
+	@touch $@
+
 $(NODE_MODULES): $(PACKAGE_JSON) $(PACKAGE_LOCK)
 	npm install
 	touch $@
@@ -116,6 +122,10 @@ check-format-src: $(FORMAT_SRC_PURS_TIDY_STAMP) ## Validate formatting of the `s
 check-format-test: PURS_TIDY_CMD=check
 check-format-test: $(FORMAT_TEST_PURS_TIDY_STAMP) ## Validate formatting of the `test` directory
 
+.PHONY: check-format-ui-guide
+check-format-ui-guide: PURS_TIDY_CMD=check
+check-format-ui-guide: $(FORMAT_UI-GUIDE_PURS_TIDY_STAMP) ## Validate formatting of the `test` directory
+
 .PHONY: clean
 clean: $(CLEAN_DEPS) ## Remove all dependencies and build artifacts, starting with a clean slate
 	rm -fr \
@@ -138,6 +148,10 @@ format-src: $(FORMAT_SRC_PURS_TIDY_STAMP) ## Format the `src` directory
 format-test: PURS_TIDY_CMD=format-in-place
 format-test: $(FORMAT_TEST_PURS_TIDY_STAMP) ## Format the `test` directory
 
+.PHONY: format-ui-guide
+format-ui-guide: PURS_TIDY_CMD=format-in-place
+format-ui-guide: $(FORMAT_UI_GUIDE_PURS_TIDY_STAMP) ## Format the `test` directory
+
 .PHONY: help
 help: $(BUILD_DIR)/help ## Display this help message
 	@awk 'BEGIN {FS = ":.*?## "}; {printf "$(CYAN)%-30s$(RESET) %s\n", $$1, $$2}' $<

package.json

@@ -1,6 +1,6 @@
 {
   "name": "purescript-ocelot",
-  "version": "0.34.2",
+  "version": "0.35.0",
   "private": true,
   "scripts": {
     "build-all": "make build",

src/DateTimePicker.purs

@@ -52,7 +52,8 @@ type ComponentM m a = H.HalogenM State Action ChildSlots Output m a
 type ComponentRender m = State -> ComponentHTML m
 
 type Input =
-  { disabled :: Boolean
+  { defaultTime :: Maybe Time
+  , disabled :: Boolean
   , interval :: Maybe Interval
   , selection :: Maybe DateTime
   , targetDate :: Maybe (Year /\ Month)
@@ -79,6 +80,7 @@ type Slot = H.Slot Query Output
 
 type State =
   { date :: Maybe Date
+  , defaultTime :: Maybe Time
   , disabled :: Boolean
   , interval :: Maybe Interval
   , targetDate :: Maybe (Year /\ Month)
@@ -110,17 +112,26 @@ handleAction = case _ of
   HandleDate msg -> case msg of
     DatePicker.SelectionChanged date' -> do
       state <- H.get
-      raiseSelectionChanged state.interval date' state.time
-      H.modify_ _ { date = date' }
+      case state.defaultTime, state.time of
+        Just defaultTime, Nothing -> do
+          H.tell _timepicker unit $ TimePicker.SetSelection $ Just defaultTime
+          H.modify_ _ { date = date', time = Just defaultTime }
+          raiseSelectionChanged state.interval date' (Just defaultTime)
+        _, _ -> do
+          H.modify_ _ { date = date' }
+          raiseSelectionChanged state.interval date' state.time
     _ -> H.raise $ DateOutput msg
   HandleTime msg -> case msg of
     TimePicker.SelectionChanged time' -> do
       state <- H.get
-      raiseSelectionChanged state.interval state.date time'
       H.modify_ _ { time = time' }
+      raiseSelectionChanged state.interval state.date time'
     _ -> H.raise $ TimeOutput msg
   Receive input -> do
-    H.modify_ _ { interval = input.interval }
+    H.modify_ _
+      { disabled = input.disabled
+      , interval = input.interval
+      }
 
 handleQuery :: forall m a. Query a -> ComponentM m (Maybe a)
 handleQuery = case _ of
@@ -144,6 +155,7 @@ handleQuery = case _ of
 initialState :: Input -> State
 initialState input =
   { date: input.selection <#> Date.DateTime.date
+  , defaultTime: input.defaultTime
   , disabled: input.disabled
   , interval: input.interval
   , targetDate: input.targetDate
@@ -164,16 +176,22 @@ raiseSelectionChanged ::
   Maybe Date ->
   Maybe Time ->
   ComponentM m Unit
-raiseSelectionChanged mInterval mDate mTime = case mInterval of
-  Nothing -> H.raise $ SelectionChanged mDateTime
-  Just interval -> case mDateTime of
-    Nothing -> H.raise $ SelectionChanged mDateTime
-    Just dateTime
-      | isWithinInterval interval dateTime -> H.raise $ SelectionChanged mDateTime
-      | otherwise -> pure unit -- NOTE transient state during parent-child synchronization
+raiseSelectionChanged mInterval mDate mTime = case maybeSelection of
+  Nothing -> pure unit
+  Just selection -> case mInterval of
+    Nothing -> H.raise $ SelectionChanged selection
+    Just interval -> case selection of
+      Nothing -> H.raise $ SelectionChanged selection
+      Just dateTime
+        | isWithinInterval interval dateTime -> H.raise $ SelectionChanged selection
+        | otherwise -> pure unit -- NOTE transient state during parent-child synchronization
   where
-  mDateTime :: Maybe DateTime
-  mDateTime = DateTime <$> mDate <*> mTime
+  maybeSelection :: Maybe (Maybe DateTime)
+  maybeSelection = case mDate, mTime of
+    Nothing, Nothing -> Just Nothing
+    Nothing, Just _ -> Nothing
+    Just _, Nothing -> Nothing
+    Just date, Just time -> Just $ Just $ Date.DateTime.DateTime date time
 
 render :: forall m. MonadAff m => ComponentRender m
 render state =

ui-guide/App/App.purs

@@ -65,15 +65,16 @@ instance showGroup :: Show Group where
 type HTML m = H.ComponentHTML Action Slots m
 
 type Slots =
-  ( child :: H.Slot (Const Void) Void String )
+  (child :: H.Slot (Const Void) Void String)
+
 _child = Proxy :: Proxy "child"
 
 -- | Takes stories config and mount element, and renders the storybook.
-runStorybook
- :: Stories Aff
- -> Array Group
- -> HTMLElement
- -> Aff Unit
+runStorybook ::
+  Stories Aff ->
+  Array Group ->
+  HTMLElement ->
+  Aff Unit
 runStorybook stories groups body = do
   app' <- runUI app { stories, groups } body
   void $ H.liftEffect $ hashes $ \_ next ->
@@ -84,7 +85,7 @@ type Input m =
   , groups :: Array Group
   }
 
-app :: ∀ m. H.Component Query (Input m) Void m
+app :: forall m. H.Component Query (Input m) Void m
 app =
   H.mkComponent
     { initialState
@@ -99,31 +100,32 @@ app =
   render :: State m -> HTML m
   render state =
     HH.body_
-    [ HH.div
-      [ HP.class_ $ HH.ClassName "min-h-screen" ]
-      [ renderSidebar state
-      , renderContainer state
+      [ HH.div
+          [ HP.class_ $ HH.ClassName "min-h-screen" ]
+          [ renderSidebar state
+          , renderContainer state
+          ]
       ]
-    ]
 
   renderContainer :: State m -> HTML m
   renderContainer state =
     HH.div
-    [ HP.class_ $ HH.ClassName "md:ml-80" ]
-    [ HH.div
-      [ HP.class_ $ HH.ClassName "fixed w-full" ]
+      [ HP.class_ $ HH.ClassName "md:ml-80" ]
       [ HH.div
-        [ HP.class_ $ HH.ClassName "pin-t bg-white md:hidden relative border-b border-grey-light h-12 py-8 flex items-center" ]
-        [ HH.a
-          [ HP.class_ $ HH.ClassName "mx-auto inline-flex items-center"
-          , HP.href "" ]
-          [ HH.text "CitizenNet UI Guide" ]
-        ]
+          [ HP.class_ $ HH.ClassName "fixed w-full" ]
+          [ HH.div
+              [ HP.class_ $ HH.ClassName "pin-t bg-white md:hidden relative border-b border-grey-light h-12 py-8 flex items-center" ]
+              [ HH.a
+                  [ HP.class_ $ HH.ClassName "mx-auto inline-flex items-center"
+                  , HP.href ""
+                  ]
+                  [ HH.text "CitizenNet UI Guide" ]
+              ]
+          ]
+      , HH.div
+          [ HP.class_ $ HH.ClassName "p-12 w-full container mx-auto" ]
+          [ renderSlot state ]
       ]
-    , HH.div
-      [ HP.class_ $ HH.ClassName "p-12 w-full container mx-auto" ]
-      [ renderSlot state ]
-    ]
 
   renderSlot :: State m -> HTML m
   renderSlot state =
@@ -135,71 +137,71 @@ app =
   renderSidebar :: State m -> HTML m
   renderSidebar state =
     Backdrop.backdrop
-    [ HP.id "sidebar"
-    , HP.classes
-      ( HH.ClassName <$>
-        [ "hidden"
-        , "fixed"
-        , "pin-y"
-        , "pin-l"
-        , "overflow-y-auto"
-        , "md:overflow-visible"
-        , "scrolling-touch"
-        , "md:scrolling-auto"
-        , "w-4/5"
-        , "md:w-full"
-        , "md:max-w-xs"
-        , "flex-none"
-        -- , "border-r-2"
-        -- , "border-grey-light"
-        , "md:flex"
-        , "flex-col"
-        ]
-      )
-    ]
-    [ HH.div
-      [ HP.class_ $ HH.ClassName "flex-1 p-6 overflow-y-auto" ]
-      [ HH.header_
-        [ Format.heading
-          [ HP.class_ $ HH.ClassName "flex" ]
-          [ HH.img
-            [ HP.class_ $ HH.ClassName "mr-2"
-            , HP.src "https://citizennet.com/manager/images/logo.svg"
-            ]
-          , HH.text "Ocelot"
+      [ HP.id "sidebar"
+      , HP.classes
+          ( HH.ClassName <$>
+              [ "hidden"
+              , "fixed"
+              , "pin-y"
+              , "pin-l"
+              , "overflow-y-auto"
+              , "md:overflow-visible"
+              , "scrolling-touch"
+              , "md:scrolling-auto"
+              , "w-4/5"
+              , "md:w-full"
+              , "md:max-w-xs"
+              , "flex-none"
+              -- , "border-r-2"
+              -- , "border-grey-light"
+              , "md:flex"
+              , "flex-col"
+              ]
+          )
+      ]
+      [ HH.div
+          [ HP.class_ $ HH.ClassName "flex-1 p-6 overflow-y-auto" ]
+          [ HH.header_
+              [ Format.heading
+                  [ HP.class_ $ HH.ClassName "flex" ]
+                  [ HH.img
+                      [ HP.class_ $ HH.ClassName "mr-2"
+                      , HP.src "https://citizennet.com/manager/images/logo.svg"
+                      ]
+                  , HH.text "Ocelot"
+                  ]
+              ]
+          , HH.nav
+              [ HP.class_ $ HH.ClassName "text-base overflow-y-auto" ]
+              (renderGroups state)
           ]
-        ]
-      , HH.nav
-        [ HP.class_ $ HH.ClassName "text-base overflow-y-auto" ]
-        (renderGroups state)
       ]
-    ]
 
   renderGroups :: State m -> Array (HTML m)
   renderGroups state =
     mapFlipped (M.toUnfoldable state.partitions) $ \(Tuple group stories) ->
       HH.div
-      [ HP.class_ $ HH.ClassName "mb-6" ]
-      [ Format.caption_
-        [ HH.text $ show group ]
-      , renderGroup state.route stories
-      ]
+        [ HP.class_ $ HH.ClassName "mb-6" ]
+        [ Format.caption_
+            [ HH.text $ show group ]
+        , renderGroup state.route stories
+        ]
 
   renderGroup :: String -> Stories m -> HTML m
   renderGroup route stories =
-    HH.ul [ HP.class_ $ HH.ClassName "list-reset" ] $
-      mapFlipped (M.toUnfoldable stories) $ \(Tuple href { anchor }) ->
-        HH.li
-        [ HP.class_ $ HH.ClassName "mb-3" ]
-        [ HH.a
-          [ HP.classes $
-            Format.linkClasses <>
-            ( if href == route then [ HH.ClassName "font-medium" ] else [] )
-          , HP.href $ "#" <> unsafeEncodeURI href
-          ]
-          [ HH.text anchor ]
-        ]
-
+    HH.ul [ HP.class_ $ HH.ClassName "list-reset" ]
+      $ mapFlipped (M.toUnfoldable stories)
+      $ \(Tuple href { anchor }) ->
+          HH.li
+            [ HP.class_ $ HH.ClassName "mb-3" ]
+            [ HH.a
+                [ HP.classes $
+                    Format.linkClasses <>
+                      (if href == route then [ HH.ClassName "font-medium" ] else [])
+                , HP.href $ "#" <> unsafeEncodeURI href
+                ]
+                [ HH.text anchor ]
+            ]
 
   eval :: forall a. Query a -> H.HalogenM (State m) Action Slots Void m (Maybe a)
   eval (RouteChange route next) = do
@@ -209,7 +211,7 @@ app =
 ----------
 -- Helpers
 
-partitionByGroup :: ∀ m. Group -> Stories m -> Tuple Group (Stories m)
+partitionByGroup :: forall m. Group -> Stories m -> Tuple Group (Stories m)
 partitionByGroup g = Tuple g <<< M.filter (\{ group } -> group == g)
 
 unsafeEncodeURI :: String -> String