{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module ELynx.Tools.Options
(
seedOpt,
executionModeOpt,
GlobalArguments (..),
Arguments (..),
parseArguments,
elynxParserInfo,
createCommandReproducible,
createCommand,
elynxFooter,
)
where
import Data.Aeson
import Data.List
import ELynx.Tools.InputOutput
import ELynx.Tools.Logger
import ELynx.Tools.Reproduction
import GHC.Generics
import Options.Applicative hiding (empty)
import Options.Applicative.Help.Pretty
seedOpt :: Parser SeedOpt
seedOpt :: Parser SeedOpt
seedOpt = Maybe Int -> SeedOpt
toSeedOpt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Int)
seedParser
seedParser :: Parser (Maybe Int)
seedParser :: Parser (Maybe Int)
seedParser =
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
forall a b. (a -> b) -> a -> b
$ forall a. ReadM a -> Mod OptionFields a -> Parser a
option
forall a. Read a => ReadM a
auto
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"seed"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'S'
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"INT"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Seed for random number generator (default: random)"
toSeedOpt :: Maybe Int -> SeedOpt
toSeedOpt :: Maybe Int -> SeedOpt
toSeedOpt Maybe Int
Nothing = SeedOpt
RandomUnset
toSeedOpt (Just Int
w) = Int -> SeedOpt
Fixed Int
w
executionModeOpt :: Parser ExecutionMode
executionModeOpt :: Parser ExecutionMode
executionModeOpt =
forall a. a -> a -> Mod FlagFields a -> Parser a
flag
ExecutionMode
Fail
ExecutionMode
Overwrite
( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"force"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f'
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help
FilePath
"Ignore previous analysis and overwrite existing output files."
)
data GlobalArguments = GlobalArguments
{ GlobalArguments -> Verbosity
verbosity :: Verbosity,
GlobalArguments -> Maybe FilePath
outFileBaseName :: Maybe FilePath,
GlobalArguments -> ExecutionMode
executionMode :: ExecutionMode,
GlobalArguments -> Bool
writeElynxFile :: Bool
}
deriving (GlobalArguments -> GlobalArguments -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlobalArguments -> GlobalArguments -> Bool
$c/= :: GlobalArguments -> GlobalArguments -> Bool
== :: GlobalArguments -> GlobalArguments -> Bool
$c== :: GlobalArguments -> GlobalArguments -> Bool
Eq, Int -> GlobalArguments -> ShowS
[GlobalArguments] -> ShowS
GlobalArguments -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [GlobalArguments] -> ShowS
$cshowList :: [GlobalArguments] -> ShowS
show :: GlobalArguments -> FilePath
$cshow :: GlobalArguments -> FilePath
showsPrec :: Int -> GlobalArguments -> ShowS
$cshowsPrec :: Int -> GlobalArguments -> ShowS
Show, forall x. Rep GlobalArguments x -> GlobalArguments
forall x. GlobalArguments -> Rep GlobalArguments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GlobalArguments x -> GlobalArguments
$cfrom :: forall x. GlobalArguments -> Rep GlobalArguments x
Generic)
instance FromJSON GlobalArguments
instance ToJSON GlobalArguments
globalArguments :: Parser GlobalArguments
globalArguments :: Parser GlobalArguments
globalArguments =
Verbosity
-> Maybe FilePath -> ExecutionMode -> Bool -> GlobalArguments
GlobalArguments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Verbosity
verbosityOpt
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser FilePath
outFileBaseNameOpt
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ExecutionMode
executionModeOpt
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
writeELynxOpt
verbosityOpt :: Parser Verbosity
verbosityOpt :: Parser Verbosity
verbosityOpt =
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
forall a. Read a => ReadM a
auto
( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"verbosity"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v'
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"VALUE"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Verbosity
Info
forall a. Semigroup a => a -> a -> a
<> forall a (f :: * -> *). Show a => Mod f a
showDefault
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help (FilePath
"Be verbose; one of: " forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> FilePath
show [Verbosity]
vs))
)
where
vs :: [Verbosity]
vs = [forall a. Bounded a => a
minBound ..] :: [Verbosity]
outFileBaseNameOpt :: Parser FilePath
outFileBaseNameOpt :: Parser FilePath
outFileBaseNameOpt =
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"output-file-basename"
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
"NAME"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help
FilePath
"Specify base name of output file"
)
writeELynxOpt :: Parser Bool
writeELynxOpt :: Parser Bool
writeELynxOpt =
forall a. a -> a -> Mod FlagFields a -> Parser a
flag
Bool
True
Bool
False
( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"no-elynx-file"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Do not write data required to reproduce an analysis."
)
data Arguments a = Arguments
{ forall a. Arguments a -> GlobalArguments
global :: GlobalArguments,
forall a. Arguments a -> a
local :: a
}
deriving (Arguments a -> Arguments a -> Bool
forall a. Eq a => Arguments a -> Arguments a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Arguments a -> Arguments a -> Bool
$c/= :: forall a. Eq a => Arguments a -> Arguments a -> Bool
== :: Arguments a -> Arguments a -> Bool
$c== :: forall a. Eq a => Arguments a -> Arguments a -> Bool
Eq, Int -> Arguments a -> ShowS
forall a. Show a => Int -> Arguments a -> ShowS
forall a. Show a => [Arguments a] -> ShowS
forall a. Show a => Arguments a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Arguments a] -> ShowS
$cshowList :: forall a. Show a => [Arguments a] -> ShowS
show :: Arguments a -> FilePath
$cshow :: forall a. Show a => Arguments a -> FilePath
showsPrec :: Int -> Arguments a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Arguments a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Arguments a) x -> Arguments a
forall a x. Arguments a -> Rep (Arguments a) x
$cto :: forall a x. Rep (Arguments a) x -> Arguments a
$cfrom :: forall a x. Arguments a -> Rep (Arguments a) x
Generic)
instance FromJSON a => FromJSON (Arguments a)
instance ToJSON a => ToJSON (Arguments a)
instance Reproducible a => Reproducible (Arguments a) where
inFiles :: Arguments a -> [FilePath]
inFiles = forall a. Reproducible a => a -> [FilePath]
inFiles forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Arguments a -> a
local
outSuffixes :: Arguments a -> [FilePath]
outSuffixes = forall a. Reproducible a => a -> [FilePath]
outSuffixes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Arguments a -> a
local
getSeed :: Arguments a -> Maybe SeedOpt
getSeed = forall a. Reproducible a => a -> Maybe SeedOpt
getSeed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Arguments a -> a
local
setSeed :: Arguments a -> SeedOpt -> Arguments a
setSeed (Arguments GlobalArguments
g a
l) SeedOpt
s = forall a. GlobalArguments -> a -> Arguments a
Arguments GlobalArguments
g forall a b. (a -> b) -> a -> b
$ forall a. Reproducible a => a -> SeedOpt -> a
setSeed a
l SeedOpt
s
parser :: Parser (Arguments a)
parser = forall a. Parser a -> Parser (Arguments a)
argumentsParser (forall a. Reproducible a => Parser a
parser @a)
cmdName :: FilePath
cmdName = forall a. Reproducible a => FilePath
cmdName @a
cmdDsc :: [FilePath]
cmdDsc = forall a. Reproducible a => [FilePath]
cmdDsc @a
cmdFtr :: [FilePath]
cmdFtr = forall a. Reproducible a => [FilePath]
cmdFtr @a
argumentsParser :: Parser a -> Parser (Arguments a)
argumentsParser :: forall a. Parser a -> Parser (Arguments a)
argumentsParser Parser a
p = forall a. GlobalArguments -> a -> Arguments a
Arguments forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GlobalArguments
globalArguments forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
p
versionOpt :: Parser (a -> a)
versionOpt :: forall a. Parser (a -> a)
versionOpt =
forall a. FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption
(forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"\n" [FilePath]
logHeader)
( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"version"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'V'
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Show version"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Mod f a
hidden
)
elynxParser :: Parser a -> Parser a
elynxParser :: forall a. Parser a -> Parser a
elynxParser Parser a
p = forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser (a -> a)
versionOpt forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
p
parseArguments :: forall a. Reproducible a => IO (Arguments a)
parseArguments :: forall a. Reproducible a => IO (Arguments a)
parseArguments =
forall a. ParserInfo a -> IO a
execParser forall a b. (a -> b) -> a -> b
$
forall a. [FilePath] -> [FilePath] -> Parser a -> ParserInfo a
elynxParserInfo (forall a. Reproducible a => [FilePath]
cmdDsc @a) (forall a. Reproducible a => [FilePath]
cmdFtr @a) (forall a. Parser a -> Parser (Arguments a)
argumentsParser forall a b. (a -> b) -> a -> b
$ forall a. Reproducible a => Parser a
parser @a)
elynxParserInfo :: [String] -> [String] -> Parser a -> ParserInfo a
elynxParserInfo :: forall a. [FilePath] -> [FilePath] -> Parser a -> ParserInfo a
elynxParserInfo [FilePath]
dsc [FilePath]
ftr = forall a. Maybe Doc -> Maybe Doc -> Parser a -> ParserInfo a
parserInfo Maybe Doc
dsc' Maybe Doc
ftr'
where
dsc' :: Maybe Doc
dsc' = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
dsc then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [FilePath]
dsc
ftr' :: Maybe Doc
ftr' = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [FilePath]
ftr forall a. [a] -> [a] -> [a]
++ [Doc]
elynxFooter
parserInfo :: Maybe Doc -> Maybe Doc -> Parser a -> ParserInfo a
parserInfo :: forall a. Maybe Doc -> Maybe Doc -> Parser a -> ParserInfo a
parserInfo Maybe Doc
dsc Maybe Doc
ftr Parser a
p =
forall a. Parser a -> InfoMod a -> ParserInfo a
info
(forall a. Parser a -> Parser a
elynxParser Parser a
p)
(forall a. InfoMod a
fullDesc forall a. Semigroup a => a -> a -> a
<> forall a. Maybe Doc -> InfoMod a
headerDoc (forall a. a -> Maybe a
Just Doc
hdr') forall a. Semigroup a => a -> a -> a
<> forall a. Maybe Doc -> InfoMod a
progDescDoc Maybe Doc
dsc forall a. Semigroup a => a -> a -> a
<> forall a. Maybe Doc -> InfoMod a
footerDoc Maybe Doc
ftr)
where
hdr' :: Doc
hdr' = [Doc] -> Doc
vsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [FilePath]
logHeader
createCommandReproducible ::
forall a b. Reproducible a => (a -> b) -> Mod CommandFields b
createCommandReproducible :: forall a b. Reproducible a => (a -> b) -> Mod CommandFields b
createCommandReproducible a -> b
f =
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command (forall a. Reproducible a => FilePath
cmdName @a) forall a b. (a -> b) -> a -> b
$
a -> b
f
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Maybe Doc -> Maybe Doc -> Parser a -> ParserInfo a
parserInfo
Maybe Doc
dsc'
Maybe Doc
ftr'
(forall a. Reproducible a => Parser a
parser @a)
where
dsc :: [FilePath]
dsc = forall a. Reproducible a => [FilePath]
cmdDsc @a
ftr :: [FilePath]
ftr = forall a. Reproducible a => [FilePath]
cmdFtr @a
dsc' :: Maybe Doc
dsc' = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
dsc then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [FilePath]
dsc
ftr' :: Maybe Doc
ftr' = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
ftr then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [FilePath]
ftr
createCommand ::
String ->
[String] ->
[String] ->
Parser a ->
(a -> b) ->
Mod CommandFields b
createCommand :: forall a b.
FilePath
-> [FilePath]
-> [FilePath]
-> Parser a
-> (a -> b)
-> Mod CommandFields b
createCommand FilePath
nm [FilePath]
dsc [FilePath]
ftr Parser a
p a -> b
f = forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
nm forall a b. (a -> b) -> a -> b
$ a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Maybe Doc -> Maybe Doc -> Parser a -> ParserInfo a
parserInfo Maybe Doc
dsc' Maybe Doc
ftr' Parser a
p
where
dsc' :: Maybe Doc
dsc' = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
dsc then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [FilePath]
dsc
ftr' :: Maybe Doc
ftr' = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
ftr then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty [FilePath]
ftr
fillParagraph :: String -> Doc
fillParagraph :: FilePath -> Doc
fillParagraph = [Doc] -> Doc
fillSep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
words
elynxFooter :: [Doc]
=
[ Doc
empty,
FilePath -> Doc
text FilePath
"ELynx",
FilePath -> Doc
text FilePath
"-----",
FilePath -> Doc
fillParagraph
FilePath
"A Haskell library and tool set for computational biology. The goal of ELynx is reproducible research. Evolutionary sequences and phylogenetic trees can be read, viewed, modified and simulated. The command line with all arguments is logged consistently, and automatically. Data integrity is verified using SHA256 sums so that validation of past analyses is possible without the need to recompute the result.",
Doc
empty,
Int -> Doc -> Doc
fill Int
9 (FilePath -> Doc
text FilePath
"slynx")
Doc -> Doc -> Doc
<+> FilePath -> Doc
text FilePath
"Analyze, modify, and simulate evolutionary sequences.",
Int -> Doc -> Doc
fill Int
9 (FilePath -> Doc
text FilePath
"tlynx")
Doc -> Doc -> Doc
<+> FilePath -> Doc
text FilePath
"Analyze, modify, and simulate phylogenetic trees.",
Int -> Doc -> Doc
fill Int
9 (FilePath -> Doc
text FilePath
"elynx") Doc -> Doc -> Doc
<+> FilePath -> Doc
text FilePath
"Validate and redo past analyses.",
Doc
empty,
FilePath -> Doc
text FilePath
"Get help for commands:",
FilePath -> Doc
text FilePath
" slynx --help",
Doc
empty,
FilePath -> Doc
text FilePath
"Get help for sub commands:",
FilePath -> Doc
text FilePath
" slynx examine --help"
]