161 lines
4.5 KiB
Haskell
161 lines
4.5 KiB
Haskell
module Main where
|
|
|
|
import System.Random
|
|
import Data.List
|
|
import Data.Maybe
|
|
import Data.Time.Clock
|
|
import Data.Time.Calendar
|
|
import Packs
|
|
|
|
data Timestamp = Ts Integer Integer Integer
|
|
data BigBox = Bb (Maybe String) deriving Show
|
|
data DataPack = Dp String Integer deriving Show
|
|
type Legal = [DataPack]
|
|
type Pool = [DataPack]
|
|
type BanQ = [BigBox]
|
|
type State = (Legal, Pool, BanQ, StdGen)
|
|
|
|
instance Eq DataPack where
|
|
(Dp s1 _) == (Dp s2 _) = s1 == s2
|
|
|
|
initialTimestamp :: Timestamp
|
|
initialTimestamp = Ts 29 09 1996
|
|
|
|
seed :: Int
|
|
seed = 69420
|
|
|
|
initialRNG :: StdGen
|
|
initialRNG = mkStdGen $ seed
|
|
|
|
initialState :: State
|
|
initialState = (
|
|
(createPoolList $ drop n dataPacks)
|
|
, (createLegalList $ take n dataPacks)
|
|
, map (\x -> Bb x) $ (map Just bigBoxes) ++ [Nothing]
|
|
, initialRNG
|
|
)
|
|
where n = (length dataPacks) `div` 2
|
|
|
|
isPreviewSeason :: Timestamp -> Bool
|
|
isPreviewSeason (Ts x _ _) = x >= 20
|
|
|
|
inFuture :: Timestamp -> Timestamp -> Bool
|
|
inFuture (Ts d1 m1 y1) (Ts d2 m2 y2)
|
|
| y1 /= y2 = y1 > y2
|
|
| m1 /= m2 = m1 > m2
|
|
| d1 /= d2 = d1 > d2
|
|
| otherwise = False
|
|
|
|
monthsSince :: Timestamp -> Timestamp -> Integer
|
|
monthsSince (Ts d1 m1 y1) (Ts d2 m2 y2)
|
|
| t1 `inFuture` t2 = (12 * (y1 - y2)) + (m1 - m2)
|
|
| otherwise = 0
|
|
where
|
|
t1 = Ts d1 m1 y1
|
|
t2 = Ts d2 m2 y2
|
|
|
|
createDpList :: Integer -> [String] -> [DataPack]
|
|
createDpList t x = map (\n -> Dp n t) x
|
|
|
|
createLegalList :: [String] -> [DataPack]
|
|
createLegalList x = createDpList (-1) x
|
|
|
|
createPoolList :: [String] -> [DataPack]
|
|
createPoolList x = createDpList 0 x
|
|
|
|
legalPoolChoices :: [DataPack] -> [DataPack]
|
|
legalPoolChoices x = filter (\(Dp _ n) -> n == 0) x
|
|
|
|
updatePackAge :: [DataPack] -> [DataPack]
|
|
updatePackAge p = map (\(Dp s n) -> (Dp s (max 0 (n-1)))) p
|
|
|
|
setTimer :: Integer -> DataPack -> DataPack
|
|
setTimer x (Dp n _) = Dp n x
|
|
|
|
setLegalTimer :: DataPack -> DataPack
|
|
setLegalTimer d = setTimer 3 d
|
|
|
|
setInRotTimer :: DataPack -> DataPack
|
|
setInRotTimer d = setTimer (-1) d
|
|
|
|
dropOldestLegal :: State -> State
|
|
dropOldestLegal (l, p, b, r) = ((drop 2 l), newPool, b, r)
|
|
where
|
|
newPool = p ++ (map setLegalTimer (take 2 l))
|
|
|
|
addNewPack :: State -> State
|
|
addNewPack (l, p, b, r) = (l ++ [(setInRotTimer nPack)], pPool, b, nR)
|
|
where
|
|
nPool = length $ legalPoolChoices p
|
|
(iPack, nR) = randomR (0, nPool-1) r
|
|
nPack = (legalPoolChoices p) !! iPack
|
|
nPackName = (\(Dp n _) -> n) nPack
|
|
pPool = filter (\(Dp n _) -> n /= nPackName) p
|
|
|
|
rotate :: Integer -> [a] -> [a]
|
|
rotate _ [] = []
|
|
rotate n xs = zipWith const (drop (fromIntegral n) (cycle xs)) xs
|
|
|
|
rotateBigBox :: State -> State
|
|
rotateBigBox (l, p, b, r) = (l, p, (rotate 1 b), r)
|
|
|
|
newRotation :: State -> State
|
|
newRotation (l, p, b, r) =
|
|
rotateBigBox . addNewPack . addNewPack $ dropOldestLegal (l, updatePackAge p, b, r)
|
|
|
|
changes :: Eq a => [a] -> [a] -> [a]
|
|
changes x y = filter (\n -> not $ n `elem` y) x
|
|
|
|
diffRot :: [DataPack] -> [DataPack] -> ([DataPack], [DataPack])
|
|
diffRot n o = (changes n o, changes o n)
|
|
|
|
strictApplyN :: Integer -> (a -> a) -> a -> a
|
|
strictApplyN 0 _ x = x
|
|
strictApplyN n f x = strictApplyN (n - 1) f $! (f x)
|
|
|
|
getCurrentRotation :: Timestamp -> State
|
|
getCurrentRotation t = strictApplyN n newRotation initialState
|
|
where
|
|
n = t `monthsSince` initialTimestamp
|
|
|
|
type Preview = ([DataPack], [DataPack], BigBox, BigBox)
|
|
|
|
getPreview :: Timestamp -> State -> Maybe Preview
|
|
getPreview n (l, p, b, r)
|
|
| isPreviewSeason n = Just $ (fst packsChange, snd packsChange, head (rotate 1 b), head b)
|
|
| otherwise = Nothing
|
|
where
|
|
packsChange = diffRot nl l
|
|
(nl, _, _, _) = newRotation (l, p, b, r)
|
|
|
|
printLegal :: State -> [String]
|
|
printLegal (l, p, b, r) = [
|
|
"Evergreen: Revised Core Set x3"
|
|
, "Deluxes : " ++ (intercalate ", " $ sort $ catMaybes (tail $ map (\(Bb x) -> x) b))
|
|
, "Datapacks: " ++ (intercalate ", " $ sort $ map (\(Dp n _) -> n) l)
|
|
]
|
|
|
|
printPreview :: Maybe Preview -> [String]
|
|
printPreview (Just (i, o, (Bb bi), (Bb bo))) = [
|
|
"Upcoming Changes:"
|
|
, ("In : " ++ (intercalate ", " $ (cleanDP i) ++ cbi))
|
|
, ("Out: " ++ (intercalate ", " $ (cleanDP o) ++ cbo))
|
|
]
|
|
where
|
|
rmEmp = filter (/="")
|
|
cbi = catMaybes [bi]
|
|
cbo = catMaybes [bo]
|
|
cleanDP = map (\(Dp n _) -> n)
|
|
printPreview Nothing = []
|
|
|
|
toTS :: (Integer, Int, Int) -> Timestamp
|
|
toTS (y,m,d) = Ts (fromIntegral d) (fromIntegral m) y
|
|
|
|
main :: IO ()
|
|
main = do
|
|
t <- getCurrentTime >>= return . toGregorian . utctDay
|
|
let ts = toTS t
|
|
let state = getCurrentRotation ts
|
|
let out = (printLegal state) ++ [""] ++ (printPreview $ getPreview ts state)
|
|
mapM_ putStrLn $ out
|