From 3bfe0bdcb79b398a387e202c5150b5e6fd230d3a Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Thu, 16 Mar 2017 01:19:07 +0100
Subject: More complicated date handling

---
 Handler/List.hs | 20 +++++++++++++++++---
 1 file changed, 17 insertions(+), 3 deletions(-)

(limited to 'Handler/List.hs')

diff --git a/Handler/List.hs b/Handler/List.hs
index 70f323a..4209651 100644
--- a/Handler/List.hs
+++ b/Handler/List.hs
@@ -19,9 +19,23 @@ import Database.Persist.Sql (Single(..), rawSql)
 import Thermoprint.Client
 
 list :: Handler (Set (WithType Text))
-list = do
-  (map (uncurry WithType . bimap unSingle unSingle) -> kinds) <- runDB $ rawSql "select reference.kind, kind.type from reference,kind where (not exists (select * from item where COALESCE(item.expires >= CURRENT_DATE, TRUE) and (item.norm_kind = reference.norm_kind))) and (reference.norm_kind = kind.norm_kind)" []
-  return $ Set.fromList kinds
+list = runDB $ do
+  today <- liftIO $ utctDay <$> getCurrentTime
+  
+  items <- map entityVal <$> selectList [] []
+  references <- Set.fromList <$> (withTypes . fmap entityVal =<< selectList [] [])
+
+  let
+    references' = Set.filter (isNothing . flip find items . matches) references
+    matches (Reference{..} `WithType` _) Item{..}
+      | today `isBefore` itemExpires = itemNormKind == referenceNormKind
+      | otherwise = False
+      
+    isBefore _ DateNever = True
+    isBefore _ DateUnknown = False
+    isBefore d1 (DateKnown d2) = d1 < d2
+
+  return $ Set.map (fmap referenceKind) references'
 
 mkPrintout :: Set (WithType Text) -> Printout
 mkPrintout list = Printout ps
-- 
cgit v1.2.3