diff options
Diffstat (limited to 'Handler')
| -rw-r--r-- | Handler/Common.hs | 12 | ||||
| -rw-r--r-- | Handler/InventoryListing.hs | 15 | ||||
| -rw-r--r-- | Handler/List.hs | 2 | 
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 | |||
| 14 | , humanId | 14 | , humanId | 
| 15 | ) where | 15 | ) where | 
| 16 | 16 | ||
| 17 | import Import | 17 | import Import hiding ((\\)) | 
| 18 | 18 | ||
| 19 | import Data.Unique | 19 | import Data.Unique | 
| 20 | 20 | ||
| 21 | import qualified Data.Text as Text | 21 | import qualified Data.Text as Text | 
| 22 | import qualified Data.ByteString.Char8 as CBS | ||
| 22 | 23 | ||
| 23 | import Data.Set (Set) | 24 | import Data.Set (Set) | 
| 24 | import qualified Data.Set as Set | 25 | import qualified Data.Set as Set | 
| @@ -29,11 +30,14 @@ import Handler.Common.Types | |||
| 29 | 30 | ||
| 30 | import Text.Julius (RawJS(..)) | 31 | import Text.Julius (RawJS(..)) | 
| 31 | 32 | ||
| 32 | import qualified Codec.Crockford as Crockford (encode) | ||
| 33 | import Database.Persist.Sql (fromSqlKey) | 33 | import Database.Persist.Sql (fromSqlKey) | 
| 34 | import qualified Web.Hashids as HID | ||
| 35 | import Data.List ((\\)) | ||
| 34 | 36 | ||
| 35 | humanId :: ItemId -> String | 37 | humanId :: ItemId -> Text | 
| 36 | humanId = Crockford.encode . fromSqlKey | 38 | humanId = Text.pack . CBS.unpack . HID.encode ctx . fromIntegral . fromSqlKey | 
| 39 | where | ||
| 40 | ctx = HID.createHashidsContext "ItemId" 3 $ (['0'..'9'] ++ ['a'..'z']) \\ ['0', 'l', 'v', '2'] | ||
| 37 | 41 | ||
| 38 | dayFormat :: Day -> String | 42 | dayFormat :: Day -> String | 
| 39 | dayFormat = formatTime defaultTimeLocale "%e. %b %y" | 43 | 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 | |||
| 12 | FormSuccess (Item{..} `WithType` t) -> runDB $ do | 12 | FormSuccess (Item{..} `WithType` t) -> runDB $ do | 
| 13 | upsertBy (UniqueKind itemNormKind) (Kind itemNormKind t) [ KindType =. t ] | 13 | upsertBy (UniqueKind itemNormKind) (Kind itemNormKind t) [ KindType =. t ] | 
| 14 | newItem <- insert Item{..} | 14 | newItem <- insert Item{..} | 
| 15 | addMessage "insertSuccess" [hamlet|Inserted new item as #{humanId newItem}|] | 15 | otherItems <- selectKeysList [ ItemNormKind ==. itemNormKind, ItemId !=. newItem ] [] | 
| 16 | when (not $ null otherItems) . addMessage "insertAmbiguous" $ | ||
| 17 | [shamlet| | ||
| 18 | $newline never | ||
| 19 | There are other items of the same kind. | ||
| 20 | <ul> | ||
| 21 | $forall other <- otherItems | ||
| 22 | <li .itemId>#{humanId other} | ||
| 23 | |] | ||
| 24 | addMessage "insertSuccess" [shamlet| | ||
| 25 | $newline never | ||
| 26 | Inserted new item as # | ||
| 27 | <span .itemId>#{humanId newItem} | ||
| 28 | |] | ||
| 16 | FormFailure errors -> mapM_ (addMessage "formError" . toHtml) errors | 29 | FormFailure errors -> mapM_ (addMessage "formError" . toHtml) errors | 
| 17 | _ -> return () | 30 | _ -> return () | 
| 18 | 31 | ||
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 | |||
| 50 | case printResult of | 50 | case printResult of | 
| 51 | FormSuccess pId -> do | 51 | FormSuccess pId -> do | 
| 52 | (JobId jId) <- jobCreate (Just pId) $ mkPrintout list | 52 | (JobId jId) <- jobCreate (Just pId) $ mkPrintout list | 
| 53 | addMessage "printSuccess" . toHtml $ "List is printing as job #" <> tshow jId | 53 | addMessage "printSuccess" [shamlet|List is printing as job ##{jId}|] | 
| 54 | FormFailure errors -> mapM_ (addMessage "formError" . toHtml) errors | 54 | FormFailure errors -> mapM_ (addMessage "formError" . toHtml) errors | 
| 55 | _ -> return () | 55 | _ -> return () | 
| 56 | 56 | ||
