diff options
| -rw-r--r-- | Handler/Common.hs | 7 | ||||
| -rw-r--r-- | Model.hs | 12 | ||||
| -rw-r--r-- | bar.cabal | 2 | ||||
| -rw-r--r-- | bar.nix | 2 | ||||
| -rw-r--r-- | config/models | 1 | ||||
| -rw-r--r-- | templates/inventoryListing.cassius | 7 | ||||
| -rw-r--r-- | templates/inventoryListing.hamlet | 5 | 
7 files changed, 30 insertions, 6 deletions
diff --git a/Handler/Common.hs b/Handler/Common.hs index 90e373a..799f692 100644 --- a/Handler/Common.hs +++ b/Handler/Common.hs  | |||
| @@ -70,12 +70,14 @@ itemForm proto identView = do | |||
| 70 | (boughtRes, boughtWidget) <- dayForm (Just . fromMaybe (DateKnown today) $ itemBought <$> proto) $ DayFormConfig False True True | 70 | (boughtRes, boughtWidget) <- dayForm (Just . fromMaybe (DateKnown today) $ itemBought <$> proto) $ DayFormConfig False True True | 
| 71 | (expiresRes, expiresWidget) <- dayForm (itemExpires <$> proto) $ DayFormConfig True False True | 71 | (expiresRes, expiresWidget) <- dayForm (itemExpires <$> proto) $ DayFormConfig True False True | 
| 72 | (openedRes, openedWidget) <- dayForm (itemOpened <$> proto) $ DayFormConfig True True True | 72 | (openedRes, openedWidget) <- dayForm (itemOpened <$> proto) $ DayFormConfig True True True | 
| 73 | ((fmap $ fromMaybe False -> runningLowRes), runningLowWidget) <- mopt checkBoxField "" . Just . Just . fromMaybe False $ fmap itemRunningLow proto | ||
| 73 | 74 | ||
| 74 | let itemRes = do | 75 | let itemRes = do | 
| 75 | itemKind <- kindRes | 76 | itemKind <- kindRes | 
| 76 | itemBought <- boughtRes | 77 | itemBought <- boughtRes | 
| 77 | itemExpires <- expiresRes | 78 | itemExpires <- expiresRes | 
| 78 | itemOpened <- openedRes | 79 | itemOpened <- openedRes | 
| 80 | itemRunningLow <- runningLowRes | ||
| 79 | t <- typeRes | 81 | t <- typeRes | 
| 80 | return $ Item{ itemNormKind = normalizeKind itemKind, ..} `WithType` t | 82 | return $ Item{ itemNormKind = normalizeKind itemKind, ..} `WithType` t | 
| 81 | 83 | ||
| @@ -87,6 +89,11 @@ itemForm proto identView = do | |||
| 87 | <div .td>^{boughtWidget} | 89 | <div .td>^{boughtWidget} | 
| 88 | <div .td>^{expiresWidget} | 90 | <div .td>^{expiresWidget} | 
| 89 | <div .td>^{openedWidget} | 91 | <div .td>^{openedWidget} | 
| 92 | <div .td> | ||
| 93 | <ul .status> | ||
| 94 | <li>^{fvInput runningLowWidget} # | ||
| 95 | <label for=#{fvId runningLowWidget}> | ||
| 96 | Running low | ||
| 90 | |] | 97 | |] | 
| 91 | where | 98 | where | 
| 92 | dayForm :: Maybe ItemDate -> DayFormConfig -> MForm Handler (FormResult ItemDate, Widget) | 99 | dayForm :: Maybe ItemDate -> DayFormConfig -> MForm Handler (FormResult ItemDate, Widget) | 
| @@ -1,5 +1,6 @@ | |||
| 1 | {-# LANGUAGE FlexibleInstances #-} | 1 | {-# LANGUAGE FlexibleInstances #-} | 
| 2 | {-# LANGUAGE DeriveFunctor #-} | 2 | {-# LANGUAGE DeriveFunctor #-} | 
| 3 | {-# LANGUAGE PatternGuards #-} | ||
| 3 | 4 | ||
| 4 | module Model where | 5 | module Model where | 
| 5 | 6 | ||
| @@ -71,10 +72,11 @@ withTypes vals = do | |||
| 71 | instance Ord Item where | 72 | instance Ord Item where | 
| 72 | x `compare` y = mconcat cmprs | 73 | x `compare` y = mconcat cmprs | 
| 73 | where | 74 | where | 
| 74 | cmprs = [ itemOpened x `compare` itemOpened y | 75 | cmprs = [ comparing itemOpened x y | 
| 75 | , itemExpires x `compare` itemExpires y | 76 | , comparing itemExpires x y | 
| 76 | , itemKind x `compare` itemKind y | 77 | , (comparing not `on` itemRunningLow) x y | 
| 77 | , itemBought x `compare` itemBought y | 78 | , comparing itemKind x y | 
| 79 | , comparing itemBought x y | ||
| 78 | ] | 80 | ] | 
| 79 | 81 | ||
| 80 | instance ToJSON Item where | 82 | instance ToJSON Item where | 
| @@ -83,6 +85,7 @@ instance ToJSON Item where | |||
| 83 | , "bought" .= itemBought | 85 | , "bought" .= itemBought | 
| 84 | , "expires" .= itemExpires | 86 | , "expires" .= itemExpires | 
| 85 | , "opened" .= itemOpened | 87 | , "opened" .= itemOpened | 
| 88 | , "running-low" .= itemRunningLow | ||
| 86 | ] | 89 | ] | 
| 87 | 90 | ||
| 88 | instance FromJSON Item where | 91 | instance FromJSON Item where | 
| @@ -93,6 +96,7 @@ instance FromJSON Item where | |||
| 93 | itemBought <- maybe DateUnknown DateKnown <$> obj .:? "bought" | 96 | itemBought <- maybe DateUnknown DateKnown <$> obj .:? "bought" | 
| 94 | itemExpires <- maybe DateNever DateKnown <$> obj .:? "expires" | 97 | itemExpires <- maybe DateNever DateKnown <$> obj .:? "expires" | 
| 95 | itemOpened <- obj .: "opened" | 98 | itemOpened <- obj .: "opened" | 
| 99 | itemRunningLow <- fromMaybe False <$> obj .:? "running-low" | ||
| 96 | return Item{..} | 100 | return Item{..} | 
| 97 | 101 | ||
| 98 | instance ToJSON (Entity Item) where | 102 | instance ToJSON (Entity Item) where | 
| @@ -1,5 +1,5 @@ | |||
| 1 | name: bar | 1 | name: bar | 
| 2 | version: 0.2.0 | 2 | version: 0.3.0 | 
| 3 | cabal-version: >= 1.8 | 3 | cabal-version: >= 1.8 | 
| 4 | build-type: Simple | 4 | build-type: Simple | 
| 5 | 5 | ||
| @@ -10,7 +10,7 @@ | |||
| 10 | }: | 10 | }: | 
| 11 | mkDerivation { | 11 | mkDerivation { | 
| 12 | pname = "bar"; | 12 | pname = "bar"; | 
| 13 | version = "0.2.0"; | 13 | version = "0.3.0"; | 
| 14 | src = ./.; | 14 | src = ./.; | 
| 15 | isLibrary = true; | 15 | isLibrary = true; | 
| 16 | isExecutable = true; | 16 | isExecutable = true; | 
diff --git a/config/models b/config/models index 8aebc5b..862fe24 100644 --- a/config/models +++ b/config/models  | |||
| @@ -4,6 +4,7 @@ Item | |||
| 4 | bought ItemDate | 4 | bought ItemDate | 
| 5 | expires ItemDate | 5 | expires ItemDate | 
| 6 | opened ItemDate | 6 | opened ItemDate | 
| 7 | runningLow Bool default=false | ||
| 7 | Foreign Kind fkType normKind | 8 | Foreign Kind fkType normKind | 
| 8 | deriving Show Eq | 9 | deriving Show Eq | 
| 9 | Reference | 10 | Reference | 
diff --git a/templates/inventoryListing.cassius b/templates/inventoryListing.cassius index 225de5d..1da6e13 100644 --- a/templates/inventoryListing.cassius +++ b/templates/inventoryListing.cassius  | |||
| @@ -18,3 +18,10 @@ div.itemId | |||
| 18 | width: 2em | 18 | width: 2em | 
| 19 | border: 1px solid #ddd | 19 | border: 1px solid #ddd | 
| 20 | border-style: solid none solid none | 20 | border-style: solid none solid none | 
| 21 | .status | ||
| 22 | padding: 0 | ||
| 23 | margin: 0 | ||
| 24 | list-style-type: none | ||
| 25 | .status li | ||
| 26 | padding: 0 | ||
| 27 | margin: 0 \ No newline at end of file | ||
diff --git a/templates/inventoryListing.hamlet b/templates/inventoryListing.hamlet index 797bd81..cc1c9ce 100644 --- a/templates/inventoryListing.hamlet +++ b/templates/inventoryListing.hamlet  | |||
| @@ -6,6 +6,7 @@ | |||
| 6 | <div .th>Bought | 6 | <div .th>Bought | 
| 7 | <div .th>Expires | 7 | <div .th>Expires | 
| 8 | <div .th>Opened | 8 | <div .th>Opened | 
| 9 | <div .th>Status | ||
| 9 | <div .th>Actions | 10 | <div .th>Actions | 
| 10 | $if isJust (preview insertForm =<< formState) | 11 | $if isJust (preview insertForm =<< formState) | 
| 11 | $with Just InsertForm{..} <- formState | 12 | $with Just InsertForm{..} <- formState | 
| @@ -52,6 +53,10 @@ | |||
| 52 | <button type=submit> | 53 | <button type=submit> | 
| 53 | Open | 54 | Open | 
| 54 | <div .td> | 55 | <div .td> | 
| 56 | <ul .status> | ||
| 57 | $if itemRunningLow | ||
| 58 | <li>Running low | ||
| 59 | <div .td> | ||
| 55 | <form method=get action=@{UpdateItemR itemId}##{toPathPiece itemId}> | 60 | <form method=get action=@{UpdateItemR itemId}##{toPathPiece itemId}> | 
| 56 | <button type=submit> | 61 | <button type=submit> | 
| 57 | Edit | 62 | Edit | 
