{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
module ELynx.Tools.Reproduction
(
logHeader,
logFooter,
Verbosity (..),
toLogLevel,
Force (..),
forceOpt,
GlobalArguments (..),
globalArguments,
Seed (..),
seedOpt,
Arguments (..),
parseArguments,
ELynx,
Reproducible (..),
getReproductionHash,
Reproduction (..),
writeReproduction,
hashFile,
createCommandReproducible,
createCommand,
elynxParserInfo,
Generic,
FromJSON,
ToJSON,
)
where
import Control.Monad
import Control.Monad.Logger
import Control.Monad.Trans.Reader hiding (local)
import Crypto.Hash.SHA256
import Data.Aeson hiding (encode)
import Data.ByteString.Base16
import qualified Data.ByteString.Char8 as BS
import Data.List hiding (group)
import Data.Time
import Data.Vector.Unboxed (Vector)
import Data.Version
import Data.Word
import ELynx.Tools.Misc
import GHC.Generics
import Language.Haskell.TH
import Options.Applicative hiding (empty)
import Options.Applicative.Help.Pretty
import Paths_elynx_tools
import System.Environment
versionString :: String
versionString :: String
versionString = String
"ELynx Suite version " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
version String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
copyrightString :: String
copyrightString :: String
copyrightString = String
"Developed by Dominik Schrempf."
compilationString :: String
compilationString :: String
compilationString =
String
"Compiled on "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ $( stringE
=<< runIO
( formatTime defaultTimeLocale "%B %-e, %Y, at %H:%M %P, %Z."
`fmap` Data.Time.getCurrentTime
)
)
hdr :: [String]
hdr :: [String]
hdr = [String
versionString, String
copyrightString, String
compilationString]
time :: IO String
time :: IO String
time =
TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%B %-e, %Y, at %H:%M %P, %Z."
(UTCTime -> String) -> IO UTCTime -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO UTCTime
Data.Time.getCurrentTime
logHeader :: String -> [String] -> IO String
String
h [String]
dsc = do
String
t <- IO String
time
String
p <- IO String
getProgName
[String]
as <- IO [String]
getArgs
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$
String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
(String
"=== " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
h) String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
[String]
dsc
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
hdr
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"Start time: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t, String
"Command line: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
as]
logFooter :: IO String
= do
String
t <- IO String
time
let timeStr :: String
timeStr = String
"=== End time: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" [String
timeStr]
versionOpt :: Parser (a -> a)
versionOpt :: Parser (a -> a)
versionOpt =
String -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption
(String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" [String]
hdr)
( String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"version"
Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'V'
Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. String -> Mod f a
help String
"Show version"
Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields (a -> a)
forall (f :: * -> *) a. Mod f a
hidden
)
elynxFooter :: [Doc]
=
[ String -> Doc
text String
"ELynx",
String -> Doc
text String
"-----",
String -> Doc
fillParagraph
String
"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 (String -> Doc
text String
"slynx")
Doc -> Doc -> Doc
<+> String -> Doc
text String
"Analyze, modify, and simulate evolutionary sequences.",
Int -> Doc -> Doc
fill Int
9 (String -> Doc
text String
"tlynx")
Doc -> Doc -> Doc
<+> String -> Doc
text String
"Analyze, modify, and simulate phylogenetic trees.",
Int -> Doc -> Doc
fill Int
9 (String -> Doc
text String
"elynx") Doc -> Doc -> Doc
<+> String -> Doc
text String
"Validate and redo past analyses.",
Doc
empty,
String -> Doc
text String
"Get help for sub commands:",
String -> Doc
text String
" slynx examine --help"
]
data Verbosity = Quiet | Warning | Info | Debug
deriving (Int -> Verbosity -> String -> String
[Verbosity] -> String -> String
Verbosity -> String
(Int -> Verbosity -> String -> String)
-> (Verbosity -> String)
-> ([Verbosity] -> String -> String)
-> Show Verbosity
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Verbosity] -> String -> String
$cshowList :: [Verbosity] -> String -> String
show :: Verbosity -> String
$cshow :: Verbosity -> String
showsPrec :: Int -> Verbosity -> String -> String
$cshowsPrec :: Int -> Verbosity -> String -> String
Show, ReadPrec [Verbosity]
ReadPrec Verbosity
Int -> ReadS Verbosity
ReadS [Verbosity]
(Int -> ReadS Verbosity)
-> ReadS [Verbosity]
-> ReadPrec Verbosity
-> ReadPrec [Verbosity]
-> Read Verbosity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Verbosity]
$creadListPrec :: ReadPrec [Verbosity]
readPrec :: ReadPrec Verbosity
$creadPrec :: ReadPrec Verbosity
readList :: ReadS [Verbosity]
$creadList :: ReadS [Verbosity]
readsPrec :: Int -> ReadS Verbosity
$creadsPrec :: Int -> ReadS Verbosity
Read, Verbosity -> Verbosity -> Bool
(Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool) -> Eq Verbosity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Verbosity -> Verbosity -> Bool
$c/= :: Verbosity -> Verbosity -> Bool
== :: Verbosity -> Verbosity -> Bool
$c== :: Verbosity -> Verbosity -> Bool
Eq, Int -> Verbosity
Verbosity -> Int
Verbosity -> [Verbosity]
Verbosity -> Verbosity
Verbosity -> Verbosity -> [Verbosity]
Verbosity -> Verbosity -> Verbosity -> [Verbosity]
(Verbosity -> Verbosity)
-> (Verbosity -> Verbosity)
-> (Int -> Verbosity)
-> (Verbosity -> Int)
-> (Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> Verbosity -> [Verbosity])
-> Enum Verbosity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
$cenumFromThenTo :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
enumFromTo :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromTo :: Verbosity -> Verbosity -> [Verbosity]
enumFromThen :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromThen :: Verbosity -> Verbosity -> [Verbosity]
enumFrom :: Verbosity -> [Verbosity]
$cenumFrom :: Verbosity -> [Verbosity]
fromEnum :: Verbosity -> Int
$cfromEnum :: Verbosity -> Int
toEnum :: Int -> Verbosity
$ctoEnum :: Int -> Verbosity
pred :: Verbosity -> Verbosity
$cpred :: Verbosity -> Verbosity
succ :: Verbosity -> Verbosity
$csucc :: Verbosity -> Verbosity
Enum, Verbosity
Verbosity -> Verbosity -> Bounded Verbosity
forall a. a -> a -> Bounded a
maxBound :: Verbosity
$cmaxBound :: Verbosity
minBound :: Verbosity
$cminBound :: Verbosity
Bounded, Eq Verbosity
Eq Verbosity
-> (Verbosity -> Verbosity -> Ordering)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Verbosity)
-> (Verbosity -> Verbosity -> Verbosity)
-> Ord Verbosity
Verbosity -> Verbosity -> Bool
Verbosity -> Verbosity -> Ordering
Verbosity -> Verbosity -> Verbosity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Verbosity -> Verbosity -> Verbosity
$cmin :: Verbosity -> Verbosity -> Verbosity
max :: Verbosity -> Verbosity -> Verbosity
$cmax :: Verbosity -> Verbosity -> Verbosity
>= :: Verbosity -> Verbosity -> Bool
$c>= :: Verbosity -> Verbosity -> Bool
> :: Verbosity -> Verbosity -> Bool
$c> :: Verbosity -> Verbosity -> Bool
<= :: Verbosity -> Verbosity -> Bool
$c<= :: Verbosity -> Verbosity -> Bool
< :: Verbosity -> Verbosity -> Bool
$c< :: Verbosity -> Verbosity -> Bool
compare :: Verbosity -> Verbosity -> Ordering
$ccompare :: Verbosity -> Verbosity -> Ordering
$cp1Ord :: Eq Verbosity
Ord, (forall x. Verbosity -> Rep Verbosity x)
-> (forall x. Rep Verbosity x -> Verbosity) -> Generic Verbosity
forall x. Rep Verbosity x -> Verbosity
forall x. Verbosity -> Rep Verbosity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Verbosity x -> Verbosity
$cfrom :: forall x. Verbosity -> Rep Verbosity x
Generic)
instance FromJSON Verbosity
instance ToJSON Verbosity
toLogLevel :: Verbosity -> LogLevel
toLogLevel :: Verbosity -> LogLevel
toLogLevel Verbosity
Quiet = LogLevel
LevelError
toLogLevel Verbosity
Warning = LogLevel
LevelWarn
toLogLevel Verbosity
Info = LogLevel
LevelInfo
toLogLevel Verbosity
Debug = LogLevel
LevelDebug
newtype Force = Force Bool
deriving (Force -> Force -> Bool
(Force -> Force -> Bool) -> (Force -> Force -> Bool) -> Eq Force
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Force -> Force -> Bool
$c/= :: Force -> Force -> Bool
== :: Force -> Force -> Bool
$c== :: Force -> Force -> Bool
Eq, Int -> Force -> String -> String
[Force] -> String -> String
Force -> String
(Int -> Force -> String -> String)
-> (Force -> String) -> ([Force] -> String -> String) -> Show Force
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Force] -> String -> String
$cshowList :: [Force] -> String -> String
show :: Force -> String
$cshow :: Force -> String
showsPrec :: Int -> Force -> String -> String
$cshowsPrec :: Int -> Force -> String -> String
Show, (forall x. Force -> Rep Force x)
-> (forall x. Rep Force x -> Force) -> Generic Force
forall x. Rep Force x -> Force
forall x. Force -> Rep Force x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Force x -> Force
$cfrom :: forall x. Force -> Rep Force x
Generic)
instance FromJSON Force
instance ToJSON Force
data GlobalArguments = GlobalArguments
{ GlobalArguments -> Verbosity
verbosity :: Verbosity,
GlobalArguments -> Maybe String
outFileBaseName :: Maybe FilePath,
GlobalArguments -> Force
forceReanalysis :: Force,
GlobalArguments -> Bool
writeElynxFile :: Bool
}
deriving (GlobalArguments -> GlobalArguments -> Bool
(GlobalArguments -> GlobalArguments -> Bool)
-> (GlobalArguments -> GlobalArguments -> Bool)
-> Eq GlobalArguments
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 -> String -> String
[GlobalArguments] -> String -> String
GlobalArguments -> String
(Int -> GlobalArguments -> String -> String)
-> (GlobalArguments -> String)
-> ([GlobalArguments] -> String -> String)
-> Show GlobalArguments
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GlobalArguments] -> String -> String
$cshowList :: [GlobalArguments] -> String -> String
show :: GlobalArguments -> String
$cshow :: GlobalArguments -> String
showsPrec :: Int -> GlobalArguments -> String -> String
$cshowsPrec :: Int -> GlobalArguments -> String -> String
Show, (forall x. GlobalArguments -> Rep GlobalArguments x)
-> (forall x. Rep GlobalArguments x -> GlobalArguments)
-> Generic GlobalArguments
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 String -> Force -> Bool -> GlobalArguments
GlobalArguments (Verbosity -> Maybe String -> Force -> Bool -> GlobalArguments)
-> Parser Verbosity
-> Parser (Maybe String -> Force -> Bool -> GlobalArguments)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Verbosity
verbosityOpt Parser (Maybe String -> Force -> Bool -> GlobalArguments)
-> Parser (Maybe String)
-> Parser (Force -> Bool -> GlobalArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser String
outFileBaseNameOpt Parser (Force -> Bool -> GlobalArguments)
-> Parser Force -> Parser (Bool -> GlobalArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Force
forceOpt Parser (Bool -> GlobalArguments)
-> Parser Bool -> Parser GlobalArguments
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
writeELynxOpt
verbosityOpt :: Parser Verbosity
verbosityOpt :: Parser Verbosity
verbosityOpt =
ReadM Verbosity -> Mod OptionFields Verbosity -> Parser Verbosity
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
ReadM Verbosity
forall a. Read a => ReadM a
auto
( String -> Mod OptionFields Verbosity
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"verbosity"
Mod OptionFields Verbosity
-> Mod OptionFields Verbosity -> Mod OptionFields Verbosity
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Verbosity
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v'
Mod OptionFields Verbosity
-> Mod OptionFields Verbosity -> Mod OptionFields Verbosity
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Verbosity
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"VALUE"
Mod OptionFields Verbosity
-> Mod OptionFields Verbosity -> Mod OptionFields Verbosity
forall a. Semigroup a => a -> a -> a
<> Verbosity -> Mod OptionFields Verbosity
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Verbosity
Info
Mod OptionFields Verbosity
-> Mod OptionFields Verbosity -> Mod OptionFields Verbosity
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Verbosity
forall a (f :: * -> *). Show a => Mod f a
showDefault
Mod OptionFields Verbosity
-> Mod OptionFields Verbosity -> Mod OptionFields Verbosity
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Verbosity
forall (f :: * -> *) a. String -> Mod f a
help (String
"Be verbose; one of: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords ((Verbosity -> String) -> [Verbosity] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Verbosity -> String
forall a. Show a => a -> String
show [Verbosity]
vs))
)
where
vs :: [Verbosity]
vs = [Verbosity]
forall a. (Bounded a, Enum a) => [a]
allValues :: [Verbosity]
outFileBaseNameOpt :: Parser FilePath
outFileBaseNameOpt :: Parser String
outFileBaseNameOpt =
Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"output-file-basename" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'o' Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NAME"
Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help
String
"Specify base name of output file"
)
forceOpt :: Parser Force
forceOpt :: Parser Force
forceOpt =
Force -> Force -> Mod FlagFields Force -> Parser Force
forall a. a -> a -> Mod FlagFields a -> Parser a
flag
(Bool -> Force
Force Bool
False)
(Bool -> Force
Force Bool
True)
( String -> Mod FlagFields Force
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"force" Mod FlagFields Force
-> Mod FlagFields Force -> Mod FlagFields Force
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Force
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f'
Mod FlagFields Force
-> Mod FlagFields Force -> Mod FlagFields Force
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Force
forall (f :: * -> *) a. String -> Mod f a
help
String
"Ignore previous analysis and overwrite existing output files."
)
writeELynxOpt :: Parser Bool
writeELynxOpt :: Parser Bool
writeELynxOpt = Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
True Bool
False ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-elynx-file"
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Do not write data required to reproduce an analysis." )
data Seed = Random | Fixed (Vector Word32)
deriving (Int -> Seed -> String -> String
[Seed] -> String -> String
Seed -> String
(Int -> Seed -> String -> String)
-> (Seed -> String) -> ([Seed] -> String -> String) -> Show Seed
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Seed] -> String -> String
$cshowList :: [Seed] -> String -> String
show :: Seed -> String
$cshow :: Seed -> String
showsPrec :: Int -> Seed -> String -> String
$cshowsPrec :: Int -> Seed -> String -> String
Show, (forall x. Seed -> Rep Seed x)
-> (forall x. Rep Seed x -> Seed) -> Generic Seed
forall x. Rep Seed x -> Seed
forall x. Seed -> Rep Seed x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Seed x -> Seed
$cfrom :: forall x. Seed -> Rep Seed x
Generic)
instance Eq Seed where
Seed
Random == :: Seed -> Seed -> Bool
== Seed
_ = Bool
True
Seed
_ == Seed
Random = Bool
True
Fixed Vector Word32
s == Fixed Vector Word32
t = Vector Word32
s Vector Word32 -> Vector Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Vector Word32
t
instance FromJSON Seed
instance ToJSON Seed
seedOpt :: Parser Seed
seedOpt :: Parser Seed
seedOpt = Maybe (Vector Word32) -> Seed
toSeed (Maybe (Vector Word32) -> Seed)
-> Parser (Maybe (Vector Word32)) -> Parser Seed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe (Vector Word32))
seedPar
toSeed :: Maybe (Vector Word32) -> Seed
toSeed :: Maybe (Vector Word32) -> Seed
toSeed Maybe (Vector Word32)
Nothing = Seed
Random
toSeed (Just Vector Word32
w) = Vector Word32 -> Seed
Fixed Vector Word32
w
seedPar :: Parser (Maybe (Vector Word32))
seedPar :: Parser (Maybe (Vector Word32))
seedPar =
Parser (Vector Word32) -> Parser (Maybe (Vector Word32))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser (Vector Word32) -> Parser (Maybe (Vector Word32)))
-> Parser (Vector Word32) -> Parser (Maybe (Vector Word32))
forall a b. (a -> b) -> a -> b
$
ReadM (Vector Word32)
-> Mod OptionFields (Vector Word32) -> Parser (Vector Word32)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
ReadM (Vector Word32)
forall a. Read a => ReadM a
auto
( String -> Mod OptionFields (Vector Word32)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"seed" Mod OptionFields (Vector Word32)
-> Mod OptionFields (Vector Word32)
-> Mod OptionFields (Vector Word32)
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields (Vector Word32)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'S' Mod OptionFields (Vector Word32)
-> Mod OptionFields (Vector Word32)
-> Mod OptionFields (Vector Word32)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Vector Word32)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"[INT]"
Mod OptionFields (Vector Word32)
-> Mod OptionFields (Vector Word32)
-> Mod OptionFields (Vector Word32)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Vector Word32)
forall (f :: * -> *) a. String -> Mod f a
help
( String
"Seed for random number generator; "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"list of 32 bit integers with up to 256 elements (default: random)"
)
)
data Arguments a = Arguments
{ Arguments a -> GlobalArguments
global :: GlobalArguments,
Arguments a -> a
local :: a
}
deriving (Arguments a -> Arguments a -> Bool
(Arguments a -> Arguments a -> Bool)
-> (Arguments a -> Arguments a -> Bool) -> Eq (Arguments a)
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 -> String -> String
[Arguments a] -> String -> String
Arguments a -> String
(Int -> Arguments a -> String -> String)
-> (Arguments a -> String)
-> ([Arguments a] -> String -> String)
-> Show (Arguments a)
forall a. Show a => Int -> Arguments a -> String -> String
forall a. Show a => [Arguments a] -> String -> String
forall a. Show a => Arguments a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Arguments a] -> String -> String
$cshowList :: forall a. Show a => [Arguments a] -> String -> String
show :: Arguments a -> String
$cshow :: forall a. Show a => Arguments a -> String
showsPrec :: Int -> Arguments a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> Arguments a -> String -> String
Show, (forall x. Arguments a -> Rep (Arguments a) x)
-> (forall x. Rep (Arguments a) x -> Arguments a)
-> Generic (Arguments a)
forall x. Rep (Arguments a) x -> Arguments a
forall x. Arguments a -> Rep (Arguments a) x
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 -> [String]
inFiles = a -> [String]
forall a. Reproducible a => a -> [String]
inFiles (a -> [String]) -> (Arguments a -> a) -> Arguments a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arguments a -> a
forall a. Arguments a -> a
local
outSuffixes :: Arguments a -> [String]
outSuffixes = a -> [String]
forall a. Reproducible a => a -> [String]
outSuffixes (a -> [String]) -> (Arguments a -> a) -> Arguments a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arguments a -> a
forall a. Arguments a -> a
local
getSeed :: Arguments a -> Maybe Seed
getSeed = a -> Maybe Seed
forall a. Reproducible a => a -> Maybe Seed
getSeed (a -> Maybe Seed)
-> (Arguments a -> a) -> Arguments a -> Maybe Seed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arguments a -> a
forall a. Arguments a -> a
local
setSeed :: Arguments a -> Vector Word32 -> Arguments a
setSeed (Arguments GlobalArguments
g a
l) Vector Word32
s = GlobalArguments -> a -> Arguments a
forall a. GlobalArguments -> a -> Arguments a
Arguments GlobalArguments
g (a -> Arguments a) -> a -> Arguments a
forall a b. (a -> b) -> a -> b
$ a -> Vector Word32 -> a
forall a. Reproducible a => a -> Vector Word32 -> a
setSeed a
l Vector Word32
s
parser :: Parser (Arguments a)
parser = Parser a -> Parser (Arguments a)
forall a. Parser a -> Parser (Arguments a)
argumentsParser (Reproducible a => Parser a
forall a. Reproducible a => Parser a
parser @a)
cmdName :: String
cmdName = Reproducible a => String
forall a. Reproducible a => String
cmdName @a
cmdDsc :: [String]
cmdDsc = Reproducible a => [String]
forall a. Reproducible a => [String]
cmdDsc @a
cmdFtr :: [String]
cmdFtr = Reproducible a => [String]
forall a. Reproducible a => [String]
cmdFtr @a
argumentsParser :: Parser a -> Parser (Arguments a)
argumentsParser :: Parser a -> Parser (Arguments a)
argumentsParser Parser a
p = GlobalArguments -> a -> Arguments a
forall a. GlobalArguments -> a -> Arguments a
Arguments (GlobalArguments -> a -> Arguments a)
-> Parser GlobalArguments -> Parser (a -> Arguments a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GlobalArguments
globalArguments Parser (a -> Arguments a) -> Parser a -> Parser (Arguments a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
p
elynxParser :: Parser a -> Parser a
elynxParser :: Parser a -> Parser a
elynxParser Parser a
p = Parser ((a -> a) -> a -> a)
forall a. Parser (a -> a)
helper Parser ((a -> a) -> a -> a) -> Parser (a -> a) -> Parser (a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (a -> a)
forall a. Parser (a -> a)
versionOpt Parser (a -> a) -> Parser a -> Parser a
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 :: IO (Arguments a)
parseArguments =
ParserInfo (Arguments a) -> IO (Arguments a)
forall a. ParserInfo a -> IO a
execParser (ParserInfo (Arguments a) -> IO (Arguments a))
-> ParserInfo (Arguments a) -> IO (Arguments a)
forall a b. (a -> b) -> a -> b
$
[String]
-> [String] -> Parser (Arguments a) -> ParserInfo (Arguments a)
forall a. [String] -> [String] -> Parser a -> ParserInfo a
elynxParserInfo (Reproducible a => [String]
forall a. Reproducible a => [String]
cmdDsc @a) (Reproducible a => [String]
forall a. Reproducible a => [String]
cmdFtr @a) (Parser a -> Parser (Arguments a)
forall a. Parser a -> Parser (Arguments a)
argumentsParser (Parser a -> Parser (Arguments a))
-> Parser a -> Parser (Arguments a)
forall a b. (a -> b) -> a -> b
$ Reproducible a => Parser a
forall a. Reproducible a => Parser a
parser @a)
type ELynx a = ReaderT (Arguments a) (LoggingT IO)
class Reproducible a where
inFiles :: a -> [FilePath]
outSuffixes :: a -> [String]
getSeed :: a -> Maybe Seed
setSeed :: a -> Vector Word32 -> a
parser :: Parser a
cmdName :: String
cmdDsc :: [String]
cmdFtr :: [String]
cmdFtr = []
getReproductionHash :: forall a. Reproducible a => Reproduction a -> String
getReproductionHash :: Reproduction a -> String
getReproductionHash Reproduction a
r =
ByteString -> String
BS.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$
ByteString -> ByteString
encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
ByteString -> ByteString
hash (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
String -> ByteString
BS.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$
[String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
Reproduction a -> String
forall a. Reproduction a -> String
progName Reproduction a
r String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
Reproduction a -> [String]
forall a. Reproduction a -> [String]
argsStr Reproduction a
r
[String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [Version -> String
showVersion (Reproduction a -> Version
forall a. Reproduction a -> Version
rVersion Reproduction a
r)]
[String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> Reproduction a -> [String]
forall a. Reproduction a -> [String]
files Reproduction a
r
[String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> Reproduction a -> [String]
forall a. Reproduction a -> [String]
checkSums Reproduction a
r
[String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> a -> [String]
forall a. Reproducible a => a -> [String]
inFiles a
ri
[String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> a -> [String]
forall a. Reproducible a => a -> [String]
outSuffixes a
ri
[String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [Reproducible a => String
forall a. Reproducible a => String
cmdName @a]
[String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> Reproducible a => [String]
forall a. Reproducible a => [String]
cmdDsc @a
[String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> Reproducible a => [String]
forall a. Reproducible a => [String]
cmdFtr @a
where
ri :: a
ri = Reproduction a -> a
forall a. Reproduction a -> a
reproducible Reproduction a
r
setHash :: Reproducible a => Reproduction a -> Reproduction a
setHash :: Reproduction a -> Reproduction a
setHash Reproduction a
r = Reproduction a
r {rHash :: Maybe String
rHash = String -> Maybe String
forall a. a -> Maybe a
Just String
h} where h :: String
h = Reproduction a -> String
forall a. Reproducible a => Reproduction a -> String
getReproductionHash Reproduction a
r
data Reproduction a = Reproduction
{
Reproduction a -> String
progName :: String,
Reproduction a -> [String]
argsStr :: [String],
Reproduction a -> Version
rVersion :: Version,
Reproduction a -> Maybe String
rHash :: Maybe String,
Reproduction a -> [String]
files :: [FilePath],
Reproduction a -> [String]
checkSums :: [String],
Reproduction a -> a
reproducible :: a
}
deriving ((forall x. Reproduction a -> Rep (Reproduction a) x)
-> (forall x. Rep (Reproduction a) x -> Reproduction a)
-> Generic (Reproduction a)
forall x. Rep (Reproduction a) x -> Reproduction a
forall x. Reproduction a -> Rep (Reproduction a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Reproduction a) x -> Reproduction a
forall a x. Reproduction a -> Rep (Reproduction a) x
$cto :: forall a x. Rep (Reproduction a) x -> Reproduction a
$cfrom :: forall a x. Reproduction a -> Rep (Reproduction a) x
Generic)
instance FromJSON a => FromJSON (Reproduction a)
instance ToJSON a => ToJSON (Reproduction a)
hashFile :: FilePath -> IO BS.ByteString
hashFile :: String -> IO ByteString
hashFile String
f = ByteString -> ByteString
encode (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
hash (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BS.readFile String
f
writeReproduction ::
forall a.
(Eq a, Show a, Reproducible a, ToJSON a) =>
String ->
a ->
IO ()
writeReproduction :: String -> a -> IO ()
writeReproduction String
bn a
r = do
String
pn <- IO String
getProgName
[String]
as <- IO [String]
getArgs
let outFs :: [String]
outFs = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
bn String -> String -> String
forall a. [a] -> [a] -> [a]
++) (a -> [String]
forall a. Reproducible a => a -> [String]
outSuffixes a
r)
let fs :: [String]
fs = a -> [String]
forall a. Reproducible a => a -> [String]
inFiles a
r [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
outFs
[ByteString]
cs <- (String -> IO ByteString) -> [String] -> IO [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO ByteString
hashFile [String]
fs
let cs' :: [String]
cs' = (ByteString -> String) -> [ByteString] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> String
BS.unpack [ByteString]
cs
s :: Reproduction a
s = String
-> [String]
-> Version
-> Maybe String
-> [String]
-> [String]
-> a
-> Reproduction a
forall a.
String
-> [String]
-> Version
-> Maybe String
-> [String]
-> [String]
-> a
-> Reproduction a
Reproduction String
pn [String]
as Version
version Maybe String
forall a. Maybe a
Nothing [String]
fs [String]
cs' a
r
IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Reproduction a -> IO ()
forall a. ToJSON a => String -> a -> IO ()
encodeFile (String
bn String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".elynx") (Reproduction a -> Reproduction a
forall a. Reproducible a => Reproduction a -> Reproduction a
setHash Reproduction a
s)
createCommandReproducible ::
forall a b. Reproducible a => (a -> b) -> Mod CommandFields b
createCommandReproducible :: (a -> b) -> Mod CommandFields b
createCommandReproducible a -> b
f =
String -> ParserInfo b -> Mod CommandFields b
forall a. String -> ParserInfo a -> Mod CommandFields a
command (Reproducible a => String
forall a. Reproducible a => String
cmdName @a) (ParserInfo b -> Mod CommandFields b)
-> ParserInfo b -> Mod CommandFields b
forall a b. (a -> b) -> a -> b
$
a -> b
f
(a -> b) -> ParserInfo a -> ParserInfo b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Doc -> Maybe Doc -> Parser a -> ParserInfo a
forall a. Maybe Doc -> Maybe Doc -> Parser a -> ParserInfo a
parserInfo
Maybe Doc
dsc'
Maybe Doc
ftr'
(Reproducible a => Parser a
forall a. Reproducible a => Parser a
parser @a)
where
dsc :: [String]
dsc = Reproducible a => [String]
forall a. Reproducible a => [String]
cmdDsc @a
ftr :: [String]
ftr = Reproducible a => [String]
forall a. Reproducible a => [String]
cmdFtr @a
dsc' :: Maybe Doc
dsc' = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
dsc then Maybe Doc
forall a. Maybe a
Nothing else Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
forall a. Pretty a => a -> Doc
pretty [String]
dsc
ftr' :: Maybe Doc
ftr' = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ftr then Maybe Doc
forall a. Maybe a
Nothing else Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
forall a. Pretty a => a -> Doc
pretty [String]
ftr
createCommand ::
String ->
[String] ->
[String] ->
Parser a ->
(a -> b) ->
Mod CommandFields b
createCommand :: String
-> [String]
-> [String]
-> Parser a
-> (a -> b)
-> Mod CommandFields b
createCommand String
nm [String]
dsc [String]
ftr Parser a
p a -> b
f = String -> ParserInfo b -> Mod CommandFields b
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
nm (ParserInfo b -> Mod CommandFields b)
-> ParserInfo b -> Mod CommandFields b
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> ParserInfo a -> ParserInfo b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Doc -> Maybe Doc -> Parser a -> ParserInfo a
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 [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
dsc then Maybe Doc
forall a. Maybe a
Nothing else Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
forall a. Pretty a => a -> Doc
pretty [String]
dsc
ftr' :: Maybe Doc
ftr' = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ftr then Maybe Doc
forall a. Maybe a
Nothing else Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
forall a. Pretty a => a -> Doc
pretty [String]
ftr
elynxParserInfo :: [String] -> [String] -> Parser a -> ParserInfo a
elynxParserInfo :: [String] -> [String] -> Parser a -> ParserInfo a
elynxParserInfo [String]
dsc [String]
ftr = Maybe Doc -> Maybe Doc -> Parser a -> ParserInfo a
forall a. Maybe Doc -> Maybe Doc -> Parser a -> ParserInfo a
parserInfo Maybe Doc
dsc' Maybe Doc
ftr'
where
dsc' :: Maybe Doc
dsc' = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
dsc then Maybe Doc
forall a. Maybe a
Nothing else Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
forall a. Pretty a => a -> Doc
pretty [String]
dsc
ftr' :: Maybe Doc
ftr' = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> ([Doc] -> Doc) -> [Doc] -> Maybe Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vsep ([Doc] -> Maybe Doc) -> [Doc] -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
forall a. Pretty a => a -> Doc
pretty [String]
ftr [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
elynxFooter
parserInfo :: Maybe Doc -> Maybe Doc -> Parser a -> ParserInfo a
parserInfo :: Maybe Doc -> Maybe Doc -> Parser a -> ParserInfo a
parserInfo Maybe Doc
dsc Maybe Doc
ftr Parser a
p =
Parser a -> InfoMod a -> ParserInfo a
forall a. Parser a -> InfoMod a -> ParserInfo a
info
(Parser a -> Parser a
forall a. Parser a -> Parser a
elynxParser Parser a
p)
(InfoMod a
forall a. InfoMod a
fullDesc InfoMod a -> InfoMod a -> InfoMod a
forall a. Semigroup a => a -> a -> a
<> Maybe Doc -> InfoMod a
forall a. Maybe Doc -> InfoMod a
headerDoc (Doc -> Maybe Doc
forall a. a -> Maybe a
Just Doc
hdr') InfoMod a -> InfoMod a -> InfoMod a
forall a. Semigroup a => a -> a -> a
<> Maybe Doc -> InfoMod a
forall a. Maybe Doc -> InfoMod a
progDescDoc Maybe Doc
dsc InfoMod a -> InfoMod a -> InfoMod a
forall a. Semigroup a => a -> a -> a
<> Maybe Doc -> InfoMod a
forall a. Maybe Doc -> InfoMod a
footerDoc Maybe Doc
ftr)
where
hdr' :: Doc
hdr' = [Doc] -> Doc
vsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
forall a. Pretty a => a -> Doc
pretty [String]
hdr
fillParagraph :: String -> Doc
fillParagraph :: String -> Doc
fillParagraph = [Doc] -> Doc
fillSep ([Doc] -> Doc) -> (String -> [Doc]) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text ([String] -> [Doc]) -> (String -> [String]) -> String -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words