From 50007726e2803be1951ed225d280a195385cb16a Mon Sep 17 00:00:00 2001 From: Shaun Kerr Date: Wed, 27 Jun 2018 14:43:47 +1200 Subject: [PATCH] Working site release + css --- Main.hs | 223 ++++++++++++++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 182 insertions(+), 41 deletions(-) diff --git a/Main.hs b/Main.hs index d8597be..7f5d34e 100644 --- a/Main.hs +++ b/Main.hs @@ -31,56 +31,197 @@ instance Yesod Chhf inBoth :: (Eq a) => [a] -> [a] -> [a] inBoth x y = filter (\n -> n `elem` y) x +showMonth :: Int -> String +showMonth 1 = "January" +showMonth 2 = "February" +showMonth 3 = "March" +showMonth 4 = "April" +showMonth 5 = "May" +showMonth 6 = "June" +showMonth 7 = "July" +showMonth 8 = "August" +showMonth 9 = "September" +showMonth 10 = "October" +showMonth 11 = "November" +showMonth 12 = "December" + getHomeR :: Handler Html -getHomeR = do - t <- io $ getCurrentTime >>= return . toGregorian . utctDay - let ts = toTS t +getHomeR = defaultLayout $ do + (year, month, day) <- io $ getCurrentTime >>= return . toGregorian . utctDay + let nextMonth = (month + 1) `mod` 12 + let ts = toTS (year, month, day) let ((i,o),b,r) = currentFormat ts let bx = (\(Bq x) -> x) let (_,ib,_) = initialRotation let bbout = map show $ catMaybes $ inBoth (bx ib) (tail $ bx b) let dpout = sort $ map show $ map (\(Ir n) -> n) i let pr = getPreview ts - defaultLayout [whamlet| -

CHHF - A Dunedin Netrunner Format -

About -

The Chris Hay Honourary Format, a post-cancellation Netrunner format. # - The format consists of 18 packs at any time, and between 5 and 6 big boxes. # - The following rotation rules are in place: -