cleanup and comments and soykaf
This commit is contained in:
parent
1aa9cac162
commit
67f908a672
@ -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
|
@ -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
|
@ -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
41
State.hs
Normal 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
|
26
Timestamp.hs
26
Timestamp.hs
@ -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
|
||||
|
11
ViewUtils.hs
11
ViewUtils.hs
@ -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"
|
||||
|
||||
|
||||
|
22
old/State.hs
22
old/State.hs
@ -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
|
Before Width: | Height: | Size: 2.9 KiB After Width: | Height: | Size: 2.9 KiB |
@ -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
|
Loading…
Reference in New Issue
Block a user