Working

.gitignore

@@ -0,0 +1,3 @@
+*.hi
+*.o
+*.swp

Config.hs

@@ -1,5 +1,10 @@
 module Config where
 
+import System.Random
+import State
+import Timestamp
+import Packs
+
 genesis :: Timestamp
 genesis = Ts 29 09 1996
 
@@ -13,14 +18,14 @@ initialRotation :: State
 initialRotation = ((i, o), b, r)
    where
       i = createInRot [
-           lunar1, lunar2, lunar3, lunar4, lunar5, lunar6
-         , sansan1 , sansan2 , sansan3 , sansan4 , sansan5 , sansan6
-         , mumbad1 , mumbad2 , mumbad3 , mumbad4 , mumbad5 , mumbad6
+           Lunar1, Lunar2, Lunar3, Lunar4, Lunar5, Lunar6
+         , Sansan1 , Sansan2 , Sansan3 , Sansan4 , Sansan5 , Sansan6
+         , Mumbad1 , Mumbad2 , Mumbad3 , Mumbad4 , Mumbad5 , Mumbad6
          ]
       o = createOutRot [
-           flash1  , flash2  , flash3  , flash4  , flash5  , flash6
-         , red1    , red2    , red3    , red4    , red5    , red6
-         , kitara1 , kitara2 , kitara3 , kitara4 , kitara5 , kitara6
+           Flash1  , Flash2  , Flash3  , Flash4  , Flash5  , Flash6
+         , Red1    , Red2    , Red3    , Red4    , Red5    , Red6
+         , Kitara1 , Kitara2 , Kitara3 , Kitara4 , Kitara5 , Kitara6
          ]
-      b = Bq [Just rr, Just td, Just dd, Just oc, Just hp, Just cc, Nothing]
+      b = Bq [Just Cc, Just Hp, Just Oc, Just Dd, Just Td, Just Rr, Nothing]
       r = entropy

Format.hs

@@ -1,17 +1,27 @@
 module Format where
 
+import System.Random
+import State
+import Timestamp
+import Config
+
+currentFormat :: Timestamp -> State
+currentFormat t = strictApplyN n nextFormat initialRotation
+   where
+      n = t `monthsSince` genesis
+
 nextFormat :: State -> State
 nextFormat (p, b, r) = (np, nb, nr)
    where
       ip = rotateOld p
-      (np, nr) = addNewPack . addNewPack (ip, r)
+      (np, nr) = (addNewPack . addNewPack) (ip, r)
       nb = rotateBox b
 
 legalOutRot :: [OutRot] -> [OutRot]
 legalOutRot x = filter (\(Or _ n) -> n == 0) x
 
 updatePackAge :: [OutRot] -> [OutRot]
-updatePackAge p = map (\(Or s n) -> (Or s $ max 0 (n-1)) p
+updatePackAge p = map (\(Or s n) -> (Or s $ max 0 (n-1))) p
 
 setIllegal :: InRot -> OutRot
 setIllegal (Ir n) = Or n 3
@@ -23,7 +33,7 @@ rotateOld :: Pool -> Pool
 rotateOld (i, o) = (ni, no)
    where
       ni = drop 2 i
-      no = o ++ dropped
+      no = (updatePackAge o) ++ dropped
       dropped = map setIllegal (take 2 i)
 
 addNewPack :: (Pool, StdGen) -> (Pool, StdGen)
@@ -32,12 +42,13 @@ addNewPack ((i, o), r) = ((ni, no), nr)
       lp = length $ legalOutRot o
       (ip, nr) = randomR (0, lp-1) r
       np = (legalOutRot o) !! ip
-      ni = i ++ (setLegal np)
+      ni = i ++ [(setLegal np)]
       no = filter (\x -> x /= np) o
 
 rotate :: Integer -> [a] -> [a]
-rotate _ [] = []
-rotate n xs = zipWith const (drop (fromIntegral n) (cycle xs)) xs
+rotate n xs = take lxs . drop ((fromIntegral n) `mod` lxs) . cycle $ xs
+   where
+      lxs = length xs
 
 rotateBox :: BoxQueue -> BoxQueue
 rotateBox (Bq x) = Bq $ rotate 1 x

Main.hs

@@ -1,19 +1,26 @@
 module Main where
 
-import System.Random
-import Data.List
-import Data.Maybe
 import Data.Time.Clock
 import Data.Time.Calendar
+import Data.Maybe
 import Packs
 import State
-
-
+import Format
+import Timestamp
 
 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
+   mapM_ putStrLn $ showState (currentFormat $ toTS t)
+
+toTS :: (Integer, Int, Int) -> Timestamp
+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]))
+   ]

Packs.hs

@@ -1,58 +1,58 @@
 module Packs where
 
 data BigBox =
-   cc | hp | oc | dd | td | rr
+   Cc | Hp | Oc | Dd | Td | Rr deriving Eq
 
 instance Show BigBox where
-   Show cc = "Creation and Control"
-   Show hp = "Honor and Profit"
-   Show oc = "Order and Chaos"
-   Show dd = "Data and Destiny"
-   Show td = "Terminal Directive"
-   Show rr = "Reign and Reverie"
+   show Cc = "Creation and Control"
+   show Hp = "Honor and Profit"
+   show Oc = "Order and Chaos"
+   show Dd = "Data and Destiny"
+   show Td = "Terminal Directive"
+   show Rr = "Reign and Reverie"
 
 data DataPack =
-     lunar1  | lunar2  | lunar3  | lunar4  | lunar5  | lunar6
-   | sansan1 | sansan2 | sansan3 | sansan4 | sansan5 | sansan6
-   | mumbad1 | mumbad2 | mumbad3 | mumbad4 | mumbad5 | mumbad6
-   | flash1  | flash2  | flash3  | flash4  | flash5  | flash6
-   | red1    | red2    | red3    | red4    | red5    | red6
-   | kitara1 | kitara2 | kitara3 | kitara4 | kitara5 | kitara6
+     Lunar1  | Lunar2  | Lunar3  | Lunar4  | Lunar5  | Lunar6
+   | Sansan1 | Sansan2 | Sansan3 | Sansan4 | Sansan5 | Sansan6
+   | Mumbad1 | Mumbad2 | Mumbad3 | Mumbad4 | Mumbad5 | Mumbad6
+   | Flash1  | Flash2  | Flash3  | Flash4  | Flash5  | Flash6
+   | Red1    | Red2    | Red3    | Red4    | Red5    | Red6
+   | Kitara1 | Kitara2 | Kitara3 | Kitara4 | Kitara5 | Kitara6 deriving Eq
 
 instance Show DataPack where
-   Show lunar1 = "Upstalk"
-   Show lunar2 = "The Spaces Between"
-   Show lunar3 = "First Contact"
-   Show lunar4 = "Up and Over"
-   Show lunar5 = "All That Remains"
-   Show lunar6 = "The Source"
-   Show sansan1 = "The Valley"
-   Show sansan2 = "Breaker Bay"
-   Show sansan3 = "Chrome City"
-   Show sansan4 = "The Underway"
-   Show sansan5 = "Old Hollywood"
-   Show sansan6 = "The Universe of Tomorrow"
-   Show mumbad1 = "Kala Ghoda"
-   Show mumbad2 = "Business First"
-   Show mumbad3 = "Democracy and Dogma"
-   Show mumbad4 = "Salsette Island"
-   Show mumbad5 = "The Liberated Mind"
-   Show mumbad6 = "Fear the Masses"
-   Show flash1 = "23 Seconds"
-   Show flash2 = "Blood Money"
-   Show flash3 = "Escalation"
-   Show flash4 = "Intervention"
-   Show flash5 = "Martial Law"
-   Show flash6 = "Quorum"
-   Show red1 = "Daedalus Complex"
-   Show red2 = "Station One"
-   Show red3 = "Earth's Scion"
-   Show red4 = "Blood and Water"
-   Show red5 = "Free Mars"
-   Show red6 = "Crimson Dust"
-   Show kitara1 = "Sovereign Sight"
-   Show kitara2 = "Down the White Nile"
-   Show kitara3 = "Council of the Crest"
-   Show kitara4 = "The Devil and the Dragon"
-   Show kitara5 = "Whispers in Nalubaale"
-   Show kitara6 = "Kampala Ascendent"
+   show Lunar1 = "Upstalk"
+   show Lunar2 = "The Spaces Between"
+   show Lunar3 = "First Contact"
+   show Lunar4 = "Up and Over"
+   show Lunar5 = "All That Remains"
+   show Lunar6 = "The Source"
+   show Sansan1 = "The Valley"
+   show Sansan2 = "Breaker Bay"
+   show Sansan3 = "Chrome City"
+   show Sansan4 = "The Underway"
+   show Sansan5 = "Old Hollywood"
+   show Sansan6 = "The Universe of Tomorrow"
+   show Mumbad1 = "Kala Ghoda"
+   show Mumbad2 = "Business First"
+   show Mumbad3 = "Democracy and Dogma"
+   show Mumbad4 = "Salsette Island"
+   show Mumbad5 = "The Liberated Mind"
+   show Mumbad6 = "Fear the Masses"
+   show Flash1 = "23 Seconds"
+   show Flash2 = "Blood Money"
+   show Flash3 = "Escalation"
+   show Flash4 = "Intervention"
+   show Flash5 = "Martial Law"
+   show Flash6 = "Quorum"
+   show Red1 = "Daedalus Complex"
+   show Red2 = "Station One"
+   show Red3 = "Earth's Scion"
+   show Red4 = "Blood and Water"
+   show Red5 = "Free Mars"
+   show Red6 = "Crimson Dust"
+   show Kitara1 = "Sovereign Sight"
+   show Kitara2 = "Down the White Nile"
+   show Kitara3 = "Council of the Crest"
+   show Kitara4 = "The Devil and the Dragon"
+   show Kitara5 = "Whispers in Nalubaale"
+   show Kitara6 = "Kampala Ascendent"

Preview.hs

@@ -28,5 +28,3 @@ printPreview (Just (i, o, (Bb bi), (Bb bo))) = [
       cleanDP = map (\(Dp n _) -> n)
 printPreview Nothing = []
 
-toTS :: (Integer, Int, Int) -> Timestamp
-toTS (y,m,d) = Ts (fromIntegral d) (fromIntegral m) y

State.hs

@@ -1,11 +1,16 @@
 module State where
 
-data Timestamp = Ts Integer Integer Integer
+import System.Random
+import Packs
 
 type State = (Pool, BoxQueue, StdGen)
 
-data InRot = Ir DataPack
+data InRot = Ir DataPack deriving Show
+
 data OutRot = Or DataPack Integer
+instance Eq OutRot where
+   (Or d1 _) == (Or d2 _) = d1 == d2
+
 data BoxQueue = Bq [Maybe BigBox]
 
 type Pool = ([InRot], [OutRot])

Timestamp.hs

@@ -1,5 +1,7 @@
 module Timestamp where
 
+data Timestamp = Ts Integer Integer Integer deriving Show
+
 isPreviewSeason :: Timestamp -> Bool
 isPreviewSeason (Ts x _ _) = x >= 20