#! /usr/bin/env stack
-- stack --resolver lts-12.20 --install-ghc script
{-# LANGUAGE LambdaCase, TemplateHaskell #-}
module Main where

import Control.Category ((>>>), (<<<))
import Control.Lens
import qualified Control.Monad.State as St
import qualified Data.List           as L
import qualified Data.Map            as M
import qualified Data.Sequence       as Seq

import Debug.Trace

type Score  = Int
type Marble = Int

-- Circular sequence convention:
-- current <| first CW <| ... <| first CCW

data Game = Game
   { _gameMarbles :: Seq.Seq Marble
   , _gamePlayers :: Seq.Seq Score
   } deriving Show
makeClassy ''Game

-- 1st CCW becomes current; current becomes 1st CW
rotateCW :: (HasGame c) => Int -> St.State c ()
rotateCW n = St.replicateM_ n $ St.modify $ game . gameMarbles %~ \case
   s' :> x -> x <| s'

-- 1st CW becomes current; current becomes 1st CCW
rotateCCW :: (HasGame c) => Int -> St.State c ()
rotateCCW n = St.replicateM_ n $ St.modify $ game . gameMarbles %~ \case
   x :< s' -> s' |> x

nextPlayer :: (HasGame c) => St.State c ()
nextPlayer = St.modify $ game . gamePlayers %~ \case
   x :< s' -> s' |> x

insertMarble :: (HasGame c) => Marble -> St.State c ()
insertMarble m = St.modify $ game . gameMarbles %~ (m <|)

removeMarble :: (HasGame c) => St.State c Marble
removeMarble = St.state $ game . gameMarbles %%~ \case
   x :< s' -> (x, s')

addScore :: (HasGame c) => Int -> St.State c ()
addScore delta = St.modify $ game . gamePlayers . _head +~ delta

newGame nPlayers = Game
   { _gameMarbles = Seq.singleton 0
   , _gamePlayers = Seq.replicate nPlayers 0
   }

runGame :: Int -> Int -> Game
runGame nPlayers lastMarble = flip St.execState (newGame nPlayers) $ do
   St.forM_ [1..lastMarble] $ \marble -> do
      --St.get >>= traceM . show
      if marble `mod` 23 /= 0
      then rotateCCW 2 *> insertMarble marble
      else do
         addScore marble
         rotateCW 7
         m <- removeMarble
         addScore m
      nextPlayer

main :: IO ()
--main = print $ runGame 9 25
main = print $ maximum $ view gamePlayers $ runGame 416 71617