content: 
  -- Parser for recognizing types of inputs
  
  module InputParser where
  
  import Expr
  import Infer
  import Debug
  import Text.Parsec
  import Data.List (intercalate,nub)
  import Control.Monad (foldM)
  
  type InputParser = Parsec String () (Maybe (String, Type))
  
  unifyInputs :: Type -> Type -> Maybe Type
  unifyInputs t1 t2 | trace' 2 ("unifying input types " ++ show t1 ++ " and " ++ show t2) False = undefined
  unifyInputs (TPair t1 t2) (TPair s1 s2) = do
    r1 <- unifyInputs t1 s1
    r2 <- unifyInputs t2 s2
    return $ TPair r1 r2
  unifyInputs (TList t1) (TList t2) = unifyInputs t1 t2 >>= return . TList
  unifyInputs t1@(TConc _) t2 | t1 == t2 = Just t1
  unifyInputs (TVar _) t = Just t
  unifyInputs t (TVar _) = Just t
  unifyInputs _ _ = Nothing
  
  number :: InputParser
  number = do
    minus <- optionMaybe $ char '-'
    prefix <- many1 digit
    suffix <- optionMaybe $ do
      sep <- oneOf "./"
      rest <- many1 digit
      return (sep:rest)
    let number = case (minus, suffix) of
          (Just _, Just suffix)  -> '-' : prefix ++ suffix
          (Just _, Nothing)      -> '-' : prefix
          (Nothing, Just suffix) -> prefix ++ suffix
          (Nothing, Nothing)     -> prefix
    return $ Just (number, TConc TNum)
  
  character :: InputParser
  character = do
    char '\''
    c <- noneOf "\\'" <|> (fmap (\c -> if c == 'n' then '\n' else c) $ char '\\' >> oneOf "\\'n")
    char '\''
    return $ Just (show c, TConc TChar)
  
  plainStr :: InputParser
  plainStr = do
    chars <- many $ noneOf "\\\"" <|> (fmap (\c -> if c == 'n' then '\n' else c) $ char '\\' >> oneOf "\\\"n")
    return $ Just (show chars, TList (TConc TChar))
  
  str :: InputParser
  str = do
    char '"'
    contents <- plainStr
    char '"'
    return contents
  
  list :: InputParser
  list = do
    char '['
    maybeElems <- sepBy inputVal (char ',')
    char ']'
    return $ do
      elems <- sequence maybeElems
      let outStr = "[" ++ intercalate "," (map fst elems) ++ "]"
      outType <- foldM unifyInputs (TVar "x") $ map snd elems
      return (outStr, TList outType)
  
  pair :: InputParser
  pair = do
    char '('
    elem1 <- inputVal
    char ','
    elem2 <- inputVal
    char ')'
    return $ do
      (str1, typ1) <- elem1
      (str2, typ2) <- elem2
      return ("(" ++ str1 ++ "," ++ str2 ++ ")", TPair typ1 typ2)
  
  inputVal :: InputParser
  inputVal = try number <|> try character <|> try list <|> try pair <|> str
  
  input :: InputParser
  input = do
    maybeInputVal <- inputVal
    maybeTyp <- optionMaybe $ char ':' >> inputType
    eof
    return $ case (maybeInputVal, maybeTyp) of
               (Nothing, _) -> Nothing
               (val@(Just _), Nothing) -> val
               (val, Just typ) -> do
                 (str, infTyp) <- val
                 newTyp <- unifyInputs infTyp typ
                 return $ (str, newTyp)
  
  inputType :: Parsec String () Type
  inputType = numT <|> charT <|> varT <|> listT <|> pairT
    where numT  = char 'N' >> return (TConc TNum)
          charT = char 'C' >> return (TConc TChar)
          varT  = lower >>= \c-> return (TVar [c])
          listT = char 'L' >> fmap TList inputType
          pairT = char 'P' >> do
            first <- inputType
            second <- inputType
            return $ TPair first second
  
  parseInput :: Int -> String -> Either String (Maybe (String, Type))
  parseInput inputIndex str =
    case parse (try input <|> plainStr) ("input" ++ show inputIndex) str of
      Left err -> Left $ show err
      Right val -> Right $ trace' 1 ("input " ++ show inputIndex ++ ", " ++ str ++ ", is " ++ show val) val
  