Posted at

ローカル時刻を入力させて UTCTime で受け取るようなカスタムフィールド

More than 5 years have passed since last update.

色々な前提や import 文を省略しているのでもちろんそのままでは動かない。

localDatetimeField :: Field App App UTCTime

localDatetimeField = Field
{ fieldParse = \rawVals fVals ->
case rawVals of
[dayF, timeF] -> runErrorT $ do
tz <- liftIO getCurrentTimeZone
mDay <- ErrorT $ fieldParse dayField [dayF] fVals
mTime <- ErrorT $ fieldParse timeField [timeF] fVals
return $ localTimeToUTC tz <$> (LocalTime <$> mDay <*> mTime)
_ -> return $ Left . SomeMessage $ MsgInvalidDatetime
, fieldView = \idAttr nameAttr attrs eResult isReq -> do
timeId <- lift newIdent
tz <- liftIO getCurrentTimeZone
let dayWidget = fieldView dayField idAttr nameAttr attrs eDay isReq
timeWidget = fieldView timeField timeId nameAttr attrs eTime isReq
eDay = localDay . utcToLocalTime tz <$> eResult
eTime = localTimeOfDay . utcToLocalTime tz <$> eResult
[whamlet|$newline never
_{MsgDate} ^{dayWidget} #
_{MsgTime} ^{timeWidget}
|]
, fieldEnctype = UrlEncoded
}