icfp2015/vm/JSONDeser.hs

{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}
module JSONDeser(readInput) where

import qualified Data.Set as Set
import Data.Maybe
import qualified Data.ByteString.Lazy as BS
import Data.Aeson
import GHC.Generics
import qualified Datatypes as DT
import LCG


data Cell = Cell { x :: Int, y :: Int}
            deriving (Show, Generic)
                    
data Unit = Unit { members :: [Cell], pivot :: Cell}
            deriving (Show, Generic)
            
data Input = Input { id :: Int,
                     units :: [Unit],
                     width :: Int,
                     height :: Int,
                     filled :: [Cell],
                     sourceLength :: Int,
                     sourceSeeds :: [Int]
                   }
             deriving (Show, Generic)


instance FromJSON Cell
instance ToJSON Cell

instance FromJSON Unit
instance ToJSON Unit

instance FromJSON Input
instance ToJSON Input

readInput :: BS.ByteString -> (Int,[(Int,DT.Game)])
readInput str =  newGame (readInputInternal str)

readInputInternal :: BS.ByteString -> Input
readInputInternal str = if isJust result
                        then fromJust result
                        else error "Error during JSON parsing"
                          where
                            result = (decode str :: Maybe Input)


newGame :: Input -> (Int,[(Int,DT.Game)])
newGame input = (JSONDeser.id input, zip (sourceSeeds input) (map gameFromSeed (sourceSeeds input)))
                where
                  gameFromSeed seed = DT.Game board (seedUnits seed input) (Set.empty :: Set.Set Int) 0 0
                  board = DT.Board w h filledel
                  w = width input
                  h = height input
                  filledel = Set.fromList  (map cellConvVM (filled input))

seedUnits :: Int -> Input -> [DT.Unit]
seedUnits s input = map (\x -> uinput !! x ) unit_index
  where
    unit_index = lcg s (length (units input)) (sourceLength input)
    uinput = map unitConvVM (units input)

cellConvVM :: Cell -> DT.Cell
cellConvVM (Cell x y) = (x,y) 

unitConvVM :: Unit -> DT.Unit
unitConvVM unit = DT.Unit setcell (cellConvVM (pivot unit)) 
  where
    setcell = Set.fromList (map cellConvVM (members unit))