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 |