{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE QuasiQuotes #-}
module Hasklepias.CohortApp.CohortAppCLI where
import Data.Aeson (ToJSON)
import Data.Char (toLower)
import Data.String.Interpolate (i)
import Data.Text (Text, splitOn)
import EventDataTheory.EventLines (ParseEventLineOption (..))
import GHC.Generics (Generic)
import Options.Applicative
import Options.Applicative.Help hiding (fullDesc)
import Text.Read (readMaybe)
data CohortCLIOpts = CohortCLIOpts
{
CohortCLIOpts -> (InputFlag, Input)
input :: !(InputFlag, Input),
CohortCLIOpts -> (OutputFlag, Output)
output :: !(OutputFlag, Output),
CohortCLIOpts -> InputDecompression
inDecompress :: !InputDecompression,
CohortCLIOpts -> OutputCompression
outCompress :: !OutputCompression,
CohortCLIOpts -> ParseEventLineOption
intervalOpt :: !ParseEventLineOption
}
type BucketName = Text
type ObjectKey = Text
newtype CredentialsCfg = MkCredentialsCfg
{ CredentialsCfg -> Text
credentialsProfile :: Text
}
deriving (CredentialsCfg -> CredentialsCfg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CredentialsCfg -> CredentialsCfg -> Bool
$c/= :: CredentialsCfg -> CredentialsCfg -> Bool
== :: CredentialsCfg -> CredentialsCfg -> Bool
$c== :: CredentialsCfg -> CredentialsCfg -> Bool
Eq, forall x. Rep CredentialsCfg x -> CredentialsCfg
forall x. CredentialsCfg -> Rep CredentialsCfg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CredentialsCfg x -> CredentialsCfg
$cfrom :: forall x. CredentialsCfg -> Rep CredentialsCfg x
Generic, Int -> CredentialsCfg -> ShowS
[CredentialsCfg] -> ShowS
CredentialsCfg -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CredentialsCfg] -> ShowS
$cshowList :: [CredentialsCfg] -> ShowS
show :: CredentialsCfg -> FilePath
$cshow :: CredentialsCfg -> FilePath
showsPrec :: Int -> CredentialsCfg -> ShowS
$cshowsPrec :: Int -> CredentialsCfg -> ShowS
Show)
instance ToJSON CredentialsCfg
data InputFlag = StdIn | FileIn | S3In deriving (Int -> InputFlag -> ShowS
[InputFlag] -> ShowS
InputFlag -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [InputFlag] -> ShowS
$cshowList :: [InputFlag] -> ShowS
show :: InputFlag -> FilePath
$cshow :: InputFlag -> FilePath
showsPrec :: Int -> InputFlag -> ShowS
$cshowsPrec :: Int -> InputFlag -> ShowS
Show)
data Input
= StdInput
| FileInput FilePath
| S3Input CredentialsCfg BucketName ObjectKey
deriving (Int -> Input -> ShowS
[Input] -> ShowS
Input -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Input] -> ShowS
$cshowList :: [Input] -> ShowS
show :: Input -> FilePath
$cshow :: Input -> FilePath
showsPrec :: Int -> Input -> ShowS
$cshowsPrec :: Int -> Input -> ShowS
Show)
data OutputFlag = StdOut | FileOut | S3Out deriving (Int -> OutputFlag -> ShowS
[OutputFlag] -> ShowS
OutputFlag -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OutputFlag] -> ShowS
$cshowList :: [OutputFlag] -> ShowS
show :: OutputFlag -> FilePath
$cshow :: OutputFlag -> FilePath
showsPrec :: Int -> OutputFlag -> ShowS
$cshowsPrec :: Int -> OutputFlag -> ShowS
Show)
data Output
= StdOutput
| FileOutput FilePath
| S3Output CredentialsCfg BucketName ObjectKey
deriving (Int -> Output -> ShowS
[Output] -> ShowS
Output -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Output] -> ShowS
$cshowList :: [Output] -> ShowS
show :: Output -> FilePath
$cshow :: Output -> FilePath
showsPrec :: Int -> Output -> ShowS
$cshowsPrec :: Int -> Output -> ShowS
Show)
data InputDecompression = NoDecompress | Decompress deriving (Int -> InputDecompression -> ShowS
[InputDecompression] -> ShowS
InputDecompression -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [InputDecompression] -> ShowS
$cshowList :: [InputDecompression] -> ShowS
show :: InputDecompression -> FilePath
$cshow :: InputDecompression -> FilePath
showsPrec :: Int -> InputDecompression -> ShowS
$cshowsPrec :: Int -> InputDecompression -> ShowS
Show)
data OutputCompression = NoCompress | Compress deriving (Int -> OutputCompression -> ShowS
[OutputCompression] -> ShowS
OutputCompression -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OutputCompression] -> ShowS
$cshowList :: [OutputCompression] -> ShowS
show :: OutputCompression -> FilePath
$cshow :: OutputCompression -> FilePath
showsPrec :: Int -> OutputCompression -> ShowS
$cshowsPrec :: Int -> OutputCompression -> ShowS
Show)
cliParser :: Parser CohortCLIOpts
cliParser :: Parser CohortCLIOpts
cliParser =
(InputFlag, Input)
-> (OutputFlag, Output)
-> InputDecompression
-> OutputCompression
-> ParseEventLineOption
-> CohortCLIOpts
CohortCLIOpts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (InputFlag, Input)
inParser
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (OutputFlag, Output)
outParser
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser InputDecompression
inputDecompressionParser
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputCompression
outputCompressionParser
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ParseEventLineOption
intervalOptParser
intervalFixEnd :: Parser Bool
intervalFixEnd :: Parser Bool
intervalFixEnd =
Mod FlagFields Bool -> Parser Bool
switch
( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"fix-end"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Parse input intervals with missing end as moment-length intervals"
)
intervalAddMoment :: Parser Bool
intervalAddMoment :: Parser Bool
intervalAddMoment =
Mod FlagFields Bool -> Parser Bool
switch
( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"add-moment"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Add a moment to input interval end times for which end >= begin"
)
intervalOptParser :: Parser ParseEventLineOption
intervalOptParser :: Parser ParseEventLineOption
intervalOptParser = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool, Bool) -> ParseEventLineOption
wrap forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
intervalFixEnd forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
intervalAddMoment
where wrap :: (Bool, Bool) -> ParseEventLineOption
wrap (Bool
True, Bool
True) = ParseEventLineOption
AddMomentAndFix
wrap (Bool
True, Bool
False) = ParseEventLineOption
FixEnd
wrap (Bool
False, Bool
True) = ParseEventLineOption
AddMomentToEnd
wrap (Bool
False, Bool
False) = ParseEventLineOption
DoNotModifyTime
stdIn :: Parser (InputFlag, Input)
stdIn = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser InputFlag
stdInFlag forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Input
stdInputParser
fileIn :: Parser (InputFlag, Input)
fileIn = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser InputFlag
fileInFlag forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Input
fileInputParser
s3In :: Parser (InputFlag, Input)
s3In = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser InputFlag
s3InFlag forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Input
s3InputParser
stdOut :: Parser (OutputFlag, Output)
stdOut = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser OutputFlag
stdOutFlag forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Output
stdOutputParser
fileOut :: Parser (OutputFlag, Output)
fileOut = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser OutputFlag
fileOutFlag forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Output
fileOutputParser
s3Out :: Parser (OutputFlag, Output)
s3Out = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser OutputFlag
s3OutFlag forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Output
s3OutputParser
inParser :: Parser (InputFlag, Input)
inParser :: Parser (InputFlag, Input)
inParser = Parser (InputFlag, Input)
stdIn forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (InputFlag, Input)
fileIn forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (InputFlag, Input)
s3In
outParser :: Parser (OutputFlag, Output)
outParser :: Parser (OutputFlag, Output)
outParser = Parser (OutputFlag, Output)
stdOut forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (OutputFlag, Output)
fileOut forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (OutputFlag, Output)
s3Out
cliParserInfo :: ParserInfo CohortCLIOpts
cliParserInfo :: ParserInfo CohortCLIOpts
cliParserInfo =
forall a. Parser a -> InfoMod a -> ParserInfo a
info
(Parser CohortCLIOpts
cliParser forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
helper)
(forall a. InfoMod a
fullDesc forall a. Semigroup a => a -> a -> a
<> forall a. Maybe Doc -> InfoMod a
progDescDoc (forall a. a -> Maybe a
Just Doc
helpText))
where
helpText :: Doc
helpText = [i|A cohort-building application.|]
stdInFlag :: Parser InputFlag
stdInFlag :: Parser InputFlag
stdInFlag =
forall a. a -> Mod FlagFields a -> Parser a
flag'
InputFlag
StdIn
( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"stdin"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Read from stdin"
)
fileInFlag :: Parser InputFlag
fileInFlag :: Parser InputFlag
fileInFlag =
forall a. a -> Mod FlagFields a -> Parser a
flag'
InputFlag
FileIn
( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"filein"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Read from specified INPUT file"
)
s3InFlag :: Parser InputFlag
s3InFlag :: Parser InputFlag
s3InFlag =
forall a. a -> Mod FlagFields a -> Parser a
flag'
InputFlag
S3In
( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"s3in"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Read from specified S3 object, using BUCKETIN KEYIN"
)
stdOutFlag :: Parser OutputFlag
stdOutFlag :: Parser OutputFlag
stdOutFlag =
forall a. a -> Mod FlagFields a -> Parser a
flag'
OutputFlag
StdOut
( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"stdout"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Write to stdout"
)
fileOutFlag :: Parser OutputFlag
fileOutFlag :: Parser OutputFlag
fileOutFlag =
forall a. a -> Mod FlagFields a -> Parser a
flag'
OutputFlag
FileOut
( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"fileout"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Write to specified OUTPUT file"
)
s3OutFlag :: Parser OutputFlag
s3OutFlag :: Parser OutputFlag
s3OutFlag =
forall a. a -> Mod FlagFields a -> Parser a
flag'
OutputFlag
S3Out
( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"s3out"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Write to specified S3 object, using BUCKETOUT KEYOUT"
)
stdInputParser :: Parser Input
stdInputParser :: Parser Input
stdInputParser = forall (f :: * -> *) a. Applicative f => a -> f a
pure Input
StdInput
stdOutputParser :: Parser Output
stdOutputParser :: Parser Output
stdOutputParser = forall (f :: * -> *) a. Applicative f => a -> f a
pure Output
StdOutput
fileInputParser :: Parser Input
fileInputParser :: Parser Input
fileInputParser =
FilePath -> Input
FileInput
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod OptionFields s -> Parser s
strOption
(forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"input" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'i' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"INPUT" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Input file")
fileOutputParser :: Parser Output
fileOutputParser :: Parser Output
fileOutputParser =
FilePath -> Output
FileOutput
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod OptionFields s -> Parser s
strOption
(forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"output" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'o' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"OUTPUT" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Output file")
s3InputParser :: Parser Input
s3InputParser :: Parser Input
s3InputParser =
CredentialsCfg -> Text -> Text -> Input
S3Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Text -> CredentialsCfg
MkCredentialsCfg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod OptionFields s -> Parser s
strOption
( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"profile"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PROFILE"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Text
"default"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"AWS profile name. Default is 'default'"
)
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. IsString s => Mod OptionFields s -> Parser s
strOption
(forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"bkt-in" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"BUCKETIN" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"S3 input bucket")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. IsString s => Mod OptionFields s -> Parser s
strOption
(forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"key-in" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"KEYIN" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"S3 input object key")
s3OutputParser :: Parser Output
s3OutputParser :: Parser Output
s3OutputParser =
CredentialsCfg -> Text -> Text -> Output
S3Output
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Text -> CredentialsCfg
MkCredentialsCfg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod OptionFields s -> Parser s
strOption
( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"profile"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PROFILE"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Text
"default"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"AWS profile name. Default is 'default'"
)
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. IsString s => Mod OptionFields s -> Parser s
strOption
(forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"bkt-out" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"BUCKETOUT" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"S3 output bucket")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. IsString s => Mod OptionFields s -> Parser s
strOption
(forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"key-out" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"KEYOUT" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"S3 output object key")
inputDecompressionParser :: Parser InputDecompression
inputDecompressionParser :: Parser InputDecompression
inputDecompressionParser =
forall a. a -> Mod FlagFields a -> Parser a
flag'
InputDecompression
Decompress
(forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"decompress" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'd' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Decompress gzipped input")
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure InputDecompression
NoDecompress
outputCompressionParser :: Parser OutputCompression
outputCompressionParser :: Parser OutputCompression
outputCompressionParser =
forall a. a -> Mod FlagFields a -> Parser a
flag' OutputCompression
Compress (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"compress" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'z' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Ccompress output using gzip")
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure OutputCompression
NoCompress