AssetDB.hs

module AssetDB where
import Text.ParserCombinators.Parsec
import Data.List (intercalate)

data Query = Class String
           | Role String
           | Attr String (Maybe String)
           | Tag String
           | Status String
           | Host String
           | AllAssets
           | And Query Query
           | Or Query Query
           | Not Query
           deriving (Show)

delim :: GenParser Char st Char
delim = oneOf "-_"

delimitedWords :: GenParser Char st String
delimitedWords = do
    x <- many1 alphaNum
    xs <- many $ try $ delim >> many1 alphaNum
    return $ intercalate "-" (x:xs)

parseADB :: GenParser Char st Query
parseADB = do
      _ <- string "adb"
      _ <- delim
      index <- choice $ map (try . string) ["class", "role", "attr", "tag", "status", "all-assets"]
      case index of
        "all-assets" -> return AllAssets
        _            -> do
          _ <- delim
          name <- delimitedWords
          case index of
            "class"      -> return $ Class name
            "role"       -> return $ Role name
            "tag"        -> return $ Tag name
            "status"     -> return $ Status name
            "attr"       -> do
              attrval <- optionMaybe $ count 2 delim >> delimitedWords
              return $ Attr name attrval

parseHost :: GenParser Char st Query
parseHost = do
      _ <- (string "af") <|> (string "AF")
      digits <- count 6 digit
      return $ Host $ "AF" ++ digits

parseNot :: GenParser Char st Query
parseNot = do
    _ <- oneOf "!~"
    q <- parseQuery
    return $ Not q

parseGroup :: GenParser Char st Query
parseGroup = between (char '(') (char ')') parseQuery

parseItem :: GenParser Char st Query
parseItem = parseADB <|> parseHost <|> parseNot <|> parseGroup

parseQuery :: GenParser Char st Query
parseQuery = do
    item <- parseItem
    tail <- optionMaybe $ oneOf ".&,|"
    case tail of
      Nothing -> return item
      Just op -> do
        rest <- parseQuery
        case op of
          '.' -> return $ And item rest
          '&' -> return $ And item rest
          ',' -> return $ Or item rest
          '|' -> return $ Or item rest

test' :: String -> IO ()
test' = parseTest parseQuery

test :: IO ()
test = mapM_ test' ["adb-class-redis", "adb-attr-foo", "adb-attr-foo--bar", "adb-all-assets", "AF001234", "!adb-class-mysql", "adb-attr-foo.!adb-attr-bar--baz"]