Created
March 24, 2018 01:42
-
-
Save neongreen/2a7b48e1d72711dc399defe1908840b7 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
-- stack --resolver lts-10.3 --install-ghc runghc --package fmt --package base-prelude --package optparse-applicative --package text | |
{-# LANGUAGE DeriveGeneric #-} | |
{-# LANGUAGE RecordWildCards #-} | |
{-# LANGUAGE NoImplicitPrelude #-} | |
{-# LANGUAGE ApplicativeDo #-} | |
-- | A small program replicating a part of @aws-cli@ (only the interface, | |
-- not the functionality). | |
module Main where | |
import BasePrelude | |
import Data.Text (Text) | |
import Options.Applicative | |
import Fmt | |
main = do | |
fmt . build =<< execParser (describe "Control AWS (not really)" parseCli) | |
-- | Some options (we support only two) and a command. | |
data Cli = Cli | |
{ debug :: Bool | |
, endpointUrl :: Maybe Text | |
, cmd :: Command | |
} | |
deriving Generic | |
instance Buildable Cli where | |
build = genericF | |
-- | A command is either "s3" or "ec2" (for controlling the S3 and EC2 | |
-- services respectively). They have subcommands, which are handled in the | |
-- same data type even though in a real app they would be put into separate | |
-- types. | |
data Command | |
= S3_ls | |
{ uri :: Maybe Text | |
, recursive :: Bool | |
, pageSize :: Maybe Int | |
} | |
| S3_mv | |
{ from :: Text | |
, to :: Text | |
} | |
| EC2_copyImage | |
{ name :: Text | |
, imageId :: Text | |
, region :: Text | |
} | |
deriving Generic | |
instance Buildable Command where | |
build = genericF | |
-- | A parser for the CLI. | |
parseCli :: Parser Cli | |
parseCli = do | |
debug <- switch $ | |
long "debug" <> | |
help "Turn on debug logging" | |
endpointUrl <- optional $ strOption $ | |
long "endpoint-url" <> | |
metavar "URL" <> | |
help "Override command's default URL with the given URL" | |
cmd <- parseCommand | |
pure Cli{..} | |
-- | A parser for commands. | |
parseCommand :: Parser Command | |
parseCommand = subparser $ mconcat | |
[ command "s3" $ describe "Simple Storage Service" $ subparser $ | |
command "ls" (describe "List S3 objects" s3_ls) <> | |
command "mv" (describe "Move an S3 object" s3_mv) | |
, command "ec2" $ describe "Elastic Compute Cloud" $ subparser $ | |
command "copy-image" (describe "Copy an AMI" ec2_copyImage) | |
] | |
where | |
-- S3 commands | |
s3_ls = do | |
uri <- optional $ strArgument $ | |
metavar "S3 URI" | |
recursive <- switch $ | |
long "recursive" <> | |
help "Command is performed on all files or objects" | |
pageSize <- optional $ option auto $ | |
long "page-size" <> | |
help "The number of results to return in each response" | |
pure S3_ls{..} | |
s3_mv = do | |
from <- strArgument (metavar "PATH") | |
to <- strArgument (metavar "PATH") | |
pure S3_mv{..} | |
-- EC2 commands | |
ec2_copyImage = do | |
name <- strOption $ | |
long "name" <> | |
help "The name of the new AMI" | |
imageId <- strOption $ | |
long "source-image-id" <> | |
help "The ID of the AMI to copy" | |
region <- strOption $ | |
long "source-region" <> | |
help "The region that contains the copied AMI" | |
pure EC2_copyImage{..} | |
-- | An utility for adding descriptions to commands (stolen from | |
-- lambdaPass and flipped). | |
describe :: String -> Parser a -> ParserInfo a | |
describe desc opts = info (helper <*> opts) $ progDesc desc |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment