summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Handler/Common.hs7
-rw-r--r--Model.hs12
-rw-r--r--bar.cabal2
-rw-r--r--bar.nix2
-rw-r--r--config/models1
-rw-r--r--templates/inventoryListing.cassius7
-rw-r--r--templates/inventoryListing.hamlet5
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)
diff --git a/Model.hs b/Model.hs
index 8778111..3554049 100644
--- a/Model.hs
+++ b/Model.hs
@@ -1,5 +1,6 @@
1{-# LANGUAGE FlexibleInstances #-} 1{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE DeriveFunctor #-} 2{-# LANGUAGE DeriveFunctor #-}
3{-# LANGUAGE PatternGuards #-}
3 4
4module Model where 5module Model where
5 6
@@ -71,10 +72,11 @@ withTypes vals = do
71instance Ord Item where 72instance 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
80instance ToJSON Item where 82instance 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
88instance FromJSON Item where 91instance 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
98instance ToJSON (Entity Item) where 102instance ToJSON (Entity Item) where
diff --git a/bar.cabal b/bar.cabal
index 4022f7f..863279a 100644
--- a/bar.cabal
+++ b/bar.cabal
@@ -1,5 +1,5 @@
1name: bar 1name: bar
2version: 0.2.0 2version: 0.3.0
3cabal-version: >= 1.8 3cabal-version: >= 1.8
4build-type: Simple 4build-type: Simple
5 5
diff --git a/bar.nix b/bar.nix
index f31cce4..072231b 100644
--- a/bar.nix
+++ b/bar.nix
@@ -10,7 +10,7 @@
10}: 10}:
11mkDerivation { 11mkDerivation {
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
9Reference 10Reference
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