From 3bfe0bdcb79b398a387e202c5150b5e6fd230d3a Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Thu, 16 Mar 2017 01:19:07 +0100 Subject: More complicated date handling --- Handler/Common.hs | 100 +++++++++++++++++++++++++++++-------- Handler/List.hs | 20 ++++++-- Handler/OpenItem.hs | 2 +- Import/NoFoundation.hs | 1 + Model.hs | 33 ++++++------ Model/Types.hs | 35 +++++++++++++ bar.cabal | 1 + config/models | 6 +-- templates/default-layout.cassius | 2 +- templates/inventoryListing.cassius | 3 ++ templates/inventoryListing.hamlet | 33 ++++++------ 11 files changed, 175 insertions(+), 61 deletions(-) create mode 100644 Model/Types.hs create mode 100644 templates/inventoryListing.cassius diff --git a/Handler/Common.hs b/Handler/Common.hs index a1ae34b..990732d 100644 --- a/Handler/Common.hs +++ b/Handler/Common.hs @@ -28,9 +28,19 @@ import Handler.Common.Types import Text.Julius (RawJS(..)) +import Data.List.NonEmpty (NonEmpty) +import Data.Semigroup hiding (First(..)) +import Data.Monoid (First(..)) + dayFormat :: Day -> String dayFormat = formatTime defaultTimeLocale "%e. %b %y" +data DayFormConfig = DayFormConfig + { dfNever :: Bool + , dfUnknown :: Bool + , dfKnown :: Bool + } + itemForm :: Maybe Item -- ^ Update existing item or insert new? -> Html -> MForm Handler (FormResult (WithType Item), Widget) itemForm proto identView = do @@ -41,12 +51,12 @@ itemForm proto identView = do let kt kWidget tWidget = [whamlet|
^{kWidget} -
^{tWidget} +
^{tWidget} |] ((kindRes, typeRes), typedKindWidget) <- typedKindField kt ((itemKind <$> proto), t) - (boughtRes, boughtWidget) <- dayForm (maybe (Just $ Just today) Just $ fmap itemBought proto) "Unknown" - (expiresRes, expiresWidget) <- dayForm (fmap itemExpires proto) "Never" - (openedRes, openedWidget) <- dayForm (fmap itemOpened proto) "Never" + (boughtRes, boughtWidget) <- dayForm (Just . fromMaybe (DateKnown today) $ itemBought <$> proto) $ DayFormConfig False True True + (expiresRes, expiresWidget) <- dayForm (itemExpires <$> proto) $ DayFormConfig True False True + (openedRes, openedWidget) <- dayForm (itemOpened <$> proto) $ DayFormConfig True True True let itemRes = do itemKind <- kindRes @@ -66,33 +76,79 @@ itemForm proto identView = do
^{openedWidget} |] where - dayForm :: Maybe (Maybe Day) -> String -> MForm Handler (FormResult (Maybe Day), Widget) - dayForm proto label = do + dayForm :: Maybe ItemDate -> DayFormConfig -> MForm Handler (FormResult ItemDate, Widget) + dayForm proto DayFormConfig{..} = do today <- utctDay <$> liftIO getCurrentTime - checkboxId <- ("check" <>) . show . hashUnique <$> liftIO newUnique + let mWhen = bool (Nothing <$) (fmap Just) + + neverBoxId <- ("check" <>) . show . hashUnique <$> liftIO newUnique + unknownBoxId <- ("check" <>) . show . hashUnique <$> liftIO newUnique + groupId <- ("dateGroup" <>) . show . hashUnique <$> liftIO newUnique - (fmap (fromMaybe False) -> isNothingRes, isNothingView) <- - mopt checkBoxField ("" { fsId = Just $ Text.pack checkboxId }) . Just . Just . fromMaybe True $ fmap isNothing proto - (dayRes, dayView) <- - mreq dayField "" . Just . fromMaybe today $ join proto + dNever <- mWhen dfNever $ + mopt checkBoxField ("" { fsId = Just $ Text.pack neverBoxId }) . Just . Just . fromMaybe True $ fmap isNever proto + dUnknown <- mWhen dfUnknown $ + mopt checkBoxField ("" { fsId = Just $ Text.pack unknownBoxId }) . Just . Just . fromMaybe False $ fmap isUnknown proto + dDay <- mWhen dfKnown $ + mopt dayField "" . Just . Just $ case proto of + Just (DateKnown d) -> d + _ -> today - let res = (bool Just (const Nothing) <$> isNothingRes) <*> dayRes + let res = resFromMaybe . fromMaybe FormMissing . fmap (fmap getFirst) $ mconcat + [ fmap (fmap (First . bool Nothing (Just DateNever) . fromMaybe False) . fst) dNever + , fmap (fmap (First . bool Nothing (Just DateUnknown) . fromMaybe False) . fst) dUnknown + , fmap (fmap (First . fmap DateKnown) . fst) dDay + ] + resFromMaybe (FormSuccess Nothing) = FormFailure ["Missing required information"] + resFromMaybe (FormSuccess (Just x)) = FormSuccess x + resFromMaybe FormMissing = FormMissing + resFromMaybe (FormFailure es) = FormFailure es return . (res, ) $ do + toWidget $ + [julius| + $(function () { + var updateInput = function() { + $('##{rawJS groupId} :input').filter(':not(:checkbox)').prop("disabled", $('##{rawJS groupId} :checkbox').filter(':checked').length > 0); + }; + + $('##{rawJS groupId} :checkbox').change(function() { + if (this.checked) { + $('##{rawJS groupId} :checkbox').not(this).prop('checked', false); + } + updateInput(); + }); + + updateInput(); + }); + |] + let width = length $ (filter id [ isJust dNever, isJust dUnknown ] :: [Bool]) [whamlet| $newline never -
-
-