summaryrefslogtreecommitdiff
path: root/Handler
diff options
context:
space:
mode:
Diffstat (limited to 'Handler')
-rw-r--r--Handler/Common.hs2
-rw-r--r--Handler/InventoryListing.hs4
-rw-r--r--Handler/List.hs5
-rw-r--r--Handler/ReferenceListing.hs6
-rw-r--r--Handler/Types.hs1
-rw-r--r--Handler/UpdateItem.hs2
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)
32import qualified Web.Hashids as HID 32import qualified Web.Hashids as HID
33import Data.List ((\\)) 33import Data.List ((\\))
34 34
35import Data.List.NonEmpty (NonEmpty)
36import Data.Semigroup hiding (First(..))
37import Data.Monoid (First(..)) 35import Data.Monoid (First(..))
38 36
39import Data.Time.Calendar 37import 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
42putInventoryListingR = do 42putInventoryListingR = 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
1module Handler.List where 3module Handler.List where
2 4
3import Import 5import Import
@@ -5,14 +7,11 @@ import Import
5import Data.Set (Set) 7import Data.Set (Set)
6import qualified Data.Set as Set 8import qualified Data.Set as Set
7 9
8import Data.Map (Map)
9import qualified Data.Map as Map 10import qualified Data.Map as Map
10 11
11import qualified Data.Text as Text 12import qualified Data.Text as Text
12import qualified Data.Text.Lazy as Lazy.Text 13import qualified Data.Text.Lazy as Lazy.Text
13 14
14import Database.Persist.Sql (Single(..), rawSql)
15
16import Thermoprint.Client 15import Thermoprint.Client
17 16
18list :: Handler (Set (WithType Text)) 17list :: 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
30putReferenceListingR = do 30putReferenceListingR = 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
3import Import 3import Import
4 4
5import Data.Set (Set)
6import qualified Data.Set as Set 5import qualified Data.Set as Set
7 6
8getTypesR :: Handler Value 7getTypesR :: 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