適当なパーサ

JsonParser.hs

import Text.Parsec
import Text.Parsec.String
import Text.Parsec.Prim as Prim

data Board = Board { grid :: [[Int]]
                   , score :: Int
                   , won :: Bool
                   , points :: Int
                   , over :: Bool
                   , moved ::Bool
                   , sessionID :: String
                   , zen :: String
                   } deriving(Show, Read, Eq)

board :: Parser Board
board = do
  char '{'
  string "\"grid\""
  char ':'
  char '['
  char '['
  a1 <- many1 digit
  char ','
  a2 <- many1 digit
  char ','
  a3 <- many1 digit
  char ','
  a4 <- many1 digit
  char ']'
  char ','
  char '['
  b1 <- many1 digit
  char ','
  b2 <- many1 digit
  char ','
  b3 <- many1 digit
  char ','
  b4 <- many1 digit
  char ']'
  char ','
  char '['
  c1 <- many1 digit
  char ','
  c2 <- many1 digit
  char ','
  c3 <- many1 digit
  char ','
  c4 <- many1 digit
  char ']'
  char ','
  char '['
  d1 <- many1 digit
  char ','
  d2 <- many1 digit
  char ','
  d3 <- many1 digit
  char ','
  d4 <- many1 digit
  char ']'
  char ']'

  char ','
  string "\"score\""
  char ':'
  score <- many1 digit

  char ','
  string "\"points\""
  char ':'
  points <- many1 digit
  
  char ','
  string "\"moved\""
  char ':'
  moved <- Prim.try (string "true") <|> Prim.try (string "false")

  char ','
  string "\"over\""
  char ':'
  over <- Prim.try (string "true") <|> Prim.try (string "false")
  
  char ','
  string "\"won\""
  char ':'
  won <- Prim.try (string "true") <|> Prim.try (string "false")

  char ','
  string "\"session_id\""
  char ':'
  char '"'
  sessionID <- many1 hexDigit
  char '"'

  char ','
  string "\"zen\""
  char ':'
  char '"'
  zen <- many1 (noneOf "\"")
  char '"'
  char '}'
  return Board {
               grid = [
                 [read a1, read a2, read a3, read a4]
               , [read b1, read b2, read b3, read b4]
               , [read c1, read c2, read c3, read c4]
               , [read d1, read d2, read d3, read d4]
               ]
             , score = read score
             , won = won == "true"
             , points = read points
             , over = over == "true"
             , moved = moved == "true"
             , sessionID = sessionID
             , zen = zen
             }

--toBoard :: 
toBoard input = case parse board "toBoard" input of
    Left err -> error $ "No match: " ++ show err
    Right val -> val

main :: IO ()
main = getLine >>= return . toBoard >>= print
-- curl -L ring:2048/hi/start/json | runhaskell JsonParser.hs

JsonParserLazy.hs

import Text.Parsec
import Text.Parsec.ByteString.Lazy
import Text.Parsec.Prim as Prim
import Data.ByteString.Lazy.Char8

data Board = Board { grid :: [[Int]]
                   , score :: Int
                   , won :: Bool
                   , points :: Int
                   , over :: Bool
                   , moved ::Bool
                   , sessionID :: String
                   , zen :: String
                   } deriving(Show, Read, Eq)

board :: Parser Board
board = do
  char '{'
  string "\"grid\""
  char ':'
  char '['
  char '['
  a1 <- many1 digit
  char ','
  a2 <- many1 digit
  char ','
  a3 <- many1 digit
  char ','
  a4 <- many1 digit
  char ']'
  char ','
  char '['
  b1 <- many1 digit
  char ','
  b2 <- many1 digit
  char ','
  b3 <- many1 digit
  char ','
  b4 <- many1 digit
  char ']'
  char ','
  char '['
  c1 <- many1 digit
  char ','
  c2 <- many1 digit
  char ','
  c3 <- many1 digit
  char ','
  c4 <- many1 digit
  char ']'
  char ','
  char '['
  d1 <- many1 digit
  char ','
  d2 <- many1 digit
  char ','
  d3 <- many1 digit
  char ','
  d4 <- many1 digit
  char ']'
  char ']'

  char ','
  string "\"score\""
  char ':'
  score <- many1 digit

  char ','
  string "\"points\""
  char ':'
  points <- many1 digit
  
  char ','
  string "\"moved\""
  char ':'
  moved <- Prim.try (string "true") <|> Prim.try (string "false")

  char ','
  string "\"over\""
  char ':'
  over <- Prim.try (string "true") <|> Prim.try (string "false")
  
  char ','
  string "\"won\""
  char ':'
  won <- Prim.try (string "true") <|> Prim.try (string "false")

  char ','
  string "\"session_id\""
  char ':'
  char '"'
  sessionID <- many1 hexDigit
  char '"'

  char ','
  string "\"zen\""
  char ':'
  char '"'
  zen <- many1 (noneOf "\"")
  char '"'
  char '}'
  return Board {
               grid = [
                 [read a1, read a2, read a3, read a4]
               , [read b1, read b2, read b3, read b4]
               , [read c1, read c2, read c3, read c4]
               , [read d1, read d2, read d3, read d4]
               ]
             , score = read score
             , won = won == "true"
             , points = read points
             , over = over == "true"
             , moved = moved == "true"
             , sessionID = sessionID
             , zen = zen
             }

--toBoard :: 
toBoard input = case parse board "toBoard" input of
    Left err -> error $ "No match: " ++ show err
    Right val -> val

main :: IO ()
main = getLine >>= return . toBoard . pack >>= print