primula-bot-0.0.1: ParseCmd.hs

-- | ParseCmd.hs
-- A module which parse command from user and return parsed structure.

module ParseCmd (
    Parsed(..),
    POSTData,
    parseCmd
) where

import ApplicativeParsec

-- | Command parsed structure.
data Parsed = NewPost POSTData
            | NewThread POSTData
            | DelPost POSTData
            | Help
            | Info
            | Unknown String
            deriving Show

type POSTData = [(String, String)]

-- | Parse command with parsec.
parseCmd :: String -> Parsed
parseCmd cmd =
    case parse parseCmd' "command" cmd of
      Left err -> Unknown (show err)
      Right p -> p

-- Simple parsers.

parseCmd' =
    (spaces0 *> cmd) <*
    (spaces0 *> eof)

cmd = post
  <|> thread
  <|> del
  <|> (Help <$ string "help")
  <|> (Info <$ string "info")
  <?> "right command"

post = toResult <$>
    (string "&gt;&gt;" *> many1 digit) <*>
    sage <*>
    imgURL <*>
    body
  where
    toResult num sage u body =
      NewPost $ sage++u++[("replyto", num), ("body", body)]

sage = [("sage", "1")] <$ (string "SAGE")
   <|> return []

thread = toResult <$>
    (char '*' *> many1 (oneOf $ ['A'..'Z']++['a'..'z'])) <*>
    imgURL <*>
    body 
  where
    toResult tag u body =
      NewThread $ u++[("tag", tag), ("body", body)]

imgURL = spaces0 *> (imgURL' <|> return [])
imgURL' = (\u -> [("imgurl", "http://"++u)]) <$>
   (string "http://"
    *> many1 (alphaNum <|> oneOf "_-/.%?@")
    <* spaces0)

body = char '\n' *> many1 anyChar

del = liftA2 toResult
    (string "del" *> spaces1 *> many1 digit)
    (spaces1 *> many1 alphaNum)
  where
    toResult num pwd =
      DelPost [("number", num), ("password", pwd)]

spaces0 = many (char ' ')
spaces1 = many1 (char ' ')