Fix utcTimeField

src/Handler/Utils/DateTime.hs

@@ -31,9 +31,6 @@ utcToLocalTime = TZ.utcToLocalTimeTZ appTZ
 localTimeToUTC :: LocalTime -> LocalToUTCResult
 localTimeToUTC = TZ.localTimeToUTCFull appTZ
 
-formatTime' :: (FormatTime t, MonadHandler m, HandlerSite m ~ UniWorX) => String -> t -> m Text
-formatTime' fmtStr t = fmap fromString $ Time.formatTime <$> getTimeLocale <*> pure fmtStr <*> pure t
-
 class FormatTime t => HasLocalTime t where
   toLocalTime :: t -> LocalTime
 
@@ -46,10 +43,13 @@ instance HasLocalTime Day where
 instance HasLocalTime UTCTime where
   toLocalTime t = utcToLocalTime t
 
+formatTime' :: (HasLocalTime t, MonadHandler m, HandlerSite m ~ UniWorX) => String -> t -> m Text
+formatTime' fmtStr t = fmap fromString $ Time.formatTime <$> getTimeLocale <*> pure fmtStr <*> pure (toLocalTime t)
+
 -- formatTime :: (FormatTime t, MonadHandler m, HandlerSite m ~ UniWorX, IsString str) => (DateTimeFormat -> String) -> t -> m str
 -- Restricted type for safety
 formatTime :: (HasLocalTime t, MonadHandler m, HandlerSite m ~ UniWorX) => SelDateTimeFormat -> t -> m Text
-formatTime proj t = flip formatTime' (toLocalTime t) =<< (unDateTimeFormat <$> getDateTimeFormat proj)
+formatTime proj t = flip formatTime' t =<< (unDateTimeFormat <$> getDateTimeFormat proj)
 
 getTimeLocale :: (MonadHandler m, HandlerSite m ~ UniWorX) => m TimeLocale
 getTimeLocale = getTimeLocale' <$> languages

src/Handler/Utils/Form.hs

@@ -405,15 +405,16 @@ dayTimeField fs mutc = do
 -}
 
 
-utcTimeField :: (Monad m, RenderMessage (HandlerSite m) FormMessage, RenderMessage (HandlerSite m) UniWorXMessage) => Field m UTCTime
+utcTimeField :: (MonadHandler m, HandlerSite m ~ UniWorX) => Field m UTCTime
 -- StackOverflow: dayToUTC <$> (areq (jqueryDayField def {...}) settings Nothing)
 -- Browser returns LocalTime
 utcTimeField = Field
     { fieldParse = parseHelperGen $ readTime
-    , fieldView = \theId name attrs val isReq ->
+    , fieldView = \theId name attrs val isReq -> do
+        val' <- either id id <$> traverse (formatTime' fieldTimeFormat) val
         [whamlet|
           $newline never
-          <input id="#{theId}" name="#{name}" *{attrs} type="datetime-local" :isReq:required value="#{either id showTime val}">
+          <input id="#{theId}" name="#{name}" *{attrs} type="datetime-local" :isReq:required value="#{val'}">
         |]
     , fieldEnctype = UrlEncoded
     }
@@ -431,9 +432,6 @@ utcTimeField = Field
         (Just (LTUAmbiguous _ _ _ _)) -> Left MsgAmbiguousUTCTime
         Nothing -> Left MsgInvalidDateTimeFormat
 
-    showTime :: UTCTime -> Text
-    showTime = fromString . (Time.formatTime defaultTimeLocale fieldTimeFormat)
-
 
 fsm :: RenderMessage UniWorX msg => msg -> FieldSettings UniWorX -- DEPRECATED
 fsm = bfs -- TODO: get rid of Bootstrap