From 299731a0cef7462dd8c17bde7ba1a4aeb6f211cd Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Wed, 15 Mar 2017 20:02:53 +0100
Subject: Implement inventory ids

---
 Handler/Common.hs                 |  7 +++++++
 Handler/InventoryListing.hs       |  4 ++--
 bar.cabal                         |  1 +
 bar.nix                           | 18 +++++++++---------
 templates/default-layout.cassius  | 10 +++++++++-
 templates/inventoryListing.hamlet |  4 ++++
 6 files changed, 32 insertions(+), 12 deletions(-)

diff --git a/Handler/Common.hs b/Handler/Common.hs
index a1ae34b..aacab92 100644
--- a/Handler/Common.hs
+++ b/Handler/Common.hs
@@ -11,6 +11,7 @@ module Handler.Common
   , FormState(..)
   , HasFormState(..)
   , stockSort, referenceSort
+  , humanId
   ) where
 
 import Import
@@ -28,6 +29,12 @@ import Handler.Common.Types
 
 import Text.Julius (RawJS(..))
 
+import qualified Codec.Crockford as Crockford (encode)
+import Database.Persist.Sql (fromSqlKey)
+
+humanId :: ItemId -> String
+humanId = Crockford.encode . fromSqlKey
+
 dayFormat :: Day -> String
 dayFormat = formatTime defaultTimeLocale "%e. %b %y"
 
diff --git a/Handler/InventoryListing.hs b/Handler/InventoryListing.hs
index c2ec5d1..d5252a1 100644
--- a/Handler/InventoryListing.hs
+++ b/Handler/InventoryListing.hs
@@ -11,8 +11,8 @@ postInventoryListingR = do
   case insertResult of 
     FormSuccess (Item{..} `WithType` t) -> runDB $ do
       upsertBy (UniqueKind itemNormKind) (Kind itemNormKind t) [ KindType =. t ]
-      insert Item{..}
-      return ()
+      newItem <- insert Item{..}
+      addMessage "insertSuccess" [hamlet|Inserted new item as #{humanId newItem}|]
     FormFailure errors -> mapM_ (addMessage "formError" . toHtml) errors
     _ -> return ()
 
diff --git a/bar.cabal b/bar.cabal
index 5003000..c99c80a 100644
--- a/bar.cabal
+++ b/bar.cabal
@@ -105,6 +105,7 @@ library
                  , mtl
                  , lens
                  , thermoprint-client
+                 , crockford
 
 executable         bar
     if flag(library-only)
diff --git a/bar.nix b/bar.nix
index 714ee94..00c2a5e 100644
--- a/bar.nix
+++ b/bar.nix
@@ -1,12 +1,12 @@
 { mkDerivation, aeson, base, bytestring, case-insensitive
 , classy-prelude, classy-prelude-conduit, classy-prelude-yesod
-, conduit, containers, data-default, directory, fast-logger
-, file-embed, hjsmin, http-conduit, lens, monad-control
-, monad-logger, mtl, persistent, persistent-postgresql
-, persistent-template, safe, shakespeare, stdenv, template-haskell
-, text, thermoprint-client, time, unordered-containers, vector, wai
-, wai-extra, wai-logger, warp, yaml, yesod, yesod-auth, yesod-core
-, yesod-form, yesod-static
+, conduit, containers, crockford, data-default, directory
+, fast-logger, file-embed, hjsmin, http-conduit, lens
+, monad-control, monad-logger, mtl, persistent
+, persistent-postgresql, persistent-template, safe, shakespeare
+, stdenv, template-haskell, text, thermoprint-client, time
+, unordered-containers, vector, wai, wai-extra, wai-logger, warp
+, yaml, yesod, yesod-auth, yesod-core, yesod-form, yesod-static
 }:
 mkDerivation {
   pname = "bar";
@@ -17,8 +17,8 @@ mkDerivation {
   libraryHaskellDepends = [
     aeson base bytestring case-insensitive classy-prelude
     classy-prelude-conduit classy-prelude-yesod conduit containers
-    data-default directory fast-logger file-embed hjsmin http-conduit
-    lens monad-control monad-logger mtl persistent
+    crockford data-default directory fast-logger file-embed hjsmin
+    http-conduit lens monad-control monad-logger mtl persistent
     persistent-postgresql persistent-template safe shakespeare
     template-haskell text thermoprint-client time unordered-containers
     vector wai wai-extra wai-logger warp yaml yesod yesod-auth
diff --git a/templates/default-layout.cassius b/templates/default-layout.cassius
index bd76a01..61a4046 100644
--- a/templates/default-layout.cassius
+++ b/templates/default-layout.cassius
@@ -31,6 +31,12 @@
   text-align: center
   padding: 0.25em
   color: #aaa
+.itemId
+  display: table-cell
+  text-align: left
+  padding: 0.25em
+  color: #aaa
+  font-family: monospace
 .table .table .td, .table .table .tc, .table .table .th, .table .table .kind
   padding: 0
 table table td, table table th
@@ -43,7 +49,7 @@ table table td, table table th
   font-weight: bold
   .formError
     color: #800
-  .printSuccess
+  .printSuccess, .insertSuccess
     color: #080
 button
   width: 6em
@@ -94,3 +100,5 @@ label.checkbox
     vertical-align: middle
   span
     vertical-align: middle
+.itemH
+  display: table-cell
\ No newline at end of file
diff --git a/templates/inventoryListing.hamlet b/templates/inventoryListing.hamlet
index 3be43db..f0ff1e4 100644
--- a/templates/inventoryListing.hamlet
+++ b/templates/inventoryListing.hamlet
@@ -1,5 +1,6 @@
 <div .table>
   <div .tr .sepBelow>
+    <div .itemH>
     <div .th>Item
     <div .th>Type
     <div .th>Bought
@@ -9,6 +10,7 @@
   $if isJust (preview insertForm =<< formState)
     $with Just InsertForm{..} <- formState
       <form .tr .sepBelow action=@{InventoryListingR} method=post enctype=#{fsInsertEncoding}>
+        <div .td>
         ^{fsInsertForm}
         <div .td>
           <button type=submit>
@@ -17,12 +19,14 @@
     $if Just itemId == (preview updateId =<< formState)
       $with Just UpdateForm{..} <- formState
          <form .tr .color action=@{UpdateItemR fsUpdateId}##{toPathPiece fsUpdateId} method=post enctype=#{fsUpdateEncoding} ##{toPathPiece fsUpdateId}>
+           <div .itemId>#{humanId itemId}
            ^{fsUpdateForm}
            <div .td>
              <button type=submit>
                Save Changes
     $else
       <div .tr .color ##{toPathPiece itemId}>
+        <div .itemId>#{humanId itemId}
         <div .kind>#{itemKind}
         <div .type>#{itemType}
         <div .td .day>
-- 
cgit v1.2.3