Factored out Html/Css into own file

This commit is contained in:
Shaun Kerr 2018-07-02 08:47:13 +12:00
parent c4e64b7893
commit 9cf0f6ebbd
10 changed files with 184 additions and 183 deletions

View File

@ -4,6 +4,7 @@ import System.Random
import State import State
import Timestamp import Timestamp
import Config import Config
import Utils
currentFormat :: Timestamp -> State currentFormat :: Timestamp -> State
currentFormat t = strictApplyN n nextFormat initialRotation currentFormat t = strictApplyN n nextFormat initialRotation
@ -45,14 +46,5 @@ addNewPack ((i, o), r) = ((ni, no), nr)
ni = i ++ [(setLegal np)] ni = i ++ [(setLegal np)]
no = filter (\x -> x /= np) o no = filter (\x -> x /= np) o
rotate :: Integer -> [a] -> [a]
rotate n xs = take lxs . drop ((fromIntegral n) `mod` lxs) . cycle $ xs
where
lxs = length xs
rotateBox :: BoxQueue -> BoxQueue rotateBox :: BoxQueue -> BoxQueue
rotateBox (Bq x) = Bq $ rotate 1 x rotateBox (Bq x) = Bq $ rotate 1 x
strictApplyN :: Integer -> (a -> a) -> a -> a
strictApplyN 0 _ x = x
strictApplyN n f x = strictApplyN (n - 1) f $! (f x)

178
Main.hs
View File

@ -14,6 +14,8 @@ import Preview
import Yesod import Yesod
import Config import Config
import Nrdb import Nrdb
import Text.Lucius
import Utils
data ProtocolSeven = ProtocolSeven data ProtocolSeven = ProtocolSeven
@ -29,23 +31,6 @@ mkYesod "ProtocolSeven" [parseRoutes|
instance Yesod ProtocolSeven instance Yesod ProtocolSeven
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 :: Handler Html
getHomeR = defaultLayout $ do getHomeR = defaultLayout $ do
(year, month, day) <- io $ getCurrentTime >>= return . toGregorian . utctDay (year, month, day) <- io $ getCurrentTime >>= return . toGregorian . utctDay
@ -62,162 +47,13 @@ getHomeR = defaultLayout $ do
let nrdbIn = nrdbSearch (pdi,catMaybes [bbi]) let nrdbIn = nrdbSearch (pdi,catMaybes [bbi])
let nrdbOut = nrdbSearch (pdo,catMaybes [bbo]) let nrdbOut = nrdbSearch (pdo,catMaybes [bbo])
setTitle "Protocol Seven" setTitle "Protocol Seven"
toWidget [lucius|
html {
color: #FFFFFF;
background-color: #222222;
font-family: 'Inconsolata', monospace;
margin: 0px;
padding: 0px;
text-size-adjust: none;
}
body {
min-width: 400px;
max-width: 600px;
margin: auto;
padding: 20px;
text-align: left;
border-left: 4px solid white;
border-right: 4px solid white;
}
section {
border-top: 4px solid white;
padding: 5px;
}
header, footer {
margin: 0px;
padding: 5px;
border-top: 4px solid white;
}
.subheading {
text-align: center;
padding: 5px;
}
h1 {
text-align: center;
margin: 0px;
padding: 5px;
}
p,h2,h3 {
margin: 0px;
padding: 5px;
}
.flexboxcontainer {
display: flex;
flex-direction: row;
flex-wrap: wrap;
padding: 10px;
}
ul {
text-align: initial;
margin: 10px;
}
.upcomingIn {
color: #00DD00;
background-color: inherit;
}
.upcomingOut {
color: #DD0000;
background-color: inherit;
}
|]
addScriptRemote "https://fonts.googleapis.com/css?family=Inconsolata" addScriptRemote "https://fonts.googleapis.com/css?family=Inconsolata"
toWidgetBody [hamlet| toWidget $(whamletFile "header.hamlet")
<header> toWidget $(whamletFile "format.hamlet")
<h1>Protocol Seven toWidget $(whamletFile "about.hamlet")
<p class="subheading">Always Be Running</p> toWidget $(whamletFile "footer.hamlet")
|] toWidget $(luciusFile "style.lucius")
toWidgetBody [hamlet|
<section class="rotation">
<h2>Format for #{showMonth month} #{year}:
<a href=#{nrdbFormat}>Click Here for NetrunnerDB
<div class="flexboxcontainer">
<div class="rotationLeft">
<h3>Evergreen:
<ul>
<li>Revised Core Set x3
<h3>Big Boxes:
<ul>
$forall bb <- bbout
<li>#{bb}
<div class="rotationRight">
<h3>Data-packs:
<ul>
$forall dp <- dpout
<li>#{dp}
<h2>Upcoming Changes for #{showMonth nextMonth} #{year}:
<div class="flexboxcontainer">
$maybe (pin, pout, pbin, pbout) <- pr
<div class="upcomingIn">
<h3>In:
<a href=#{nrdbIn}>Click Here for NetrunnerDB
<ul>
$maybe pbbin <- pbin
<li>+ #{show pbbin}
$forall indp <- pin
<li>+ #{show indp}
<div class="upcomingOut">
<h3>Out:
<a href=#{nrdbOut}>Click Here for NetrunnerDB
<ul>
$maybe pbbout <- pbout
<li>- #{show pbbout}
$forall outdp <- pout
<li>- #{show outdp}
$nothing
<h3>Coming soon!
|]
toWidgetBody [hamlet|
<section class="about">
<h2>What is Protocol Seven?
<blockquote><em>"No matter where you go, everybody's connected."</em> - Lain Iwakura
<p>For many of us, Fantasy Flight Games' Living Card Game <strong>Android: Netrunner</strong> was more than simply a card game. The term <em>Lifestyle Game</em> has been thrown around a lot, but is truer for no other community than that of <strong>ANR</strong>. Without the influx of things to discuss each month, it may seem likely that the community will die, however this is only true if we let it happen.
<p>With the cancellation of many players favourite game, and no real replacement anywhere on the horizon, all that's left is to create our own points of discussion. Many players are working on custom cycles to expand the card pool, however one <strong>Chris Hay</strong> of the small and oft ridiculed meta from <strong>Dunedin, New Zealand</strong> has come up with a solution; an everchanging format using the current completed card pool.
<h2>How does it work?
<blockquote><em>"One theory says that man is a neoteny and is no longer able to evolve. If this is true, then what an absurd creature mankind has evolved into."</em> - Eiri Masami
<p><strong>Protocol Seven</strong> is an attempt at a constantly evolving metagame. Rather than relying on an influx of new cards every month, <strong>Protocol Seven</strong> relies on a monthly rotation schedule. This allows discussion of a new metagame every month for the forseeable future.
<p>A month's format in <strong>Protocol Seven</strong> will at any time consist of the following:
<ul>
<li>3x Revised Core Set
<li>18x Data Packs from the Lunar - Kitara cycles
<li>5-6x Deluxe Boxes (Including Terminal Directive)
<p>This website will automatically update with the latest format, as well as a preview of the next months changes. This allows discussion, an ever-changing metagame, whilst also keeping the card pool similar enough between months that decks can be altered rather than completely remade.
<h2>The Protocol Seven Protocol
<blockquote><em>"But a protocol is nothing more than a simple agreement."</em> - Eiri Masami
<p>A comprehensive description of the <strong>Protocol Seven</strong> format
<ul>
<li>3x Revised Core Sets will be legal at all times
<li>The most recent FFG Most Wanted List will be active at all times
<li>The Genesis and Spin cycles are not legal
<li>Cards from the Original Core Set that are not in the Revised Core Set are not legal
<li>18x of the 36 Data Packs from Lunar cycle onwards will be legal at all times
<li>Each rotation will remove the two Data Packs that have been in play the longest, and replace them with two, randomly chosen packs
<li>Once rotated out, a Data Pack will not rotate in for at least three months
<li>Each rotation, one Deluxe Box (Including Terminal Directive), in release order, will be chosen as illegal
<li>Every 7th rotation, all Deluxes will be legal instead
<li>The rotation will happen on the 1st of every month, New Zealand time
<li>On the 20th of every month, a preview of the next months format will be shown
<li><del>No matter what the currently legal packs are, Door to Door (Escalation #59) will always be legal</del>
|]
toWidgetBody [hamlet|
<footer>
<p>Shaun Kerr (techieAgnostic) - shaundavidkerr@gmail.com
<p>Credit to Chris Hay
<p><em>Powered by Haskell - Minimally Tested</em>
|]
main :: IO () main :: IO ()
main = warp 80 ProtocolSeven main = warp 80 ProtocolSeven
toTS :: (Integer, Int, Int) -> Timestamp
toTS (y,m,d) = Ts (fromIntegral d) (fromIntegral m) y

View File

@ -6,6 +6,7 @@ import Packs
import State import State
import Timestamp import Timestamp
import Format import Format
import Utils
type Preview = ([DataPack], [DataPack], Maybe BigBox, Maybe BigBox) type Preview = ([DataPack], [DataPack], Maybe BigBox, Maybe BigBox)
@ -13,9 +14,6 @@ extractPreview :: Maybe Preview -> ([DataPack],[DataPack],Maybe BigBox, Maybe Bi
extractPreview Nothing = ([],[],Nothing, Nothing) extractPreview Nothing = ([],[],Nothing, Nothing)
extractPreview (Just (i,o,ib,ob)) = (i,o,ib,ob) extractPreview (Just (i,o,ib,ob)) = (i,o,ib,ob)
changes :: Eq a => [a] -> [a] -> [a]
changes x y = filter (\n -> not $ n `elem` y) x
diffRot :: [InRot] -> [InRot] -> ([DataPack], [DataPack]) diffRot :: [InRot] -> [InRot] -> ([DataPack], [DataPack])
diffRot c f = (packIn, packOut) diffRot c f = (packIn, packOut)
where where

View File

@ -19,3 +19,6 @@ monthsSince (Ts d1 m1 y1) (Ts d2 m2 y2)
where where
t1 = Ts d1 m1 y1 t1 = Ts d1 m1 y1
t2 = Ts d2 m2 y2 t2 = Ts d2 m2 y2
toTS :: (Integer, Int, Int) -> Timestamp
toTS (y,m,d) = Ts (fromIntegral d) (fromIntegral m) y

30
Utils.hs Normal file
View File

@ -0,0 +1,30 @@
module Utils where
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"
rotate :: Integer -> [a] -> [a]
rotate n xs = take lxs . drop ((fromIntegral n) `mod` lxs) . cycle $ xs
where
lxs = length xs
strictApplyN :: Integer -> (a -> a) -> a -> a
strictApplyN 0 _ x = x
strictApplyN n f x = strictApplyN (n - 1) f $! (f x)
changes :: Eq a => [a] -> [a] -> [a]
changes x y = filter (\n -> not $ n `elem` y) x

30
about.hamlet Normal file
View File

@ -0,0 +1,30 @@
<section class="about">
<h2>What is Protocol Seven?
<blockquote><em>"No matter where you go, everybody's connected."</em> - Lain Iwakura
<p>For many of us, Fantasy Flight Games' Living Card Game <strong>Android: Netrunner</strong> was more than simply a card game. The term <em>Lifestyle Game</em> has been thrown around a lot, but is truer for no other community than that of <strong>ANR</strong>. Without the influx of things to discuss each month, it may seem likely that the community will die, however this is only true if we let it happen.
<p>With the cancellation of many players favourite game, and no real replacement anywhere on the horizon, all that's left is to create our own points of discussion. Many players are working on custom cycles to expand the card pool, however one <strong>Chris Hay</strong> of the small and oft ridiculed meta from <strong>Dunedin, New Zealand</strong> has come up with a solution; an everchanging format using the current completed card pool.
<h2>How does it work?
<blockquote><em>"One theory says that man is a neoteny and is no longer able to evolve. If this is true, then what an absurd creature mankind has evolved into."</em> - Eiri Masami
<p><strong>Protocol Seven</strong> is an attempt at a constantly evolving metagame. Rather than relying on an influx of new cards every month, <strong>Protocol Seven</strong> relies on a monthly rotation schedule. This allows discussion of a new metagame every month for the forseeable future.
<p>A month's format in <strong>Protocol Seven</strong> will at any time consist of the following:
<ul>
<li>3x Revised Core Set
<li>18x Data Packs from the Lunar - Kitara cycles
<li>5-6x Deluxe Boxes (Including Terminal Directive)
<p>This website will automatically update with the latest format, as well as a preview of the next months changes. This allows discussion, an ever-changing metagame, whilst also keeping the card pool similar enough between months that decks can be altered rather than completely remade.
<h2>The Protocol Seven Protocol
<blockquote><em>"But a protocol is nothing more than a simple agreement."</em> - Eiri Masami
<p>A comprehensive description of the <strong>Protocol Seven</strong> format
<ul>
<li>3x Revised Core Sets will be legal at all times
<li>The most recent FFG Most Wanted List will be active at all times
<li>The Genesis and Spin cycles are not legal
<li>Cards from the Original Core Set that are not in the Revised Core Set are not legal
<li>18x of the 36 Data Packs from Lunar cycle onwards will be legal at all times
<li>Each rotation will remove the two Data Packs that have been in play the longest, and replace them with two, randomly chosen packs
<li>Once rotated out, a Data Pack will not rotate in for at least three months
<li>Each rotation, one Deluxe Box (Including Terminal Directive), in release order, will be chosen as illegal
<li>Every 7th rotation, all Deluxes will be legal instead
<li>The rotation will happen on the 1st of every month, New Zealand time
<li>On the 20th of every month, a preview of the next months format will be shown
<li><del>No matter what the currently legal packs are, Door to Door (Escalation #59) will always be legal</del>

4
footer.hamlet Normal file
View File

@ -0,0 +1,4 @@
<footer>
<p>Shaun Kerr (techieAgnostic) - shaundavidkerr@gmail.com
<p>Credit to Chris Hay
<p><em>Powered by Haskell - Minimally Tested</em>

38
format.hamlet Normal file
View File

@ -0,0 +1,38 @@
<section class="rotation">
<h2>Format for #{showMonth month} #{year}:
<a href=#{nrdbFormat}>Click Here for NetrunnerDB
<div class="flexboxcontainer">
<div class="rotationLeft">
<h3>Evergreen:
<ul>
<li>Revised Core Set x3
<h3>Big Boxes:
<ul>
$forall bb <- bbout
<li>#{bb}
<div class="rotationRight">
<h3>Data-packs:
<ul>
$forall dp <- dpout
<li>#{dp}
<h2>Upcoming Changes for #{showMonth nextMonth} #{year}:
<div class="flexboxcontainer">
$maybe (pin, pout, pbin, pbout) <- pr
<div class="upcomingIn">
<h3>In:
<a href=#{nrdbIn}>Click Here for NetrunnerDB
<ul>
$maybe pbbin <- pbin
<li>+ #{show pbbin}
$forall indp <- pin
<li>+ #{show indp}
<div class="upcomingOut">
<h3>Out:
<a href=#{nrdbOut}>Click Here for NetrunnerDB
<ul>
$maybe pbbout <- pbout
<li>- #{show pbbout}
$forall outdp <- pout
<li>- #{show outdp}
$nothing
<h3>Coming soon!

3
header.hamlet Normal file
View File

@ -0,0 +1,3 @@
<header>
<h1>Protocol Seven
<p class="subheading">Always Be Running</p>

67
style.lucius Normal file
View File

@ -0,0 +1,67 @@
html {
color: #FFFFFF;
background-color: #222222;
font-family: 'Inconsolata', monospace;
margin: 0px;
padding: 0px;
text-size-adjust: none;
}
body {
min-width: 400px;
max-width: 600px;
margin: auto;
padding: 20px;
text-align: left;
border-left: 4px solid white;
border-right: 4px solid white;
}
section {
border-top: 4px solid white;
padding: 5px;
}
header, footer {
margin: 0px;
padding: 5px;
border-top: 4px solid white;
}
.subheading {
text-align: center;
padding: 5px;
}
h1 {
text-align: center;
margin: 0px;
padding: 5px;
}
p,h2,h3 {
margin: 0px;
padding: 5px;
}
.flexboxcontainer {
display: flex;
flex-direction: row;
flex-wrap: wrap;
padding: 10px;
}
ul {
text-align: initial;
margin: 10px;
}
.upcomingIn {
color: #00DD00;
background-color: inherit;
}
.upcomingOut {
color: #DD0000;
background-color: inherit;
}