First Working Version
This commit is contained in:
parent
7ef4f7fed8
commit
e55590f49b
@ -53,9 +53,6 @@ rotate n xs = take lxs . drop ((fromIntegral n) `mod` lxs) . cycle $ xs
|
|||||||
rotateBox :: BoxQueue -> BoxQueue
|
rotateBox :: BoxQueue -> BoxQueue
|
||||||
rotateBox (Bq x) = Bq $ rotate 1 x
|
rotateBox (Bq x) = Bq $ rotate 1 x
|
||||||
|
|
||||||
changes :: Eq a => [a] -> [a] -> [a]
|
|
||||||
changes x y = filter (\n -> not $ n `elem` y) x
|
|
||||||
|
|
||||||
strictApplyN :: Integer -> (a -> a) -> a -> a
|
strictApplyN :: Integer -> (a -> a) -> a -> a
|
||||||
strictApplyN 0 _ x = x
|
strictApplyN 0 _ x = x
|
||||||
strictApplyN n f x = strictApplyN (n - 1) f $! (f x)
|
strictApplyN n f x = strictApplyN (n - 1) f $! (f x)
|
||||||
|
15
Main.hs
15
Main.hs
@ -7,20 +7,15 @@ import Packs
|
|||||||
import State
|
import State
|
||||||
import Format
|
import Format
|
||||||
import Timestamp
|
import Timestamp
|
||||||
|
import Preview
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
t <- getCurrentTime >>= return . toGregorian . utctDay
|
t <- getCurrentTime >>= return . toGregorian . utctDay
|
||||||
mapM_ putStrLn $ showState (currentFormat $ toTS t)
|
let ts = toTS t
|
||||||
|
let state = currentFormat ts
|
||||||
|
let out = (printLegal state) ++ [""] ++ (printPreview $ getPreview ts)
|
||||||
|
mapM_ putStrLn $ out
|
||||||
|
|
||||||
toTS :: (Integer, Int, Int) -> Timestamp
|
toTS :: (Integer, Int, Int) -> Timestamp
|
||||||
toTS (y,m,d) = Ts (fromIntegral d) (fromIntegral m) y
|
toTS (y,m,d) = Ts (fromIntegral d) (fromIntegral m) y
|
||||||
|
|
||||||
showState :: State -> [String]
|
|
||||||
showState ((i, o), (Bq b), _) =
|
|
||||||
[
|
|
||||||
"Legal Packs:\n" ++ concat (map (\(Ir n) -> " " ++ show n ++ "\n") i)
|
|
||||||
, "Legal Boxes:\n" ++ concat (map (\x -> " " ++ show x ++ "\n") (catMaybes $ tail b))
|
|
||||||
, "Rotated Packs:\n" ++ concat (map (\(Or n _) -> " " ++ show n ++ "\n") o)
|
|
||||||
, "Rotated Boxes:\n" ++ concat (map (\x -> " " ++ show x ++ "\n") (catMaybes $ [head b]))
|
|
||||||
]
|
|
||||||
|
48
Preview.hs
48
Preview.hs
@ -1,30 +1,50 @@
|
|||||||
type Preview = ([DataPack], [DataPack], BigBox, BigBox)
|
module Preview where
|
||||||
|
|
||||||
getPreview :: Timestamp -> State -> Maybe Preview
|
import Data.List
|
||||||
getPreview n (l, p, b, r)
|
import Data.Maybe
|
||||||
|
import Packs
|
||||||
|
import State
|
||||||
|
import Timestamp
|
||||||
|
import Format
|
||||||
|
|
||||||
|
type Preview = ([DataPack], [DataPack], Maybe BigBox, Maybe BigBox)
|
||||||
|
|
||||||
|
changes :: Eq a => [a] -> [a] -> [a]
|
||||||
|
changes x y = filter (\n -> not $ n `elem` y) x
|
||||||
|
|
||||||
|
diffRot :: [InRot] -> [InRot] -> ([DataPack], [DataPack])
|
||||||
|
diffRot c f = (packIn, packOut)
|
||||||
|
where
|
||||||
|
packIn = map clean $ changes f c
|
||||||
|
packOut = map clean $ changes c f
|
||||||
|
clean = (\(Ir n) -> n)
|
||||||
|
|
||||||
|
getPreview :: Timestamp -> Maybe Preview
|
||||||
|
getPreview n
|
||||||
| isPreviewSeason n = Just $ (fst packsChange, snd packsChange, head (rotate 1 b), head b)
|
| isPreviewSeason n = Just $ (fst packsChange, snd packsChange, head (rotate 1 b), head b)
|
||||||
| otherwise = Nothing
|
| otherwise = Nothing
|
||||||
where
|
where
|
||||||
packsChange = diffRot nl l
|
((i,o), (Bq b), r) = currentFormat n
|
||||||
(nl, _, _, _) = newRotation (l, p, b, r)
|
packsChange = diffRot i ni
|
||||||
|
((ni,_),_,_) = nextFormat ((i,o),(Bq b),r)
|
||||||
|
|
||||||
printLegal :: State -> [String]
|
printLegal :: State -> [String]
|
||||||
printLegal (l, p, b, r) = [
|
printLegal ((i,o),(Bq b),_) = [
|
||||||
"Evergreen: Revised Core Set x3"
|
"===Evergreen:\nRevised Core Set x3"
|
||||||
, "Deluxes : " ++ (intercalate ", " $ sort $ catMaybes (tail $ map (\(Bb x) -> x) b))
|
, "===Deluxes :\n" ++ (intercalate "\n" $ sort $ map show $ catMaybes (tail b))
|
||||||
, "Datapacks: " ++ (intercalate ", " $ sort $ map (\(Dp n _) -> n) l)
|
, "===Datapacks:\n" ++ (intercalate "\n" $ sort $ map show $ map (\(Ir n) -> n) i)
|
||||||
]
|
]
|
||||||
|
|
||||||
printPreview :: Maybe Preview -> [String]
|
printPreview :: Maybe Preview -> [String]
|
||||||
printPreview (Just (i, o, (Bb bi), (Bb bo))) = [
|
printPreview (Just (i, o, bi, bo)) = [
|
||||||
"Upcoming Changes:"
|
"===Upcoming Changes:"
|
||||||
, ("In : " ++ (intercalate ", " $ (cleanDP i) ++ cbi))
|
, ("===In :\n" ++ (intercalate "\n" $ (map show i) ++ (map show cbi)))
|
||||||
, ("Out: " ++ (intercalate ", " $ (cleanDP o) ++ cbo))
|
, ("===Out:\n" ++ (intercalate "\n" $ (map show o) ++ (map show cbo)))
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
rmEmp = filter (/="")
|
rmEmp = filter (/="")
|
||||||
cbi = catMaybes [bi]
|
cbi = catMaybes [bi]
|
||||||
cbo = catMaybes [bo]
|
cbo = catMaybes [bo]
|
||||||
cleanDP = map (\(Dp n _) -> n)
|
cleanDP = map (\(Or n _) -> n)
|
||||||
printPreview Nothing = []
|
printPreview Nothing = []
|
||||||
|
|
||||||
|
2
State.hs
2
State.hs
@ -5,7 +5,7 @@ import Packs
|
|||||||
|
|
||||||
type State = (Pool, BoxQueue, StdGen)
|
type State = (Pool, BoxQueue, StdGen)
|
||||||
|
|
||||||
data InRot = Ir DataPack deriving Show
|
data InRot = Ir DataPack deriving (Show, Eq)
|
||||||
|
|
||||||
data OutRot = Or DataPack Integer
|
data OutRot = Or DataPack Integer
|
||||||
instance Eq OutRot where
|
instance Eq OutRot where
|
||||||
|
Loading…
Reference in New Issue
Block a user