diff --git a/src/Handler/Utils/DateTime.hs b/src/Handler/Utils/DateTime.hs index aa33587ee..e6088cd79 100644 --- a/src/Handler/Utils/DateTime.hs +++ b/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 diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index e16be54d4..4c549109a 100644 --- a/src/Handler/Utils/Form.hs +++ b/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 - + |] , 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