Better ids & warnings

3 files changed, 23 insertions, 6 deletions

diff --git a/Handler/Common.hs b/Handler/Common.hs
index aacab92..c2788e8 100644
--- a/Handler/Common.hs
+++ b/Handler/Common.hs
@@ -14,11 +14,12 @@ module Handler.Common
   , humanId
   ) where
 
-import Import
+import Import hiding ((\\))
 
 import Data.Unique
 
 import qualified Data.Text as Text
+import qualified Data.ByteString.Char8 as CBS
 
 import Data.Set (Set)
 import qualified Data.Set as Set
@@ -29,11 +30,14 @@ import Handler.Common.Types
 
 import Text.Julius (RawJS(..))
 
-import qualified Codec.Crockford as Crockford (encode)
 import Database.Persist.Sql (fromSqlKey)
+import qualified Web.Hashids as HID
+import Data.List ((\\))
 
-humanId :: ItemId -> String
-humanId = Crockford.encode . fromSqlKey
+humanId :: ItemId -> Text
+humanId = Text.pack . CBS.unpack . HID.encode ctx . fromIntegral . fromSqlKey
+  where
+    ctx = HID.createHashidsContext "ItemId" 3 $ (['0'..'9'] ++ ['a'..'z']) \\ ['0', 'l', 'v', '2']
 
 dayFormat :: Day -> String
 dayFormat = formatTime defaultTimeLocale "%e. %b %y"
diff --git a/Handler/InventoryListing.hs b/Handler/InventoryListing.hs
index d5252a1..d87512a 100644
--- a/Handler/InventoryListing.hs
+++ b/Handler/InventoryListing.hs
@@ -12,7 +12,20 @@ postInventoryListingR = do
     FormSuccess (Item{..} `WithType` t) -> runDB $ do
       upsertBy (UniqueKind itemNormKind) (Kind itemNormKind t) [ KindType =. t ]
       newItem <- insert Item{..}
-      addMessage "insertSuccess" [hamlet|Inserted new item as #{humanId newItem}|]
+      otherItems <- selectKeysList [ ItemNormKind ==. itemNormKind, ItemId !=. newItem ] []
+      when (not $ null otherItems) . addMessage "insertAmbiguous" $
+        [shamlet|
+                $newline never
+                There are other items of the same kind.
+                <ul>
+                  $forall other <- otherItems
+                    <li .itemId>#{humanId other}
+                |]
+      addMessage "insertSuccess" [shamlet|
+                                         $newline never
+                                         Inserted new item as #
+                                         <span .itemId>#{humanId newItem}
+                                         |]
     FormFailure errors -> mapM_ (addMessage "formError" . toHtml) errors
     _ -> return ()
 
diff --git a/Handler/List.hs b/Handler/List.hs
index 70f323a..21b735b 100644
--- a/Handler/List.hs
+++ b/Handler/List.hs
@@ -50,7 +50,7 @@ postListR = do
   case printResult of
     FormSuccess pId -> do
       (JobId jId) <- jobCreate (Just pId) $ mkPrintout list
-      addMessage "printSuccess" . toHtml $ "List is printing as job #" <> tshow jId
+      addMessage "printSuccess" [shamlet|List is printing as job ##{jId}|]
     FormFailure errors -> mapM_ (addMessage "formError" . toHtml) errors
     _ -> return ()