diff options
Diffstat (limited to 'Handler')
-rw-r--r-- | Handler/Common.hs | 2 | ||||
-rw-r--r-- | Handler/InventoryListing.hs | 4 | ||||
-rw-r--r-- | Handler/List.hs | 5 | ||||
-rw-r--r-- | Handler/ReferenceListing.hs | 6 | ||||
-rw-r--r-- | Handler/Types.hs | 1 | ||||
-rw-r--r-- | Handler/UpdateItem.hs | 2 |
6 files changed, 8 insertions, 12 deletions
diff --git a/Handler/Common.hs b/Handler/Common.hs index ab84e4e..88cbd8d 100644 --- a/Handler/Common.hs +++ b/Handler/Common.hs | |||
@@ -32,8 +32,6 @@ import Database.Persist.Sql (fromSqlKey) | |||
32 | import qualified Web.Hashids as HID | 32 | import qualified Web.Hashids as HID |
33 | import Data.List ((\\)) | 33 | import Data.List ((\\)) |
34 | 34 | ||
35 | import Data.List.NonEmpty (NonEmpty) | ||
36 | import Data.Semigroup hiding (First(..)) | ||
37 | import Data.Monoid (First(..)) | 35 | import Data.Monoid (First(..)) |
38 | 36 | ||
39 | import Data.Time.Calendar | 37 | import Data.Time.Calendar |
diff --git a/Handler/InventoryListing.hs b/Handler/InventoryListing.hs index d87512a..c61c62b 100644 --- a/Handler/InventoryListing.hs +++ b/Handler/InventoryListing.hs | |||
@@ -10,7 +10,7 @@ postInventoryListingR = do | |||
10 | 10 | ||
11 | case insertResult of | 11 | case insertResult of |
12 | FormSuccess (Item{..} `WithType` t) -> runDB $ do | 12 | FormSuccess (Item{..} `WithType` t) -> runDB $ do |
13 | upsertBy (UniqueKind itemNormKind) (Kind itemNormKind t) [ KindType =. t ] | 13 | void $ upsertBy (UniqueKind itemNormKind) (Kind itemNormKind t) [ KindType =. t ] |
14 | newItem <- insert Item{..} | 14 | newItem <- insert Item{..} |
15 | otherItems <- selectKeysList [ ItemNormKind ==. itemNormKind, ItemId !=. newItem ] [] | 15 | otherItems <- selectKeysList [ ItemNormKind ==. itemNormKind, ItemId !=. newItem ] [] |
16 | when (not $ null otherItems) . addMessage "insertAmbiguous" $ | 16 | when (not $ null otherItems) . addMessage "insertAmbiguous" $ |
@@ -42,5 +42,5 @@ putInventoryListingR :: Handler Value | |||
42 | putInventoryListingR = do | 42 | putInventoryListingR = do |
43 | (Item{..} `WithType` t) <- requireCheckJsonBody | 43 | (Item{..} `WithType` t) <- requireCheckJsonBody |
44 | returnJson <=< runDB $ do | 44 | returnJson <=< runDB $ do |
45 | upsertBy (UniqueKind itemNormKind) (Kind itemNormKind t) [ KindType =. t ] | 45 | void $ upsertBy (UniqueKind itemNormKind) (Kind itemNormKind t) [ KindType =. t ] |
46 | withType =<< insertEntity Item{..} | 46 | withType =<< insertEntity Item{..} |
diff --git a/Handler/List.hs b/Handler/List.hs index e28bb16..522f6f5 100644 --- a/Handler/List.hs +++ b/Handler/List.hs | |||
@@ -1,3 +1,5 @@ | |||
1 | {-# LANGUAGE PatternGuards #-} | ||
2 | |||
1 | module Handler.List where | 3 | module Handler.List where |
2 | 4 | ||
3 | import Import | 5 | import Import |
@@ -5,14 +7,11 @@ import Import | |||
5 | import Data.Set (Set) | 7 | import Data.Set (Set) |
6 | import qualified Data.Set as Set | 8 | import qualified Data.Set as Set |
7 | 9 | ||
8 | import Data.Map (Map) | ||
9 | import qualified Data.Map as Map | 10 | import qualified Data.Map as Map |
10 | 11 | ||
11 | import qualified Data.Text as Text | 12 | import qualified Data.Text as Text |
12 | import qualified Data.Text.Lazy as Lazy.Text | 13 | import qualified Data.Text.Lazy as Lazy.Text |
13 | 14 | ||
14 | import Database.Persist.Sql (Single(..), rawSql) | ||
15 | |||
16 | import Thermoprint.Client | 15 | import Thermoprint.Client |
17 | 16 | ||
18 | list :: Handler (Set (WithType Text)) | 17 | list :: Handler (Set (WithType Text)) |
diff --git a/Handler/ReferenceListing.hs b/Handler/ReferenceListing.hs index 690f3f7..9fda87f 100644 --- a/Handler/ReferenceListing.hs +++ b/Handler/ReferenceListing.hs | |||
@@ -11,8 +11,8 @@ postReferenceListingR = do | |||
11 | 11 | ||
12 | case insertResult of | 12 | case insertResult of |
13 | FormSuccess (Reference{..} `WithType` t) -> runDB $ do | 13 | FormSuccess (Reference{..} `WithType` t) -> runDB $ do |
14 | upsertBy (UniqueKind referenceNormKind) (Kind referenceNormKind t) [ KindType =. t ] | 14 | void $ upsertBy (UniqueKind referenceNormKind) (Kind referenceNormKind t) [ KindType =. t ] |
15 | insert Reference{..} | 15 | void $ insert Reference{..} |
16 | return () | 16 | return () |
17 | FormFailure errors -> mapM_ (addMessage "formError" . toHtml) errors | 17 | FormFailure errors -> mapM_ (addMessage "formError" . toHtml) errors |
18 | _ -> return () | 18 | _ -> return () |
@@ -30,5 +30,5 @@ putReferenceListingR :: Handler Value | |||
30 | putReferenceListingR = do | 30 | putReferenceListingR = do |
31 | (Reference{..} `WithType` referenceType) <- requireCheckJsonBody | 31 | (Reference{..} `WithType` referenceType) <- requireCheckJsonBody |
32 | returnJson <=< runDB $ do | 32 | returnJson <=< runDB $ do |
33 | upsertBy (UniqueKind referenceNormKind) (Kind referenceNormKind referenceType) [ KindType =. referenceType ] | 33 | void $ upsertBy (UniqueKind referenceNormKind) (Kind referenceNormKind referenceType) [ KindType =. referenceType ] |
34 | withType =<< insertEntity Reference{..} | 34 | withType =<< insertEntity Reference{..} |
diff --git a/Handler/Types.hs b/Handler/Types.hs index 04055ad..2fc45a3 100644 --- a/Handler/Types.hs +++ b/Handler/Types.hs | |||
@@ -2,7 +2,6 @@ module Handler.Types where | |||
2 | 2 | ||
3 | import Import | 3 | import Import |
4 | 4 | ||
5 | import Data.Set (Set) | ||
6 | import qualified Data.Set as Set | 5 | import qualified Data.Set as Set |
7 | 6 | ||
8 | getTypesR :: Handler Value | 7 | getTypesR :: Handler Value |
diff --git a/Handler/UpdateItem.hs b/Handler/UpdateItem.hs index ce6b30d..ebd29e4 100644 --- a/Handler/UpdateItem.hs +++ b/Handler/UpdateItem.hs | |||
@@ -13,7 +13,7 @@ postUpdateItemR fsUpdateId = do | |||
13 | 13 | ||
14 | case updateResult of | 14 | case updateResult of |
15 | FormSuccess (Item{..} `WithType` t) -> runDB $ do | 15 | FormSuccess (Item{..} `WithType` t) -> runDB $ do |
16 | upsertBy (UniqueKind itemNormKind) (Kind itemNormKind t) [ KindType =. t ] | 16 | void $ upsertBy (UniqueKind itemNormKind) (Kind itemNormKind t) [ KindType =. t ] |
17 | update fsUpdateId [ ItemKind =. itemKind | 17 | update fsUpdateId [ ItemKind =. itemKind |
18 | , ItemNormKind =. itemNormKind | 18 | , ItemNormKind =. itemNormKind |
19 | , ItemBought =. itemBought | 19 | , ItemBought =. itemBought |