{-# 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 forall {ann}. Maybe (Doc ann)
dsc' Maybe Doc
ftr'
where
dsc' :: Maybe (Doc ann)
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
$ forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [FilePath]
dsc
ftr' :: Maybe Doc
ftr' = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
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 forall {ann}. Doc ann
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 ann
hdr' = forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
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
forall {ann}. Maybe (Doc ann)
dsc'
forall {ann}. Maybe (Doc ann)
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 ann)
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
$ forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [FilePath]
dsc
ftr' :: Maybe (Doc ann)
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
$ forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
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 forall {ann}. Maybe (Doc ann)
dsc' forall {ann}. Maybe (Doc ann)
ftr' Parser a
p
where
dsc' :: Maybe (Doc ann)
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
$ forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [FilePath]
dsc
ftr' :: Maybe (Doc ann)
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
$ forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [FilePath]
ftr
fillParagraph :: String -> Doc
fillParagraph :: FilePath -> Doc
fillParagraph = forall ann. [Doc ann] -> Doc ann
fillSep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
words
elynxFooter :: [Doc]
=
[ forall a. Monoid a => a
mempty,
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"ELynx",
forall a ann. Pretty a => a -> Doc ann
pretty 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.",
forall a. Monoid a => a
mempty,
forall ann. Int -> Doc ann -> Doc ann
fill Int
9 (forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"slynx")
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"Analyze, modify, and simulate evolutionary sequences.",
forall ann. Int -> Doc ann -> Doc ann
fill Int
9 (forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"tlynx")
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"Analyze, modify, and simulate phylogenetic trees.",
forall ann. Int -> Doc ann -> Doc ann
fill Int
9 (forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"elynx") forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"Validate and redo past analyses.",
forall a. Monoid a => a
mempty,
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"Get help for commands:",
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
" slynx --help",
forall a. Monoid a => a
mempty,
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
"Get help for sub commands:",
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
" slynx examine --help"
]