From 7bc954b779a9bc4e1c5e60f2648101c62ed22e72 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Tue, 14 Mar 2017 18:33:42 +0100
Subject: Reference & list

---
 Handler/Common.hs | 64 ++++++++++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 59 insertions(+), 5 deletions(-)

(limited to 'Handler/Common.hs')

diff --git a/Handler/Common.hs b/Handler/Common.hs
index 38fb1ce..2416d15 100644
--- a/Handler/Common.hs
+++ b/Handler/Common.hs
@@ -3,8 +3,13 @@
 module Handler.Common
   ( inventoryListing
   , itemForm
+  , referenceListing
+  , referenceForm
+  , kinds
   , InventoryState(..)
+  , ReferenceState(..)
   , FormState(..)
+  , HasFormState(..)
   ) where
 
 import Import
@@ -25,7 +30,7 @@ itemForm :: Maybe Item -- ^ Update existing item or insert new?
 itemForm proto identView = do
   today <- utctDay <$> liftIO getCurrentTime
   
-  (kindRes, kindView) <- mreq textField "" $ itemKind <$> proto
+  (kindRes, kindWidget) <- kindField $ itemKind <$> proto
   (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"
@@ -41,7 +46,7 @@ itemForm proto identView = do
     [whamlet|
             $newline never
             #{identView}
-            <div .td>^{fvInput kindView}
+            <div .td>^{kindWidget}
             <div .td>^{boughtWidget}
             <div .td>^{expiresWidget}
             <div .td>^{openedWidget}
@@ -73,6 +78,55 @@ itemForm proto identView = do
                 |]
 
 inventoryListing :: InventoryState -> Widget
-inventoryListing InventoryState{..} = do
-  setTitle "Bar Inventory"
-  $(widgetFile "inventoryListing")
+inventoryListing InventoryState{ invFormState = formState, ..} = $(widgetFile "inventoryListing")
+
+referenceForm :: Maybe Reference -- ^ Update existing item or insert new?
+              -> Html -> MForm Handler (FormResult Reference, Widget)
+referenceForm proto identView = do
+  (kindRes, kindWidget) <- kindField $ referenceKind <$> proto
+
+  let referenceRes = do
+        referenceKind <- kindRes
+        return Reference{ referenceNormKind = normalizeKind referenceKind, .. }
+
+  return . (referenceRes, ) $
+    [whamlet|
+            $newline never
+            #{identView}
+            <div .td>^{kindWidget}
+            |]
+
+referenceListing :: ReferenceState -> Widget
+referenceListing ReferenceState{ refFormState = formState, ..} = $(widgetFile "referenceListing")
+
+kindField :: Maybe Text -> MForm Handler (FormResult Text, Widget)
+kindField proto = do
+  optionId <- ("options" <>) . tshow . hashUnique <$> liftIO newUnique
+
+  let
+    attrs = [ ("list", optionId)
+            , ("autocomplete", "off")
+            ]
+  
+  (kindRes, kindView) <- mreq textField ("" { fsAttrs = attrs }) proto
+
+  options <- lift kinds
+
+  return . (kindRes, ) $
+    [whamlet|
+            $newline never
+            ^{fvInput kindView}
+            <datalist ##{optionId}>
+              $forall opt <- options
+                <option value=#{opt}>
+            |]
+
+kinds :: Handler [Text]
+kinds = do
+  stock <- runDB $ selectList [] []
+  reference <- runDB $ selectList [] []
+
+  return $ concat
+    [ [ itemKind | Entity _ Item{..} <- stock ]
+    , [ referenceKind | Entity _ Reference{..} <- reference ]
+    ]
-- 
cgit v1.2.3