{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      :  ELynx.Tools.Reproduction
-- Description :  Functions to ease reproduction of analyses
-- Copyright   :  (c) Dominik Schrempf 2021
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  dominik.schrempf@gmail.com
-- Stability   :  unstable
-- Portability :  portable
--
-- Creation date: Tue Nov 19 15:07:09 2019.
--
-- Use of standard input is not supported.
module ELynx.Tools.Reproduction
  ( -- * Log file
    logHeader,
    logFooter,

    -- * Options
    Verbosity (..),
    toLogLevel,
    Force (..),
    forceOpt,
    GlobalArguments (..),
    globalArguments,
    Seed (..),
    seedOpt,
    Arguments (..),
    parseArguments,

    -- * Reproduction
    ELynx,
    Reproducible (..),
    getReproductionHash,
    Reproduction (..),
    writeReproduction,
    hashFile,

    -- * Misc
    createCommandReproducible,
    createCommand,
    elynxParserInfo,

    -- * Re-exports
    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

-- Be careful; it is necessary to synchronize the version numbers across packages.
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
              )
        )

-- A short header to be used in executables. 'unlines' doesn't work here because
-- it adds an additional newline at the end.
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

-- | Short, globally usable string preceding all logs with obligatory description.
logHeader :: String -> [String] -> IO String
logHeader :: String -> [String] -> IO String
logHeader 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]

-- | See 'logHeader' but footer.
logFooter :: IO String
logFooter :: IO String
logFooter = 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"
        -- Lower case 'v' clashes with verbosity.
        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]
elynxFooter :: [Doc]
elynxFooter =
  [ 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"
  ]

-- | Verbosity levels.
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

-- | Conert verbosity option to log level.
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

-- | Exit when output exists, or overwrite.
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

-- | A set of global arguments used by all programs. The idea is to provide a
-- common framework for shared arguments.
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

-- | See 'GlobalArguments', parser function.
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

-- | Boolean option; be verbose; default NO.
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]

-- | Output filename.
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"
    )

-- | Force option parser.
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)
    -- DO NOT CHANGE --force nor -f; they are used by 'elynx redo'.
    ( 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." )

-- | Random or fixed seed.
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)

-- | Upon equality check, a random seed is not different from a fixed one.
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

-- | Seed option for MWC. Defaults to Random.
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)"
            )
      )

-- | Argument skeleton to be used with all commands.
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

-- | Parse arguments. Provide a global description, header, footer, and so on.
-- Custom additional description (first argument) and footer (second argument)
-- can be provided. print help if needed.
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)

-- | Logging transformer to be used with all executables.
type ELynx a = ReaderT (Arguments a) (LoggingT IO)

-- | Reproducible commands have
--   - a set of input files to be checked for consistency,
--   - a set of output suffixes which define output files to be checked for consistency,
--   - a function to get the seed, if available,
--   - a function to set the seed, if applicable,
--   - a parser to read the command line,
--   - a nice program name, description, and footer.
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 = []

-- | A unique hash of the reproduction data type.
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.
            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
              -- Reproducible.
              [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

-- | Necessary information for a reproducible run. Notably, the input files are
-- checked for consistency!
data Reproduction a = Reproduction
  { -- | Program name.
    Reproduction a -> String
progName :: String,
    -- | Command line arguments without program name.
    Reproduction a -> [String]
argsStr :: [String],
    Reproduction a -> Version
rVersion :: Version,
    -- | Unique hash; see 'getReproductionHash'.
    Reproduction a -> Maybe String
rHash :: Maybe String,
    -- | File paths of used files.
    Reproduction a -> [String]
files :: [FilePath],
    -- | SHA256 sums of used files.
    Reproduction a -> [String]
checkSums :: [String],
    -- | Command argument.
    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)

-- | Helper function.
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

-- | Write an ELynx reproduction file.
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)

-- | Create a command; convenience function.
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

-- | Create a command; convenience function.
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

-- | ELynx parser info; convenience function.
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

-- Short version of ELynx parser info for sub commands.
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

-- | Fill a string so that it becomes a paragraph with line breaks. Useful for
-- descriptions, headers and footers.
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