From 37f0dac79707a0de81ec6364d2704007eefd9289 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Wed, 15 Mar 2017 16:56:58 +0100
Subject: Fix sorting

---
 Handler/Common.hs           | 16 +++++++++++++++-
 Handler/InventoryListing.hs |  2 +-
 Handler/ReferenceListing.hs |  2 +-
 3 files changed, 17 insertions(+), 3 deletions(-)

(limited to 'Handler')

diff --git a/Handler/Common.hs b/Handler/Common.hs
index 1cf63de..65988da 100644
--- a/Handler/Common.hs
+++ b/Handler/Common.hs
@@ -10,13 +10,14 @@ module Handler.Common
   , ReferenceState(..)
   , FormState(..)
   , HasFormState(..)
+  , stockSort, referenceSort
   ) where
 
 import Import
 
 import Data.Unique
 
-import qualified Data.Text as Text (pack)
+import qualified Data.Text as Text
 
 import Data.Set (Set)
 import qualified Data.Set as Set
@@ -165,3 +166,16 @@ kinds = do
     [ [ itemKind | Entity _ Item{..} <- stock ]
     , [ referenceKind | Entity _ Reference{..} <- reference ]
     ]
+
+type Sort a = a -> a
+
+stockSort :: Sort [WithType (Entity Item)]
+stockSort = concat . map (sortOn $ entityVal . typedVal) . sortGroups . group
+  where
+    group = groupBy ((==) `on` valType) . sortOn valType
+    sortGroups = sortOn (fmap minimum . fromNullable . map (entityVal . typedVal))
+
+referenceSort :: Sort [WithType (Entity Reference)]
+referenceSort = sortBy referenceOrdering
+  where
+    referenceOrdering (Entity _ refA `WithType` refAType) (Entity _ refB `WithType` refBType) = compare refAType refBType <> compare refA refB
diff --git a/Handler/InventoryListing.hs b/Handler/InventoryListing.hs
index 6d4d8fa..cbf4eab 100644
--- a/Handler/InventoryListing.hs
+++ b/Handler/InventoryListing.hs
@@ -16,7 +16,7 @@ postInventoryListingR = do
     FormFailure errors -> mapM_ (addMessage "formError" . toHtml) errors
     _ -> return ()
 
-  (sortOn (entityVal . typedVal) -> stock) <- runDB $ mapM withType =<< selectList [] []
+  (stockSort -> stock) <- runDB $ mapM withType =<< selectList [] []
 
   selectRep $ do
     provideJson (stock :: [WithType (Entity Item)])
diff --git a/Handler/ReferenceListing.hs b/Handler/ReferenceListing.hs
index 0b89a20..e433429 100644
--- a/Handler/ReferenceListing.hs
+++ b/Handler/ReferenceListing.hs
@@ -17,7 +17,7 @@ postReferenceListingR = do
     FormFailure errors -> mapM_ (addMessage "formError" . toHtml) errors
     _ -> return ()
 
-  reference <- runDB $ mapM withType =<< selectList [] [Asc ReferenceKind]
+  (referenceSort -> reference) <- runDB $ mapM withType =<< selectList [] [Asc ReferenceKind]
 
   selectRep $ do
     provideJson (reference :: [WithType (Entity Reference)])
-- 
cgit v1.2.3