From 72b9f29c057eb45d022b9bbc1562d7b84ccc165b Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Tue, 28 Mar 2017 12:51:25 +0200
Subject: Running low

---
 Handler/Common.hs                  |  7 +++++++
 Model.hs                           | 12 ++++++++----
 bar.cabal                          |  2 +-
 bar.nix                            |  2 +-
 config/models                      |  1 +
 templates/inventoryListing.cassius |  7 +++++++
 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
   (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
+  ((fmap $ fromMaybe False -> runningLowRes), runningLowWidget) <- mopt checkBoxField "" . Just . Just . fromMaybe False $ fmap itemRunningLow proto
 
   let itemRes = do
         itemKind <- kindRes
         itemBought <- boughtRes
         itemExpires <- expiresRes
         itemOpened <- openedRes
+        itemRunningLow <- runningLowRes
         t <- typeRes
         return $ Item{ itemNormKind = normalizeKind itemKind, ..} `WithType` t
 
@@ -87,6 +89,11 @@ itemForm proto identView = do
             <div .td>^{boughtWidget}
             <div .td>^{expiresWidget}
             <div .td>^{openedWidget}
+            <div .td>
+              <ul .status>
+                <li>^{fvInput runningLowWidget} #
+                  <label for=#{fvId runningLowWidget}>
+                    Running low
             |]
   where
     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 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE PatternGuards #-}
 
 module Model where
 
@@ -71,10 +72,11 @@ withTypes vals = do
 instance Ord Item where
   x `compare` y = mconcat cmprs
     where
-      cmprs = [ itemOpened x `compare` itemOpened y
-              , itemExpires x `compare` itemExpires y
-              , itemKind x `compare` itemKind y
-              , itemBought x `compare` itemBought y
+      cmprs = [ comparing itemOpened x y
+              , comparing itemExpires x y
+              , (comparing not `on` itemRunningLow) x y
+              , comparing itemKind x y
+              , comparing itemBought x y
               ]
 
 instance ToJSON Item where
@@ -83,6 +85,7 @@ instance ToJSON Item where
     , "bought" .= itemBought
     , "expires" .= itemExpires
     , "opened" .= itemOpened
+    , "running-low" .= itemRunningLow
     ]
 
 instance FromJSON Item where
@@ -93,6 +96,7 @@ instance FromJSON Item where
     itemBought <- maybe DateUnknown DateKnown <$> obj .:? "bought"
     itemExpires <- maybe DateNever DateKnown <$> obj .:? "expires"
     itemOpened <- obj .: "opened"
+    itemRunningLow <- fromMaybe False <$> obj .:? "running-low"
     return Item{..}
   
 instance 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 @@
 name:              bar
-version:           0.2.0
+version:           0.3.0
 cabal-version:     >= 1.8
 build-type:        Simple
 
diff --git a/bar.nix b/bar.nix
index f31cce4..072231b 100644
--- a/bar.nix
+++ b/bar.nix
@@ -10,7 +10,7 @@
 }:
 mkDerivation {
   pname = "bar";
-  version = "0.2.0";
+  version = "0.3.0";
   src = ./.;
   isLibrary = true;
   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
     bought ItemDate
     expires ItemDate
     opened ItemDate
+    runningLow Bool default=false
     Foreign Kind fkType normKind
     deriving Show Eq
 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
   width: 2em
   border: 1px solid #ddd
   border-style: solid none solid none
+.status
+  padding: 0
+  margin: 0
+  list-style-type: none
+.status li
+  padding: 0
+  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 @@
     <div .th>Bought
     <div .th>Expires
     <div .th>Opened
+    <div .th>Status
     <div .th>Actions
   $if isJust (preview insertForm =<< formState)
     $with Just InsertForm{..} <- formState
@@ -51,6 +52,10 @@
               <form method=post action=@{OpenItemR itemId}>
                 <button type=submit>
                   Open
+        <div .td>
+          <ul .status>
+            $if itemRunningLow
+              <li>Running low
         <div .td>
           <form method=get action=@{UpdateItemR itemId}##{toPathPiece itemId}>
             <button type=submit>
-- 
cgit v1.2.3