cleanup and comments and soykaf

This commit is contained in:
Shaun Kerr 2018-10-17 11:30:33 +13:00
parent 1aa9cac162
commit 67f908a672
71 changed files with 122 additions and 26 deletions

View File

@ -1,19 +1,34 @@
module Config where
{---
- Config Module
-
- Contains settings that will effect the running of the program
-
- Shaun Kerr
-}
import System.Random
import State
import Timestamp
import Packs
-- Earliest rotation.
-- Each format is generated starting from this date.
genesis :: Timestamp
genesis = Ts 29 09 1996
-- Initial seed.
-- Keep it secret. Keep it safe.
seed :: Int
seed = 69420
-- Initial RNG
entropy :: StdGen
entropy = mkStdGen $ seed
-- Initial rotation.
-- Simple split in half, genesis leaves plenty of time to shuffle.
initialRotation :: State
initialRotation = ((i, o), b, r)
where

View File

@ -1,16 +1,27 @@
module Format where
{---
- Format Module
-
- Functions for generating new formats
- Little bit of a shitshow
-
- Shaun Kerr
-}
import System.Random
import State
import Timestamp
import Config
import Utils
-- Calculate the format starting from Genesis
currentFormat :: Timestamp -> State
currentFormat t = strictApplyN n nextFormat initialRotation
where
n = t `monthsSince` genesis
-- Take a format and return the next months format
nextFormat :: State -> State
nextFormat (p, b, r) = (np, nb, nr)
where
@ -18,18 +29,23 @@ nextFormat (p, b, r) = (np, nb, nr)
(np, nr) = (addNewPack . addNewPack) (ip, r)
nb = rotateBox b
-- Returns the out rotation packs that are legal
legalOutRot :: [OutRot] -> [OutRot]
legalOutRot x = filter (\(Or _ n) -> n == 0) x
-- Updates out rotation pack legality
updatePackAge :: [OutRot] -> [OutRot]
updatePackAge p = map (\(Or s n) -> (Or s $ max 0 (n-1))) p
-- Illegalise a pack
setIllegal :: InRot -> OutRot
setIllegal (Ir n) = Or n 3
-- Legalise a pack
setLegal :: OutRot -> InRot
setLegal (Or n _) = Ir n
-- Drop two oldest packs
rotateOld :: Pool -> Pool
rotateOld (i, o) = (ni, no)
where
@ -37,6 +53,7 @@ rotateOld (i, o) = (ni, no)
no = (updatePackAge o) ++ dropped
dropped = map setIllegal (take 2 i)
-- Add a new pack
addNewPack :: (Pool, StdGen) -> (Pool, StdGen)
addNewPack ((i, o), r) = ((ni, no), nr)
where
@ -46,5 +63,6 @@ addNewPack ((i, o), r) = ((ni, no), nr)
ni = i ++ [(setLegal np)]
no = filter (\x -> x /= np) o
-- Update the banned box
rotateBox :: BoxQueue -> BoxQueue
rotateBox (Bq x) = Bq $ rotate 1 x

View File

@ -1,5 +1,14 @@
module Packs where
{---
- Pack Module
-
- Defines datatypes for each pack and I totally didn't
- hand code this nuh-uh for real
-
- Shaun Kerr
-}
data BigBox =
Cc | Hp | Oc | Dd | Td | Rr deriving Eq

41
State.hs Normal file
View File

@ -0,0 +1,41 @@
module State where
{---
- State Module
-
- Functions used for creating and defining the
- state of the current rotation.
-
- Shaun Kerr.
-}
import System.Random
import Packs
-- Total State is the Datapack Pool, the Banned Big Box,
-- and the next random number.
type State = (Pool, BoxQueue, StdGen)
-- In Rotation packs have no metadata
data InRot = Ir DataPack deriving (Show, Eq)
-- Out Rotation packs need a number of months
-- until they're legal again.
data OutRot = Or DataPack Integer
instance Eq OutRot where
(Or d1 _) == (Or d2 _) = d1 == d2
-- Box Queue is full of Maybes for the month
-- where none are banned.
data BoxQueue = Bq [Maybe BigBox]
-- Total pool is split into in and out of rotation
type Pool = ([InRot], [OutRot])
-- Simple Wrapper
createInRot :: [DataPack] -> [InRot]
createInRot x = map (\n -> Ir n) x
-- Wrapper + Initial legality
createOutRot :: [DataPack] -> [OutRot]
createOutRot x = map (\n -> Or n 0) x

View File

@ -1,10 +1,25 @@
module Timestamp where
{---
- Timestamp Module
-
- Functions related to getting and using timestamps.
-
- Shaun Kerr
-}
import Data.Time.LocalTime
import Data.Time.Format
-- Internal Date Representation
data Timestamp = Ts Integer Integer Integer deriving Show
-- Previews Start on the 20th
isPreviewSeason :: Timestamp -> Bool
isPreviewSeason (Ts x _ _) = x >= 20
-- True // False if first date is in the future
-- relative to the second date.
inFuture :: Timestamp -> Timestamp -> Bool
inFuture (Ts d1 m1 y1) (Ts d2 m2 y2)
| y1 /= y2 = y1 > y2
@ -12,6 +27,9 @@ inFuture (Ts d1 m1 y1) (Ts d2 m2 y2)
| d1 /= d2 = d1 > d2
| otherwise = False
-- How many months in the future the first date is
-- relative from the second date.
-- returns 0 otherwise.
monthsSince :: Timestamp -> Timestamp -> Integer
monthsSince (Ts d1 m1 y1) (Ts d2 m2 y2)
| t1 `inFuture` t2 = (12 * (y1 - y2)) + (m1 - m2)
@ -20,14 +38,22 @@ monthsSince (Ts d1 m1 y1) (Ts d2 m2 y2)
t1 = Ts d1 m1 y1
t2 = Ts d2 m2 y2
-- Helper, format Integer representation to Timestamp
toTS :: (Integer, Integer, Integer) -> Timestamp
toTS (y,m,d) = Ts d m y
-- IO Function, get the current date as a [Char]
getCurrentTime :: IO [Char]
getCurrentTime = getZonedTime
>>= return . (formatTime defaultTimeLocale "%Y %m %d")
-- Helper, format the [Char] as triple Integer
fmtCurrentTime :: [Char] -> (Integer, Integer, Integer)
fmtCurrentTime n = (\[a,b,c] -> (a,b,c)) iTime
where
iTime = map (\x -> read x :: Integer) $ words n
-- Hide away some ugly steps. Not sure we ever
-- use the other two so can probably compact this.
getTimestamp :: [Char] -> Timestamp
getTimestamp x = toTS . fmtCurrentTime $ x

View File

@ -1,5 +1,14 @@
module ViewUtils where
{---
- ViewUtils Module
-
- Your guess is as good as mine why this is its own thing
- gotta get the month I guess
-
- Shaun Kerr
-}
import Timestamp
showMonth :: Integer -> String
@ -15,5 +24,3 @@ showMonth 9 = "September"
showMonth 10 = "October"
showMonth 11 = "November"
showMonth 12 = "December"

View File

@ -1,22 +0,0 @@
module State where
import System.Random
import Packs
type State = (Pool, BoxQueue, StdGen)
data InRot = Ir DataPack deriving (Show, Eq)
data OutRot = Or DataPack Integer
instance Eq OutRot where
(Or d1 _) == (Or d2 _) = d1 == d2
data BoxQueue = Bq [Maybe BigBox]
type Pool = ([InRot], [OutRot])
createInRot :: [DataPack] -> [InRot]
createInRot x = map (\n -> Ir n) x
createOutRot :: [DataPack] -> [OutRot]
createOutRot x = map (\n -> Or n 0) x

View File

Before

Width:  |  Height:  |  Size: 2.9 KiB

After

Width:  |  Height:  |  Size: 2.9 KiB

View File

View File

View File

@ -47,10 +47,12 @@ ctx = defaultContext <>
-- Default context for format
fmtCtx :: Integer -> Integer -> String -> Context String
fmtCtx m y u =
fmtCtx m y u dps bbs =
(titleField mTitle) <>
(field "nrdbUrl" u) <>
(listFieldWith
(listField "dpacks" (
field "dp" (return .
)
ctx
where
mTitle = "Format for " ++ (showMonth m) ++ " " ++ y