87 lines
2.1 KiB
Haskell
87 lines
2.1 KiB
Haskell
module MiniParser.Deploy where
|
|
|
|
import Control.Monad (void)
|
|
import Data.Void (Void)
|
|
import Text.Megaparsec
|
|
( Parsec
|
|
, choice
|
|
, eof
|
|
, errorBundlePretty
|
|
, many
|
|
, parse
|
|
, sepBy1
|
|
, some
|
|
, (<|>)
|
|
)
|
|
import Text.Megaparsec.Char (alphaNumChar, char, space1, string)
|
|
|
|
data Environment
|
|
= Staging
|
|
| Production
|
|
deriving (Eq, Show)
|
|
|
|
data DeployCommand = DeployCommand
|
|
{ serviceName :: String
|
|
, environment :: Environment
|
|
, tags :: [String]
|
|
}
|
|
deriving (Eq, Show)
|
|
|
|
type Parser = Parsec Void String
|
|
|
|
environmentParser :: Parser Environment
|
|
environmentParser =
|
|
choice
|
|
[ Production <$ string "production"
|
|
, Staging <$ string "staging"
|
|
]
|
|
|
|
identifierParser :: Parser String
|
|
identifierParser = some (alphaNumChar <|> char '_' <|> char '-')
|
|
|
|
tagParser :: Parser [String]
|
|
tagParser = string "tags=" *> (identifierParser `sepBy1` char ',')
|
|
|
|
deployCommandParser :: Parser DeployCommand
|
|
deployCommandParser = do
|
|
void (string "deploy")
|
|
space1
|
|
parsedService <- identifierParser
|
|
space1
|
|
parsedEnvironment <- environmentParser
|
|
parsedTags <- many (space1 *> tagParser)
|
|
eof
|
|
pure
|
|
DeployCommand
|
|
{ serviceName = parsedService
|
|
, environment = parsedEnvironment
|
|
, tags = concat parsedTags
|
|
}
|
|
|
|
parseDeployCommand :: String -> Either String DeployCommand
|
|
parseDeployCommand input =
|
|
case parse deployCommandParser "deploy-command" input of
|
|
Left parseError -> Left (errorBundlePretty parseError)
|
|
Right command -> Right command
|
|
|
|
renderCommand :: DeployCommand -> String
|
|
renderCommand command =
|
|
"deploy "
|
|
++ serviceName command
|
|
++ " to "
|
|
++ renderEnvironment (environment command)
|
|
++ renderTags (tags command)
|
|
|
|
renderEnvironment :: Environment -> String
|
|
renderEnvironment Staging = "staging"
|
|
renderEnvironment Production = "production"
|
|
|
|
renderTags :: [String] -> String
|
|
renderTags [] = " with no tags"
|
|
renderTags parsedTags = " with tags: " ++ commaSeparated parsedTags
|
|
|
|
commaSeparated :: [String] -> String
|
|
commaSeparated [] = ""
|
|
commaSeparated [singleItem] = singleItem
|
|
commaSeparated (firstItem : remainingItems) = firstItem ++ ", " ++ commaSeparated remainingItems
|