p7/old/Main.hs

{-# 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