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

色々な前提や 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
    }