p7/old/Main.hs
2018-09-17 14:39:15 +12:00

69 lines
1.8 KiB
Haskell

{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings #-}
module Main where
import Data.Time
import Data.List
import Data.Maybe
import Packs
import State
import Format
import Timestamp
import Preview
import Yesod
import Config
import Nrdb
import Text.Lucius
import Utils
data ProtocolSeven = ProtocolSeven
io :: MonadIO io => IO a -> io a
io = liftIO
putStrLnIO :: MonadIO io => String -> io ()
putStrLnIO = io . putStrLn
mkYesod "ProtocolSeven" [parseRoutes|
/ HomeR GET
|]
instance Yesod ProtocolSeven
getHomeR :: Handler Html
getHomeR = defaultLayout $ do
-- Date / Time stuff
sTimeDate <- io $ getZonedTime >>= return . (formatTime defaultTimeLocale "%Y %m %d")
let (year, month, day) = (\[a,b,c] -> (a,b,c)) $ map (\x -> read x :: Integer) $ words sTimeDate
let nextMonth = (month + 1) `mod` 12
let ts = toTS (year, month, day)
-- Release Order Big Boxes
let (_,ib,_) = initialRotation
-- Current Format
let ((i,o),b,r) = currentFormat ts
let bx = (\(Bq x) -> x)
let bbout = map show $ catMaybes $ inBoth (bx ib) (tail $ bx b)
let dpout = sort $ map show $ map (\(Ir n) -> n) i
-- Preview
let pr = getPreview ts
let (pdi,pdo,bbi,bbo) = extractPreview pr
let nrdbFormat = nrdbSearch (((map (\(Ir n) -> n) i) ++ (map (\(Or n _) -> n) o)),(catMaybes (bx b)))
let nrdbIn = nrdbSearch (pdi,catMaybes [bbi])
let nrdbOut = nrdbSearch (pdo,catMaybes [bbo])
-- Build Site
setTitle "Protocol Seven"
addScriptRemote "https://fonts.googleapis.com/css?family=Inconsolata"
toWidget $(whamletFile "header.hamlet")
toWidget $(whamletFile "format.hamlet")
toWidget $(whamletFile "about.hamlet")
toWidget $(whamletFile "footer.hamlet")
toWidget $(luciusFile "style.lucius")
main :: IO ()
main = warp 80 ProtocolSeven