-- hsdip -- a diplomacy parser/renderer.
-- Copyright (C) 2006 Evan Martin <martine@danga.com>

module Conf(
  Conf(..),
  locXY,
  parseFile
) where

import Text.ParserCombinators.Parsec
import qualified Text.ParserCombinators.Parsec.Token as P
import Text.ParserCombinators.Parsec.Language
import qualified Data.Map as Map
import qualified Diplomacy
import qualified Data.Char
-- import Debug.Trace

data Conf = Conf {
  locations :: Map.Map String (Int, Int)
} deriving Show

-- fallback :: a -> Maybe a -> a
-- fallback def try = maybe def id try

keyFromLocation :: Diplomacy.Location -> String
keyFromLocation = tryCases where
  tryCases "Liverpool"       = "lvp"
  tryCases "Gulf of Bothnia" = "bot"
  tryCases "North Sea"       = "nth"
  tryCases "Norwegian Sea"   = "nrg"
  tryCases x                 = defaultMunge x
  defaultMunge = take 3 . spacefree . lowercase
  spacefree = filter (/= ' ')
  lowercase = map Data.Char.toLower

locXY :: Conf -> Diplomacy.Location -> (Double, Double)
locXY conf loc = maybe (error ("Bad location " ++ loc)) toDouble coords where
  toDouble (x, y) = (fromIntegral x, fromIntegral y)
  coords = Map.lookup key (locations conf)
  key = keyFromLocation loc

lexer :: P.TokenParser st
lexer = P.makeTokenParser def where
  def = emptyDef {
          P.commentLine = "#",
          P.opStart = opLetter def,
          P.opLetter = oneOf "(,)"
          -- P.reservedNames = ["location"]
        }
{-
braces :: CharParser st a -> CharParser st a
braces = P.braces lexer
reserved :: String -> CharParser st ()
reserved = P.reserved lexer
-}
comma :: CharParser st String
comma = P.comma lexer
decimal :: CharParser st Integer
decimal = P.decimal lexer
identifier :: CharParser st String
identifier = P.identifier lexer
parens :: CharParser st a -> CharParser st a
parens = P.parens lexer

whiteSpace :: CharParser st ()
whiteSpace = P.whiteSpace lexer

p_conf :: GenParser Char () Conf
p_conf = do
  whiteSpace
  locs <- many1 p_location
  return $ Conf (Map.fromList locs)
  where
    p_location :: Parser (String, (Int,Int))
    p_location = do
      loc <- identifier
      pos <- parens $ do x <- decimal
                         comma
                         y <- decimal
                         return (fromIntegral x, fromIntegral y)
      return (loc, pos)

parseFile :: FilePath -> IO (Either String Conf)
parseFile file = do
  res <- parseFromFile p_conf file
  return $ case res of
    Left err -> Left (show err)
    Right conf -> Right conf

-- vim: set ts=2 sw=2 et :