{- Translate C type declarations into English.
  This exercise was taken from "Expert C Programming:  Deep C Secrets", p. 84.
   Example: echo -n "int *p;" | runhugs -98 cdecl.hs
-}
--there are only two things from standard libraries I might like to
--use, so I'm just defining them here

--from Data.Char
isAlphaNum c = c `elem` (['a'..'z']++['A'..'Z']++['0'..'9'])

--from Control.Monad
liftM f m = m >>= return . f
--also, chooseMaybe defined lower matches the mplus instance for Maybe

--the token type
data TokenType = Identifier | Qualifier | Type | Symbol Char
  deriving (Show, Eq)
data Token = Token {
  tokenType :: TokenType,
  tokenValue :: String
} deriving (Show, Eq)

-- the lexer
lexer s = map classifyString (words (s >>= padSymbols))
  where padSymbols c | isAlphaNum c = [c]
                     | otherwise = ' ':c:" "

classifyString "const"  = Token Qualifier "read-only "
classifyString "*"      = Token (Symbol '*') "pointer to "
classifyString [c]
  | not (isAlphaNum c)  = Token (Symbol c) [c]
classifyString s        = Token tokType s
  where
    tokType = case s of
      "volatile" -> Qualifier
      x | x `elem` ["void", "char", "signed", "unsigned", "short",
                    "int", "long", "float", "double", "struct",
                    "union", "enum"] -> Type
      x -> Identifier

--make a little parer monad
{- different from "real" libraries mostly in not reporting
   parse failure very nicely, orElse hanging onto the input
   string until the first branch has suceeded or failed,
   and not doing any clever grammar optimization under the covers
-}
newtype Parse tok a = Parse {runParse :: [tok] -> Maybe (a, [tok])}
instance Monad (Parse tok) where
  return x = Parse $ \s -> Just (x, s)
  Parse p1 >>= f = Parse $ \s -> do (x,s') <- p1 s
                                    let (Parse p2) = f x
                                    p2 s'
orElse (Parse p1) (Parse p2) = Parse $ \s -> p1 s `chooseMaybe` p2 s
  where chooseMaybe l@(Just _) _ = l
        chooseMaybe _ r = r
sat pred = Parse testTok
  where testTok (tok:toks) | pred tok = return (tok,toks)
        testTok _ = Nothing

--some useful derived parsers
tok desiredType = sat ((==desiredType).tokenType)
tokVal = liftM tokenValue . tok
tokBut undesiredType = sat ((/=undesiredType).tokenType)
tokButVal = liftM tokenValue . tokBut
option x p = p `orElse` return x
many p = option [] $ do x <- p; xs <- many p; return (x:xs)
many_ p = option () $ p >> many_ p
between start end p = do start; x <- p; end; return x
parens = between (tok (Symbol '(')) (tok (Symbol ')'))
brackets = between (tok (Symbol '[')) (tok (Symbol ']'))

--parse a type declaration into the english text for that declaration
top = do t <- tokVal Type
         txt <- decl
         return (txt++t)

argList = parens (many_ (argList
                         `orElse`
                         (tokBut (Symbol ')') >> return ())))
identifier = tokVal Identifier
decl =
  do qualptrs <- many (tokVal Qualifier `orElse` tokVal (Symbol '*'))
     desc <- (liftM (++" is ") identifier `orElse` parens decl)
     suffixes <- many (do range <- brackets (option "" (liftM ("0.."++) identifier))
                          return $ "array "++range++" of "
                       `orElse`
                       (argList >> return "function returning "))
     return $ desc ++ concat (reverse (qualptrs ++ suffixes))

translate s = let Just result = runParse top (lexer s) in fst result
main = interact translate