elynx-tools 0.5.1.1 → 0.6.0.0

raw patch · 11 files changed

+786/−990 lines, 11 filesdep −deepseqdep −monad-controldep −monad-loggerdep ~aesondep ~attoparsecdep ~base16-bytestringPVP ok

version bump matches the API change (PVP)

Dependencies removed: deepseq, monad-control, monad-logger, transformers-base

Dependency ranges changed: aeson, attoparsec, base16-bytestring, bytestring, cryptohash-sha256, directory, hmatrix, mwc-random, optparse-applicative, primitive, template-haskell, text, time, transformers, vector, zlib

API changes (from Hackage documentation)

Files

• ChangeLog.md +10/−0
• README.md +27/−412
• elynx-tools.cabal +57/−59
• src/ELynx/Tools.hs +6/−2
• src/ELynx/Tools/ELynx.hs +142/−0
• src/ELynx/Tools/Environment.hs +78/−0
• src/ELynx/Tools/InputOutput.hs +28/−79
• src/ELynx/Tools/Logger.hs +185/−95
• src/ELynx/Tools/Options.hs +243/−0
• src/ELynx/Tools/Reproduction.hs +10/−309
• src/ELynx/Tools/Text.hs +0/−34

@@ -5,6 +5,16 @@ ## Unreleased changes  +## Version 0.6.0.0++-   **elynx-tree:** remove parallel folds with layers (`parBranchFoldMapWithLayer`+    too special and slow).+-   **elynx-tree:** fix various tree instances; add zip trees with appropriate+    instances.+-   Remove `monad-logger` dependency and implement lighter alternative.+-   Significant changes to the tool chain.++ ## Version 0.5.1.0  -   **elynx-tree:** new functions `isValidPath`, `isLeaf`, `depth`; add conversion

@@ -2,7 +2,7 @@  # The ELynx Suite -Version: 0.5.1.0.+Version: 0.6.0.0. Reproducible evolution made easy.  <p align="center"><img src="https://travis-ci.org/dschrempf/elynx.svg?branch=master"/></p>@@ -39,7 +39,7 @@  # Installation -ELynx is written in [Haskell](https://www.haskell.org/) and can be installed with [Stack](https://docs.haskellstack.org/en/stable/README/).+ELynx is written in [Haskell](https://www.haskell.org/) and can be installed with [cabal-install](https://cabal.readthedocs.io/en/3.4/cabal-commands.html) or [Stack](https://docs.haskellstack.org/en/stable/README/).  1.  Install Stack with your package manager, or directly from the web     page.@@ -67,15 +67,15 @@     [PATH](https://en.wikipedia.org/wiki/PATH_(variable)) environment variable. Then, they can be used directly.  -# SLynx+# Get help -Handle evolutionary sequences.+For example: -    stack exec slynx -- --help | head -n -16+    slynx --help -    ELynx Suite version 0.5.1.0.+    ELynx Suite version 0.6.0.0.     Developed by Dominik Schrempf.-    Compiled on June 12, 2021, at 14:54 pm, UTC.+    Compiled on September 3, 2021, at 20:56 pm, UTC.          Usage: slynx [-v|--verbosity VALUE] [-o|--output-file-basename NAME]                   [-f|--force] [--no-elynx-file] COMMAND@@ -84,7 +84,7 @@     Available options:       -h,--help                Show this help text       -V,--version             Show version-      -v,--verbosity VALUE     Be verbose; one of: Quiet Warning Info Debug+      -v,--verbosity VALUE     Be verbose; one of: Quiet Warn Info Debug                                (default: Info)       -o,--output-file-basename NAME                                Specify base name of output file@@ -112,107 +112,33 @@       - Protein (amino acids)       - ProteinX (amino acids; including gaps)       - ProteinS (amino acids; including gaps, and translation stops)---## Concatenate--Concatenate multi sequence alignments.--    stack exec slynx -- concatenate --help--    ELynx Suite version 0.5.1.0.-    Developed by Dominik Schrempf.-    Compiled on June 12, 2021, at 14:54 pm, UTC.-    -    Usage: slynx concatenate (-a|--alphabet NAME) INPUT-FILE-      Concatenate sequences found in input files.-    -    Available options:-      -h,--help                Show this help text-      -V,--version             Show version-      -a,--alphabet NAME       Specify alphabet type NAME-      INPUT-FILE               Read sequences from INPUT-FILE-      -h,--help                Show this help text---## Examine--Examine sequence with `slynx examine`.--    stack exec slynx -- examine --help--    ELynx Suite version 0.5.1.0.-    Developed by Dominik Schrempf.-    Compiled on June 12, 2021, at 14:54 pm, UTC.-    -    Usage: slynx examine (-a|--alphabet NAME) INPUT-FILE [--per-site]-      Examine sequences. If data is a multi sequence alignment, additionally analyze columns.-    -    Available options:-      -h,--help                Show this help text-      -V,--version             Show version-      -a,--alphabet NAME       Specify alphabet type NAME-      INPUT-FILE               Read sequences from INPUT-FILE-      --per-site               Report per site summary statistics-      -h,--help                Show this help text---## Filter--Filter sequences with `filer-rows`.--    stack exec slynx -- filter-rows --help--    ELynx Suite version 0.5.1.0.-    Developed by Dominik Schrempf.-    Compiled on June 12, 2021, at 14:54 pm, UTC.-    -    Usage: slynx filter-rows (-a|--alphabet NAME) INPUT-FILE [--longer-than LENGTH] -                             [--shorter-than LENGTH] [--standard-characters]-      Filter rows (or sequences) found in input files.-    -    Available options:-      -h,--help                Show this help text-      -V,--version             Show version-      -a,--alphabet NAME       Specify alphabet type NAME-      INPUT-FILE               Read sequences from INPUT-FILE-      --longer-than LENGTH     Only keep sequences longer than LENGTH-      --shorter-than LENGTH    Only keep sequences shorter than LENGTH-      --standard-characters    Only keep sequences containing at least one standard-                               (i.e., non-IUPAC) character-      -h,--help                Show this help text--Filter columns of multi sequence alignments with `filter-columns`.--    stack exec slynx -- filter-columns --help--    ELynx Suite version 0.5.1.0.-    Developed by Dominik Schrempf.-    Compiled on June 12, 2021, at 14:54 pm, UTC.+      - ProteinI (amino acids; including gaps, translation stops, and IUPAC codes)+    ELynx+    -----+    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.     -    Usage: slynx filter-columns (-a|--alphabet NAME) INPUT-FILE -                                [--standard-chars DOUBLE]-      Filter columns of multi sequence alignments.+    slynx     Analyze, modify, and simulate evolutionary sequences.+    tlynx     Analyze, modify, and simulate phylogenetic trees.+    elynx     Validate and redo past analyses.     -    Available options:-      -h,--help                Show this help text-      -V,--version             Show version-      -a,--alphabet NAME       Specify alphabet type NAME-      INPUT-FILE               Read sequences from INPUT-FILE-      --standard-chars DOUBLE  Keep columns with a proportion standard (non-IUPAC)-                               characters larger than DOUBLE in [0,1]-      -h,--help                Show this help text+    Get help for sub commands:+      slynx examine --help  -## Simulate+## Sub command -Simulate sequences with `slynx simulate`.+The documentation of sub commands can be accessed separately: -    stack exec slynx -- simulate --help+    slynx simulate --help -    ELynx Suite version 0.5.1.0.+    ELynx Suite version 0.6.0.0.     Developed by Dominik Schrempf.-    Compiled on June 12, 2021, at 14:54 pm, UTC.+    Compiled on September 3, 2021, at 20:56 pm, UTC.          Usage: slynx simulate (-t|--tree-file Name) [-s|--substitution-model MODEL]                            [-m|--mixture-model MODEL] [-e|--edm-file NAME] @@ -281,315 +207,4 @@          LG exchangeabilities with site profiles (Phylobayes) given in FILES.          -m "EDM(LG-Custom)" -p FILES     For special mixture models, mixture weights are optional.---## Sub-sample--Sub-sample columns from multi sequence alignments.--    stack exec slynx -- sub-sample --help--    ELynx Suite version 0.5.1.0.-    Developed by Dominik Schrempf.-    Compiled on June 12, 2021, at 14:54 pm, UTC.-    -    Usage: slynx sub-sample (-a|--alphabet NAME) INPUT-FILE-                            (-n|--number-of-sites INT)-                            (-m|--number-of-alignments INT) [-S|--seed [INT]]-      Sub-sample columns from multi sequence alignments.-    -    Available options:-      -h,--help                Show this help text-      -V,--version             Show version-      -a,--alphabet NAME       Specify alphabet type NAME-      INPUT-FILE               Read sequences from INPUT-FILE-      -n,--number-of-sites INT Number of sites randomly drawn with replacement-      -m,--number-of-alignments INT-                               Number of multi sequence alignments to be created-      -S,--seed [INT]          Seed for random number generator; list of 32 bit-                               integers with up to 256 elements (default: random)-      -h,--help                Show this help text-    -    Create a given number of multi sequence alignments, each of which contains a given number of random sites drawn from the original multi sequence alignment.---## Translate--Translate sequences.--    stack exec slynx -- translate --help--    ELynx Suite version 0.5.1.0.-    Developed by Dominik Schrempf.-    Compiled on June 12, 2021, at 14:54 pm, UTC.-    -    Usage: slynx translate (-a|--alphabet NAME) INPUT-FILE (-r|--reading-frame INT)-                           (-u|--universal-code CODE)-      Translate from DNA to Protein or DNAX to ProteinX.-    -    Available options:-      -h,--help                Show this help text-      -V,--version             Show version-      -a,--alphabet NAME       Specify alphabet type NAME-      INPUT-FILE               Read sequences from INPUT-FILE-      -r,--reading-frame INT   Reading frame [0|1|2].-      -u,--universal-code CODE universal code; one of: Standard,-                               VertebrateMitochondrial.-      -h,--help                Show this help text---# TLynx--Handle phylogenetic trees in Newick format.--    stack exec tlynx -- --help | head -n -16--    ELynx Suite version 0.5.1.0.-    Developed by Dominik Schrempf.-    Compiled on June 12, 2021, at 14:54 pm, UTC.-    -    Usage: tlynx [-v|--verbosity VALUE] [-o|--output-file-basename NAME] -                 [-f|--force] [--no-elynx-file] COMMAND-      Compare, examine, and simulate phylogenetic trees.-    -    Available options:-      -h,--help                Show this help text-      -V,--version             Show version-      -v,--verbosity VALUE     Be verbose; one of: Quiet Warning Info Debug-                               (default: Info)-      -o,--output-file-basename NAME-                               Specify base name of output file-      -f,--force               Ignore previous analysis and overwrite existing-                               output files.-      --no-elynx-file          Do not write data required to reproduce an analysis.-    -    Available commands:-      compare                  Compare two phylogenetic trees (compute distances and branch-wise differences).-      connect                  Connect two phylogenetic trees in all ways (possibly honoring constraints).-      distance                 Compute distances between many phylogenetic trees.-      examine                  Compute summary statistics of phylogenetic trees.-      shuffle                  Shuffle a phylogenetic tree (keep coalescent times, but shuffle topology and leaves).-      simulate                 Simulate phylogenetic trees using a birth and death or coalescent process.-    -    -    Available tree file formats:-      - Newick Standard: Branch support values are stored in square brackets after branch lengths.-      - Newick IqTree:   Branch support values are stored as node names after the closing bracket of forests.-      - Newick RevBayes: Key-value pairs is provided in square brackets after node names as well as branch lengths. XXX: Key value pairs are ignored at the moment.---## Compare--Compute distances between phylogenetic trees.--    stack exec tlynx -- compare --help--    ELynx Suite version 0.5.1.0.-    Developed by Dominik Schrempf.-    Compiled on June 12, 2021, at 14:54 pm, UTC.-    -    Usage: tlynx compare [-n|--normalize] [-b|--bipartitions] [-t|--intersect] -                         [-f|--newick-format FORMAT] NAMES-      Compare two phylogenetic trees (compute distances and branch-wise differences).-    -    Available options:-      -h,--help                Show this help text-      -V,--version             Show version-      -n,--normalize           Normalize trees before comparison-      -b,--bipartitions        Print and plot common and missing bipartitions-      -t,--intersect           Compare intersections; i.e., before comparison, drop-                               leaves that are not present in the other tree-      -f,--newick-format FORMAT-                               Newick tree format: Standard, IqTree, or RevBayes;-                               default: Standard; for detailed help, see 'tlynx-                               --help'-      NAMES                    Tree files-      -h,--help                Show this help text---## Connect--Connect two phylogenetic tree in all ways (possibly honoring constraints).--    stack exec tlynx -- connect --help--    ELynx Suite version 0.5.1.0.-    Developed by Dominik Schrempf.-    Compiled on June 12, 2021, at 14:54 pm, UTC.-    -    Usage: tlynx connect [-f|--newick-format FORMAT] [-c|--contraints CONSTRAINTS]-                         TREE-FILE-A TREE-FILE-B-      Connect two phylogenetic trees in all ways (possibly honoring constraints).-    -    Available options:-      -h,--help                Show this help text-      -V,--version             Show version-      -f,--newick-format FORMAT-                               Newick tree format: Standard, IqTree, or RevBayes;-                               default: Standard; for detailed help, see 'tlynx-                               --help'-      -c,--contraints CONSTRAINTS-                               File containing one or more Newick trees to be used-                               as constraints-      TREE-FILE-A              File containing the first Newick tree-      TREE-FILE-B              File containing the second Newick tree-      -h,--help                Show this help text---## Distancce--Compute distances between many phylogenetic trees.--    stack exec tlynx -- distance --help--    ELynx Suite version 0.5.1.0.-    Developed by Dominik Schrempf.-    Compiled on June 12, 2021, at 14:54 pm, UTC.-    -    Usage: tlynx distance (-d|--distance MEASURE) [-n|--normalize] [-t|--intersect] -                          [-s|--summary-statistics] -                          [-m|--master-tree-file MASTER-TREE-File] -                          [-f|--newick-format FORMAT] [INPUT-FILES]-      Compute distances between many phylogenetic trees.-    -    Available options:-      -h,--help                Show this help text-      -V,--version             Show version-      -d,--distance MEASURE    Type of distance to calculate (available distance-                               measures are listed below)-      -n,--normalize           Normalize trees before distance calculation; only-                               affect distances depending on branch lengths-      -t,--intersect           Compare intersections; i.e., before comparison, drop-                               leaves that are not present in the other tree-      -s,--summary-statistics  Report summary statistics only-      -m,--master-tree-file MASTER-TREE-File-                               Compare all trees to the tree in the master tree-                               file.-      -f,--newick-format FORMAT-                               Newick tree format: Standard, IqTree, or RevBayes;-                               default: Standard; for detailed help, see 'tlynx-                               --help'-      INPUT-FILES              Read tree(s) from INPUT-FILES; if more files are-                               given, one tree is expected per file-      -h,--help                Show this help text-    -    Distance measures:-      symmetric                Symmetric distance (Robinson-Foulds distance).-      incompatible-split[VAL]  Incompatible split distance. Collapse branches with (normalized)-                               support less than 0.0<=VAL<=1.0 before distance calculation;-                               if, let's say, VAL>0.7, only well supported differences contribute-                               to the total distance.-      branch-score             Branch score distance.---## Examine--Compute summary statistics of phylogenetic trees.--    stack exec tlynx -- examine --help--    ELynx Suite version 0.5.1.0.-    Developed by Dominik Schrempf.-    Compiled on June 12, 2021, at 14:54 pm, UTC.-    -    Usage: tlynx examine INPUT-FILE [-f|--newick-format FORMAT]-      Compute summary statistics of phylogenetic trees.-    -    Available options:-      -h,--help                Show this help text-      -V,--version             Show version-      INPUT-FILE               Read trees from INPUT-FILE-      -f,--newick-format FORMAT-                               Newick tree format: Standard, IqTree, or RevBayes;-                               default: Standard; for detailed help, see 'tlynx-                               --help'-      -h,--help                Show this help text---## Shuffle--Shuffle a phylogenetic tree (keep coalescent times, but shuffle topology and-leaves).--    stack exec tlynx -- shuffle --help--    ELynx Suite version 0.5.1.0.-    Developed by Dominik Schrempf.-    Compiled on June 12, 2021, at 14:54 pm, UTC.-    -    Usage: tlynx shuffle [-f|--newick-format FORMAT] [-n|--replicates N] TREE-FILE -                         [-S|--seed [INT]]-      Shuffle a phylogenetic tree (keep coalescent times, but shuffle topology and leaves).-    -    Available options:-      -h,--help                Show this help text-      -V,--version             Show version-      -f,--newick-format FORMAT-                               Newick tree format: Standard, IqTree, or RevBayes;-                               default: Standard; for detailed help, see 'tlynx-                               --help'-      -n,--replicates N        Number of trees to generate-      TREE-FILE                File containing a Newick tree-      -S,--seed [INT]          Seed for random number generator; list of 32 bit-                               integers with up to 256 elements (default: random)-      -h,--help                Show this help text---## Simulate--Simulate phylogenetic trees using birth and death processes.--    stack exec tlynx -- simulate --help--    ELynx Suite version 0.5.1.0.-    Developed by Dominik Schrempf.-    Compiled on June 12, 2021, at 14:54 pm, UTC.-    -    Usage: tlynx simulate (-t|--nTrees INT) (-n|--nLeaves INT) PROCESS -                          [-u|--sub-sample DOUBLE] [-s|--summary-statistics] -                          [-S|--seed [INT]]-      Simulate phylogenetic trees using a birth and death or coalescent process.-    -    Available options:-      -h,--help                Show this help text-      -V,--version             Show version-      -t,--nTrees INT          Number of trees-      -n,--nLeaves INT         Number of leaves per tree-      -u,--sub-sample DOUBLE   Perform sub-sampling; see below.-      -s,--summary-statistics  For each branch, print length and number of children-      -S,--seed [INT]          Seed for random number generator; list of 32 bit-                               integers with up to 256 elements (default: random)-      -h,--help                Show this help text-    -    Available processes:-      birthdeath               Birth and death process-      coalescent               Coalescent process-    -    See, for example, 'tlynx simulate birthdeath --help'.-    Sub-sample with probability p:-      1. Simulate one big tree with n'=round(n/p), n'>=n, leaves;-      2. Randomly sample sub-trees with n leaves.-      (With p=1.0, the same tree is reported over and over again.)---# ELynx--Validate and (optionally) redo past ELynx analyses.--    stack exec elynx -- --help | head -n -16--    ELynx Suite version 0.5.1.0.-    Developed by Dominik Schrempf.-    Compiled on June 12, 2021, at 14:54 pm, UTC.-    -    Usage: elynx COMMAND-      Validate and redo past ELynx analyses-    -    Available options:-      -h,--help                Show this help text-      -V,--version             Show version-    -    Available commands:-      validate                 Validate an ELynx analysis-      redo                     Redo an ELynx analysis 

@@ -1,67 +1,65 @@-cabal-version:      2.2-name:               elynx-tools-version:            0.5.1.1-license:            GPL-3.0-or-later-license-file:       LICENSE-copyright:          Dominik Schrempf (2021)-maintainer:         dominik.schrempf@gmail.com-author:             Dominik Schrempf-homepage:           https://github.com/dschrempf/elynx#readme-bug-reports:        https://github.com/dschrempf/elynx/issues-synopsis:           Tools for ELynx-description:-    Please see the README on GitHub at <https://github.com/dschrempf/elynx>.+cabal-version:  2.2+name:           elynx-tools+version:        0.6.0.0+synopsis:       Tools for ELynx+description:    Please see the README on GitHub at <https://github.com/dschrempf/elynx>.+category:       Bioinformatics+homepage:       https://github.com/dschrempf/elynx#readme+bug-reports:    https://github.com/dschrempf/elynx/issues+author:         Dominik Schrempf+maintainer:     dominik.schrempf@gmail.com+copyright:      Dominik Schrempf (2021)+license:        GPL-3.0-or-later+license-file:   LICENSE+build-type:     Simple -category:           Bioinformatics-build-type:         Simple extra-source-files:     README.md     ChangeLog.md  source-repository head-    type:     git-    location: https://github.com/dschrempf/elynx+  type: git+  location: https://github.com/dschrempf/elynx  library-    exposed-modules:  ELynx.Tools-    hs-source-dirs:   src-    other-modules:-        ELynx.Tools.ByteString-        ELynx.Tools.Concurrent-        ELynx.Tools.Definitions-        ELynx.Tools.Equality-        ELynx.Tools.InputOutput-        ELynx.Tools.LinearAlgebra-        ELynx.Tools.List-        ELynx.Tools.Logger-        ELynx.Tools.Misc-        ELynx.Tools.Numeric-        ELynx.Tools.Reproduction-        ELynx.Tools.Text-        Paths_elynx_tools--    autogen-modules:  Paths_elynx_tools-    default-language: Haskell2010-    ghc-options:      -Wall -Wunused-packages-    build-depends:-        aeson >=1.5.6.0,-        attoparsec >=0.13.2.5,-        base >=4.7 && <5,-        base16-bytestring >=1.0.1.0,-        bytestring >=0.10.12.0,-        cryptohash-sha256 >=0.11.102.0,-        deepseq >=1.4.4.0,-        directory >=1.3.6.0,-        hmatrix >=0.20.2,-        monad-control >=1.0.2.3,-        monad-logger >=0.3.36,-        mwc-random >=0.15.0.1,-        optparse-applicative >=0.16.1.0,-        primitive >=0.7.1.0,-        template-haskell >=2.16.0.0,-        text >=1.2.4.1,-        time >=1.9.3,-        transformers >=0.5.6.2,-        transformers-base >=0.4.5.2,-        vector >=0.12.3.0,-        zlib >=0.6.2.3+  exposed-modules:+      ELynx.Tools+  other-modules:+      ELynx.Tools.ByteString+      ELynx.Tools.Concurrent+      ELynx.Tools.Definitions+      ELynx.Tools.ELynx+      ELynx.Tools.Environment+      ELynx.Tools.Equality+      ELynx.Tools.InputOutput+      ELynx.Tools.LinearAlgebra+      ELynx.Tools.List+      ELynx.Tools.Logger+      ELynx.Tools.Misc+      ELynx.Tools.Numeric+      ELynx.Tools.Options+      ELynx.Tools.Reproduction+      Paths_elynx_tools+  autogen-modules:+      Paths_elynx_tools+  hs-source-dirs: src+  ghc-options: -Wall -Wunused-packages+  build-depends:+      aeson+    , attoparsec+    , base >=4.7 && <5+    , base16-bytestring+    , bytestring+    , cryptohash-sha256+    , directory+    , hmatrix+    , mwc-random+    , optparse-applicative+    , primitive+    , template-haskell+    , text+    , time+    , transformers+    , vector+    , zlib+  default-language: Haskell2010

@@ -15,6 +15,8 @@   ( module ELynx.Tools.ByteString,     module ELynx.Tools.Concurrent,     module ELynx.Tools.Definitions,+    module ELynx.Tools.ELynx,+    module ELynx.Tools.Environment,     module ELynx.Tools.Equality,     module ELynx.Tools.InputOutput,     module ELynx.Tools.LinearAlgebra,@@ -22,14 +24,16 @@     module ELynx.Tools.Logger,     module ELynx.Tools.Misc,     module ELynx.Tools.Numeric,+    module ELynx.Tools.Options,     module ELynx.Tools.Reproduction,-    module ELynx.Tools.Text,   ) where  import ELynx.Tools.ByteString import ELynx.Tools.Concurrent import ELynx.Tools.Definitions+import ELynx.Tools.ELynx+import ELynx.Tools.Environment import ELynx.Tools.Equality import ELynx.Tools.InputOutput import ELynx.Tools.LinearAlgebra@@ -37,5 +41,5 @@ import ELynx.Tools.Logger import ELynx.Tools.Misc import ELynx.Tools.Numeric+import ELynx.Tools.Options import ELynx.Tools.Reproduction-import ELynx.Tools.Text

@@ -0,0 +1,142 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module      :  ELynx.Tools.ELynx+-- Description :  The ELynx transformer+-- Copyright   :  (c) 2021 Dominik Schrempf+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Creation date: Thu Sep  2 18:55:11 2021.+module ELynx.Tools.ELynx+  ( ELynx,+    eLynxWrapper,+    out,+    outHandle,+  )+where++import Control.Monad.IO.Class+import Control.Monad.Trans.Reader hiding (local)+import Data.Aeson+import qualified Data.ByteString.Lazy.Char8 as BL+import ELynx.Tools.Environment+import ELynx.Tools.InputOutput+import ELynx.Tools.Logger+import ELynx.Tools.Options+import ELynx.Tools.Reproduction+import System.IO+import System.Random.MWC++-- | ELynx transformer to be used with all executables.+type ELynx a = ReaderT (Environment a) IO++fixSeed :: Reproducible a => a -> IO a+fixSeed x = case getSeed x of+  (Just RandomUnset) -> do+    g <- createSystemRandom+    s <- fromSeed <$> save g+    return $ setSeed x (RandomSet s)+  _ -> return x++eLynxRun ::+  forall a b.+  (Eq a, Reproducible a, Reproducible b, Show a, ToJSON a) =>+  (b -> a) ->+  ELynx b () ->+  ELynx b ()+eLynxRun f worker = do+  -- Header.+  logInfoHeader (cmdName @b) (cmdDsc @b)+  mso <- reader (getSeed . localArguments)+  case mso of+    Nothing -> return ()+    Just (RandomSet s) -> logInfoS $ "Seed: random; set to " <> show s <> "."+    Just (Fixed s) -> logInfoS $ "Seed: fixed to " <> show s <> "."+    Just RandomUnset -> error "eLynxRun: Seed unset."+  -- Worker.+  worker+  -- Footer.+  e <- ask+  let g = globalArguments e+      l = localArguments e+  case (writeElynxFile g, outFileBaseName g) of+    (False, _) ->+      logInfoS "No elynx file option --- skip writing ELynx file for reproducible runs."+    (True, Nothing) ->+      logInfoS "No output file given --- skip writing ELynx file for reproducible runs."+    (True, Just bn) -> do+      logInfoS "Write ELynx reproduction file."+      liftIO $ writeReproduction bn (Arguments g (f l))+  -- Footer.+  logInfoFooter++-- | The 'ReaderT' and 'LoggingT' wrapper for ELynx. Prints a header and a+-- footer, logs to 'stderr' if no file is provided. Initializes the seed if none+-- is provided. If a log file is provided, log to the file and to 'stderr'.+eLynxWrapper ::+  (Eq a, Show a, Reproducible a, Reproducible b, ToJSON a) =>+  GlobalArguments ->+  -- Local arguments.+  b ->+  -- Local arguments across all commands.+  (b -> a) ->+  ELynx b () ->+  IO ()+eLynxWrapper gArgs lArgs f worker = do+  -- 1. Fix seed.+  lArgs' <- fixSeed lArgs++  -- 2. Initialize environment.+  e <- initializeEnvironment gArgs lArgs'++  -- 3. Run.+  runReaderT (eLynxRun f worker) e++  -- 4. Close environment.+  closeEnvironment e++-- Get out file path with extension.+getOutFilePath ::+  forall a. Reproducible a => String -> ELynx a (Maybe FilePath)+getOutFilePath ext = do+  a <- ask+  let bn = outFileBaseName . globalArguments $ a+      sfxs = outSuffixes . localArguments $ a+  if ext `elem` sfxs+    then return $ (++ ext) <$> bn+    else+      error+        "getOutFilePath: out file suffix not registered; please contact maintainer."++-- | Write a result with a given name to file with given extension or standard+-- output. Supports compression.+out :: Reproducible a => String -> BL.ByteString -> String -> ELynx a ()+out name res ext = do+  mfp <- getOutFilePath ext+  case mfp of+    Nothing -> do+      logInfoS $ "Write " <> name <> " to standard output."+      liftIO $ BL.putStr res+    Just fp -> do+      logInfoS $ "Write " <> name <> " to file '" <> fp <> "'."+      em <- executionMode . globalArguments <$> ask+      liftIO $ writeGZFile em fp res++-- | Get an output handle, does not support compression. The handle has to be+-- closed after use!+outHandle :: Reproducible a => String -> String -> ELynx a Handle+outHandle name ext = do+  mfp <- getOutFilePath ext+  case mfp of+    Nothing -> do+      logInfoS $ "Write " <> name <> " to standard output."+      return stdout+    Just fp -> do+      logInfoS $ "Write " <> name <> " to file '" <> fp <> "'."+      em <- executionMode . globalArguments <$> ask+      liftIO $ openFileWithExecutionMode em fp

@@ -0,0 +1,78 @@+-- |+-- Module      :  ELynx.Tools.Environment+-- Description :  Runtime environment+-- Copyright   :  (c) 2021 Dominik Schrempf+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Creation date: Thu Sep  2 22:46:02 2021.+module ELynx.Tools.Environment+  ( Environment (..),+    initializeEnvironment,+    closeEnvironment,+  )+where++import Control.Concurrent.MVar+import Control.Monad+import Data.Time+import ELynx.Tools.InputOutput+import ELynx.Tools.Logger+import ELynx.Tools.Options+import System.IO++-- | The environment of an ELynx run.+data Environment a = Environment+  { -- | Global arguments.+    globalArguments :: GlobalArguments,+    -- | Local arguments of command.+    localArguments :: a,+    -- | List will be empty if using 'Quiet'. If 'LogStdOutAndFile' is used+    -- 'logHandles' contains two handles to the standard output and the log+    -- file.+    logHandles :: [Handle],+    -- | MVar blocking output.+    outLock :: MVar (),+    -- | Used to calculate the ETA.+    startingTime :: UTCTime+  }+  deriving (Eq)++instance HasLock (Environment a) where+  getLock = outLock++instance HasLogHandles (Environment a) where+  getLogHandles = logHandles++instance HasStartingTime (Environment a) where+  getStartingTime = startingTime++instance HasVerbosity (Environment a) where+  getVerbosity = verbosity . globalArguments++-- | Initialize the environment.+--+-- Open log file, get current time.+initializeEnvironment :: GlobalArguments -> a -> IO (Environment a)+initializeEnvironment g l = do+  t <- getCurrentTime+  mh <- case (outFileBaseName g, verbosity g) of+    (_, Quiet) -> return []+    (Just bn, _) -> do+      let fn = bn ++ ".log"+      h <- openFileWithExecutionMode em fn+      return [stdout, h]+    (Nothing, _) -> return [stdout]+  lock <- newMVar ()+  return $ Environment g l mh lock t+  where+    em = executionMode g++-- | Close file handles.+closeEnvironment :: Environment s -> IO ()+closeEnvironment e = forM_ hs hClose+  where+    hs = filter (/= stdout) $ logHandles e

@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -17,13 +18,13 @@ -- -- Tools involving input, output, and parsing. module ELynx.Tools.InputOutput-  ( -- * Input, output-    getOutFilePath,-    openFile',+  ( -- * Execution Mode+    ExecutionMode (..),+    openFileWithExecutionMode,++    -- * Input, output     readGZFile,     writeGZFile,-    out,-    outHandle,      -- * Parsing     runParserOnFile,@@ -36,73 +37,49 @@ where  import Codec.Compression.GZip-  ( compress,-    decompress,-  )-import Control.DeepSeq (force)-import Control.Exception (evaluate)-import Control.Monad ((<=<))-import Control.Monad.IO.Class-import Control.Monad.Logger-import Control.Monad.Trans.Reader (ask)-import Data.Attoparsec.ByteString.Lazy+import Data.Aeson+import Data.Attoparsec.ByteString.Lazy hiding (Fail) import qualified Data.ByteString.Lazy.Char8 as BL import Data.List (isSuffixOf)-import qualified Data.Text as T-import ELynx.Tools.Reproduction-  ( Arguments (..),-    ELynx,-    Force (..),-    Reproducible (..),-    forceReanalysis,-    outFileBaseName,-  )-import System.Directory (doesFileExist)+import GHC.Generics+import System.Directory import System.IO --- | Get out file path with extension.-getOutFilePath ::-  forall a. Reproducible a => String -> ELynx a (Maybe FilePath)-getOutFilePath ext = do-  a <- ask-  let bn = outFileBaseName . global $ a-      sfxs = outSuffixes a-  if ext `elem` sfxs-    then return $ (++ ext) <$> bn-    else-      error-        "getOutFilePath: out file suffix not registered; please contact maintainer."+-- | Overwrite existing output files or fail if output files exist.+data ExecutionMode = Overwrite | Fail+  deriving (Eq, Show, Generic) -checkFile :: Force -> FilePath -> IO ()-checkFile (Force True) _ = return ()-checkFile (Force False) fp =+instance FromJSON ExecutionMode++instance ToJSON ExecutionMode++checkFile :: ExecutionMode -> FilePath -> IO ()+checkFile Overwrite _ = return ()+checkFile Fail fp =   doesFileExist fp >>= \case     True ->       error $         "File exists: "           <> fp-          <> ". Please use the --force option to repeat an analysis."+          <> "."+          <> "\n"+          <> "Please use --force to overwrite results of a previous analysis."     False -> return ()  -- | Open existing files only if 'Force' is true.-openFile' :: Force -> FilePath -> IOMode -> IO Handle-openFile' frc fp md = checkFile frc fp >> openFile fp md---- XXX: For now, all files are read strictly (see help of--- Control.DeepSeq.force).-readFile' :: FilePath -> IO BL.ByteString-readFile' fn = withFile fn ReadMode $ (evaluate . force) <=< BL.hGetContents+openFileWithExecutionMode :: ExecutionMode -> FilePath -> IO Handle+openFileWithExecutionMode em fp = checkFile em fp >> openFile fp WriteMode  -- | Read file. If file path ends with ".gz", assume gzipped file and decompress -- before read. readGZFile :: FilePath -> IO BL.ByteString readGZFile f-  | ".gz" `isSuffixOf` f = decompress <$> readFile' f-  | otherwise = readFile' f+  | ".gz" `isSuffixOf` f = decompress <$> BL.readFile f+  | otherwise = BL.readFile f  -- | Write file. If file path ends with ".gz", assume gzipped file and compress -- before write.-writeGZFile :: Force -> FilePath -> BL.ByteString -> IO ()+writeGZFile :: ExecutionMode -> FilePath -> BL.ByteString -> IO () writeGZFile frc f r   | ".gz" `isSuffixOf` f = checkFile frc f >> BL.writeFile f (compress r)   | otherwise = checkFile frc f >> BL.writeFile f r@@ -134,31 +111,3 @@ parseByteStringWith p x = case eitherResult $ parse p x of   Left err -> error err   Right val -> val---- | Write a result with a given name to file with given extension or standard--- output. Supports compression.-out :: Reproducible a => String -> BL.ByteString -> String -> ELynx a ()-out name res ext = do-  mfp <- getOutFilePath ext-  case mfp of-    Nothing -> do-      $(logInfo) $ T.pack $ "Write " <> name <> " to standard output."-      liftIO $ BL.putStr res-    Just fp -> do-      $(logInfo) $ T.pack $ "Write " <> name <> " to file '" <> fp <> "'."-      frc <- forceReanalysis . global <$> ask-      liftIO $ writeGZFile frc fp res---- | Get an output handle, does not support compression. The handle has to be--- closed after use!-outHandle :: Reproducible a => String -> String -> ELynx a Handle-outHandle name ext = do-  mfp <- getOutFilePath ext-  case mfp of-    Nothing -> do-      $(logInfo) $ T.pack $ "Write " <> name <> " to standard output."-      return stdout-    Just fp -> do-      $(logInfo) $ T.pack $ "Write " <> name <> " to file '" <> fp <> "'."-      frc <- forceReanalysis . global <$> ask-      liftIO $ openFile' frc fp WriteMode

@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -16,111 +17,200 @@ -- -- Creation date: Fri Sep  6 14:43:19 2019. module ELynx.Tools.Logger-  ( -- * Logger-    logNewSection,-    eLynxWrapper,+  ( Verbosity (..),+    HasLock (..),+    HasLogHandles (..),+    HasStartingTime (..),+    HasVerbosity (..),+    Logger,+    logOutB,+    logDebugB,+    logDebugS,+    logWarnB,+    logWarnS,+    logInfoB,+    logInfoS,+    logHeader,+    logInfoHeader,+    logInfoFooter,+    logInfoNewSection,   ) where -import Control.Monad.Base (liftBase)+import Control.Concurrent.MVar+import Control.Monad import Control.Monad.IO.Class-import Control.Monad.Logger-import Control.Monad.Trans.Control (MonadBaseControl)-import Control.Monad.Trans.Reader (ReaderT (runReaderT))-import qualified Data.ByteString.Char8 as BS-import Data.Text-import ELynx.Tools.InputOutput (openFile')-import ELynx.Tools.Reproduction+import Control.Monad.Trans.Reader+import Data.Aeson.TH+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Lazy.Char8 as BL+import Data.List+import Data.Time+import Data.Version+import GHC.Generics+import Language.Haskell.TH+import Paths_elynx_tools+import System.Environment import System.IO-import System.Random.MWC --- | Unified way of creating a new section in the log.-logNewSection :: MonadLogger m => Text -> m ()-logNewSection s = $(logInfo) $ "== " <> s+-- | Verbosity levels.+data Verbosity = Quiet | Warn | Info | Debug+  deriving (Bounded, Enum, Eq, Generic, Ord, Read, Show) --- | The 'ReaderT' and 'LoggingT' wrapper for ELynx. Prints a header and a--- footer, logs to 'stderr' if no file is provided. Initializes the seed if none--- is provided. If a log file is provided, log to the file and to 'stderr'.-eLynxWrapper ::-  forall a b.-  (Eq a, Show a, Reproducible a, ToJSON a) =>-  Arguments a ->-  (Arguments a -> Arguments b) ->-  ELynx b () ->-  IO ()-eLynxWrapper args f worker = do-  -- Arguments.-  let gArgs = global args-      lArgs = local args-  let lvl = toLogLevel $ verbosity gArgs-      rd = forceReanalysis gArgs-      outBn = outFileBaseName gArgs-      logFile = (++ ".log") <$> outBn-  runELynxLoggingT lvl rd logFile $ do-    -- Header.-    h <- liftIO $ logHeader (cmdName @a) (cmdDsc @a)-    $(logInfo) $ pack $ h ++ "\n"-    -- Fix seed.-    lArgs' <- case getSeed lArgs of-      Nothing -> return lArgs-      Just Random -> do-        -- XXX: Have to go via a generator here, since creation of seed is not-        -- supported.-        g <- liftIO createSystemRandom-        s <- liftIO $ fromSeed <$> save g-        $(logInfo) $ pack $ "Seed: random; set to " <> show s <> "."-        return $ setSeed lArgs s-      Just (Fixed s) -> do-        $(logInfo) $ pack $ "Seed: " <> show s <> "."-        return lArgs-    let args' = Arguments gArgs lArgs'-    -- Run the worker with the fixed seed.-    runReaderT worker $ f args'-    -- Reproduction file.-    case (writeElynxFile gArgs, outBn) of-      (False, _) ->-        $(logInfo)-          "No elynx file option --- skip writing ELynx file for reproducible runs."-      (True, Nothing) ->-        $(logInfo)-          "No output file given --- skip writing ELynx file for reproducible runs."-      (True, Just bn) -> do-        $(logInfo) "Write ELynx reproduction file."-        liftIO $ writeReproduction bn args'-    -- Footer.-    ftr <- liftIO logFooter-    $(logInfo) $ pack ftr+$(deriveJSON defaultOptions ''Verbosity) -runELynxLoggingT ::-  (MonadBaseControl IO m, MonadIO m) =>-  LogLevel ->-  Force ->-  Maybe FilePath ->-  LoggingT m a ->-  m a-runELynxLoggingT lvl _ Nothing =-  runELynxStderrLoggingT . filterLogger (\_ l -> l >= lvl)-runELynxLoggingT lvl frc (Just fn) =-  runELynxFileLoggingT frc fn . filterLogger (\_ l -> l >= lvl)+-- | Types with an output lock for concurrent output.+class HasLock e where+  getLock :: e -> MVar () -runELynxFileLoggingT ::-  MonadBaseControl IO m => Force -> FilePath -> LoggingT m a -> m a-runELynxFileLoggingT frc fp logger = do-  h <- liftBase $ openFile' frc fp WriteMode-  liftBase (hSetBuffering h LineBuffering)-  r <- runLoggingT logger (output2H stderr h)-  liftBase (hClose h)-  return r+-- | Types with logging information.+class HasLogHandles e where+  getLogHandles :: e -> [Handle] -runELynxStderrLoggingT :: MonadIO m => LoggingT m a -> m a-runELynxStderrLoggingT = (`runLoggingT` output stderr)+-- | Types with starting time.+class HasStartingTime s where+  getStartingTime :: s -> UTCTime -output :: Handle -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()-output h _ _ _ msg = BS.hPutStrLn h ls where ls = fromLogStr msg+-- | Types with verbosity.+class HasVerbosity s where+  getVerbosity :: s -> Verbosity -output2H :: Handle -> Handle -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()-output2H h1 h2 _ _ _ msg = do-  BS.hPutStrLn h1 ls-  BS.hPutStrLn h2 ls+-- | Reader transformer used for logging to a file and to standard output.+type Logger e a = ReaderT e IO a++msgPrepare :: BL.ByteString -> BL.ByteString -> BL.ByteString+msgPrepare pref msg = BL.intercalate "\n" $ map (BL.append pref) $ BL.lines msg++-- Make sure that concurrent output is not scrambled.+atomicAction :: HasLock e => IO () -> Logger e ()+atomicAction a = do+  l <- reader getLock+  liftIO $ withMVar l (const a)++-- | Write to standard output and maybe to log file.+logOutB ::+  (HasLogHandles e, HasLock e) =>+  -- | Prefix.+  BL.ByteString ->+  -- | Message.+  BL.ByteString ->+  Logger e ()+logOutB pref msg = do+  hs <- reader getLogHandles+  mapM_ (atomicAction . (`BL.hPutStrLn` msg')) hs   where-    ls = fromLogStr msg+    msg' = msgPrepare pref msg++-- Perform debug action.+logDebugA :: (HasLock e, HasLogHandles e, HasVerbosity e) => Logger e () -> Logger e ()+logDebugA a = reader getVerbosity >>= \v -> when (v >= Debug) a++-- | Log debug message.+logDebugB :: (HasLock e, HasLogHandles e, HasVerbosity e) => BL.ByteString -> Logger e ()+logDebugB = logDebugA . logOutB "D: "++-- | Log debug message.+logDebugS :: (HasLock e, HasLogHandles e, HasVerbosity e) => String -> Logger e ()+logDebugS = logDebugB . BL.pack++-- Perform warning action.+logWarnA :: (HasLogHandles e, HasVerbosity e) => Logger e () -> Logger e ()+logWarnA a = reader getVerbosity >>= \v -> when (v >= Warn) a++-- | Log warning message.+logWarnB :: (HasLock e, HasLogHandles e, HasVerbosity e) => BL.ByteString -> Logger e ()+logWarnB = logWarnA . logOutB "W: "++-- | Log warning message.+logWarnS :: (HasLock e, HasLogHandles e, HasVerbosity e) => String -> Logger e ()+logWarnS = logWarnB . BL.pack++-- Perform info action.+logInfoA :: (HasLogHandles e, HasVerbosity e) => Logger e () -> Logger e ()+logInfoA a = reader getVerbosity >>= \v -> when (v >= Info) a++-- | Log info message.+logInfoB :: (HasLock e, HasLogHandles e, HasVerbosity e) => BL.ByteString -> Logger e ()+logInfoB = logInfoA . logOutB "   "++-- | Log info message.+logInfoS :: (HasLock e, HasLogHandles e, HasVerbosity e) => String -> Logger e ()+logInfoS = logInfoB . BL.pack++-- Be careful; it is necessary to synchronize the version numbers across packages.+versionString :: String+versionString = "ELynx Suite version " ++ showVersion version ++ "."++copyrightString :: String+copyrightString = "Developed by Dominik Schrempf."++compilationString :: String+compilationString =+  "Compiled on "+    ++ $( stringE+            =<< runIO+              ( formatTime defaultTimeLocale "%B %-e, %Y, at %H:%M %P, %Z."+                  `fmap` getCurrentTime+              )+        )++-- A short header to be used in executables. 'unlines' doesn't work here because+-- it adds an additional newline at the end.+logHeader :: [String]+logHeader = [versionString, copyrightString, compilationString]++-- For a given width, align string to the right; use given fill character.+alignRightWithNoTrim :: Char -> Int -> BL.ByteString -> BL.ByteString+alignRightWithNoTrim c n s = BL.replicate (fromIntegral n - l) c <> s+  where+    l = BL.length s++-- Adapted from System.ProgressBar.renderDuration of package+-- [terminal-progressbar-0.4.1](https://hackage.haskell.org/package/terminal-progress-bar-0.4.1).+renderDuration :: NominalDiffTime -> BL.ByteString+renderDuration dt = hTxt <> mTxt <> sTxt+  where+    hTxt = renderDecimal h <> ":"+    mTxt = renderDecimal m <> ":"+    sTxt = renderDecimal s+    (h, hRem) = ts `quotRem` 3600+    (m, s) = hRem `quotRem` 60+    -- Total amount of seconds+    ts :: Int+    ts = round dt+    renderDecimal n = alignRightWithNoTrim '0' 2 $ BB.toLazyByteString $ BB.intDec n++-- Render a time stamp.+renderTime :: FormatTime t => t -> String+renderTime = formatTime defaultTimeLocale "%B %-e, %Y, at %H:%M %P, %Z."++-- | Log header.+logInfoHeader :: (HasLock e, HasLogHandles e, HasStartingTime e, HasVerbosity e) => String -> [String] -> Logger e ()+logInfoHeader cmdName cmdDsc = do+  logInfoS hline+  logInfoS $ intercalate "\n" logHeader+  t <- renderTime <$> reader getStartingTime+  p <- liftIO getProgName+  as <- liftIO getArgs+  logInfoS $+    intercalate "\n" $+      hline :+      ("Command name: " ++ cmdName) :+      cmdDsc+        ++ ["Starting time: " ++ t, "Command line: " ++ p ++ " " ++ unwords as]+  logInfoS hline+  where+    hline = replicate 78 '-'++-- | Log footer.+logInfoFooter :: (HasLock e, HasLogHandles e, HasStartingTime e, HasVerbosity e) => Logger e ()+logInfoFooter = do+  ti <- reader getStartingTime+  te <- liftIO getCurrentTime+  let dt = te `diffUTCTime` ti+  logInfoB $ "Wall clock run time: " <> renderDuration dt <> "."+  logInfoS $ "End time: " <> renderTime te++-- | Unified way of creating a new section in the log.+logInfoNewSection :: (HasLock e, HasLogHandles e, HasVerbosity e) => String -> Logger e ()+logInfoNewSection s = logInfoS $ "== " <> s

@@ -0,0 +1,243 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module      :  ELynx.Tools.Options+-- Description :  General ELynx options+-- Copyright   :  (c) 2021 Dominik Schrempf+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Creation date: Thu Sep  2 19:17:07 2021.+module ELynx.Tools.Options+  ( -- * Command options+    SeedOpt (..),+    seedOpt,+    executionModeOpt,++    -- * Arguments+    GlobalArguments (..),+    Arguments (..),++    -- * Misc+    parseArguments,+    elynxParserInfo,+    createCommandReproducible,+    createCommand,+    elynxFooter,+  )+where++import Data.Aeson+import Data.List+import qualified Data.Vector.Unboxed as VU+import Data.Word+import ELynx.Tools.InputOutput+import ELynx.Tools.Logger+import ELynx.Tools.Misc+import ELynx.Tools.Reproduction+import Options.Applicative hiding (empty)+import Options.Applicative.Help.Pretty++-- | Seed option for MWC. Defaults to Random.+seedOpt :: Parser SeedOpt+seedOpt = toSeedOpt <$> seedParser++seedParser :: Parser (Maybe (VU.Vector Word32))+seedParser =+  optional $+    option+      auto+      ( long "seed" <> short 'S' <> metavar "[INT]"+          <> help+            ( "Seed for random number generator; "+                ++ "list of 32 bit integers with up to 256 elements (default: random)"+            )+      )++toSeedOpt :: Maybe (VU.Vector Word32) -> SeedOpt+toSeedOpt Nothing = RandomUnset+toSeedOpt (Just w) = Fixed w++-- Execution mode option parser.+executionModeOpt :: Parser ExecutionMode+executionModeOpt =+  flag+    Fail+    Overwrite+    -- DO NOT CHANGE. This option is used by 'elynx redo'.+    ( long "force" <> short 'f'+        <> help+          "Ignore previous analysis and overwrite existing output files."+    )++-- | A set of global arguments used by all programs. The idea is to provide a+-- common framework for shared arguments.+data GlobalArguments = GlobalArguments+  { verbosity :: Verbosity,+    outFileBaseName :: Maybe FilePath,+    executionMode :: ExecutionMode,+    writeElynxFile :: Bool+  }+  deriving (Eq, Show, Generic)++instance FromJSON GlobalArguments++instance ToJSON GlobalArguments++-- | See 'GlobalArguments', parser function.+globalArguments :: Parser GlobalArguments+globalArguments =+  GlobalArguments+    <$> verbosityOpt <*> optional outFileBaseNameOpt <*> executionModeOpt <*> writeELynxOpt++-- Boolean option; be verbose; default NO.+verbosityOpt :: Parser Verbosity+verbosityOpt =+  option+    auto+    ( long "verbosity"+        <> short 'v'+        <> metavar "VALUE"+        <> value Info+        <> showDefault+        <> help ("Be verbose; one of: " ++ unwords (map show vs))+    )+  where+    vs = allValues :: [Verbosity]++-- Output filename.+outFileBaseNameOpt :: Parser FilePath+outFileBaseNameOpt =+  strOption+    ( long "output-file-basename" <> short 'o' <> metavar "NAME"+        <> help+          "Specify base name of output file"+    )++-- Write ELynx file at the end.+writeELynxOpt :: Parser Bool+writeELynxOpt =+  flag+    True+    False+    ( long "no-elynx-file"+        <> help "Do not write data required to reproduce an analysis."+    )++-- | Argument skeleton to be used with all commands.+data Arguments a = Arguments+  { global :: GlobalArguments,+    local :: a+  }+  deriving (Eq, Show, Generic)++instance FromJSON a => FromJSON (Arguments a)++instance ToJSON a => ToJSON (Arguments a)++instance Reproducible a => Reproducible (Arguments a) where+  inFiles = inFiles . local+  outSuffixes = outSuffixes . local+  getSeed = getSeed . local+  setSeed (Arguments g l) s = Arguments g $ setSeed l s+  parser = argumentsParser (parser @a)+  cmdName = cmdName @a+  cmdDsc = cmdDsc @a+  cmdFtr = cmdFtr @a++argumentsParser :: Parser a -> Parser (Arguments a)+argumentsParser p = Arguments <$> globalArguments <*> p++versionOpt :: Parser (a -> a)+versionOpt =+  infoOption+    (intercalate "\n" logHeader)+    ( long "version"+        -- Lower case 'v' clashes with verbosity.+        <> short 'V'+        <> help "Show version"+        <> hidden+    )++elynxParser :: Parser a -> Parser a+elynxParser p = helper <*> versionOpt <*> 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 =+  execParser $+    elynxParserInfo (cmdDsc @a) (cmdFtr @a) (argumentsParser $ parser @a)++-- | ELynx parser info; convenience function.+elynxParserInfo :: [String] -> [String] -> Parser a -> ParserInfo a+elynxParserInfo dsc ftr = parserInfo dsc' ftr'+  where+    dsc' = if null dsc then Nothing else Just $ vsep $ map pretty dsc+    ftr' = Just . vsep $ map pretty ftr ++ elynxFooter++-- Short version of ELynx parser info for sub commands.+parserInfo :: Maybe Doc -> Maybe Doc -> Parser a -> ParserInfo a+parserInfo dsc ftr p =+  info+    (elynxParser p)+    (fullDesc <> headerDoc (Just hdr') <> progDescDoc dsc <> footerDoc ftr)+  where+    hdr' = vsep $ map pretty logHeader++-- | Create a command; convenience function.+createCommandReproducible ::+  forall a b. Reproducible a => (a -> b) -> Mod CommandFields b+createCommandReproducible f =+  command (cmdName @a) $+    f+      <$> parserInfo+        dsc'+        ftr'+        (parser @a)+  where+    dsc = cmdDsc @a+    ftr = cmdFtr @a+    dsc' = if null dsc then Nothing else Just $ vsep $ map pretty dsc+    ftr' = if null ftr then Nothing else Just $ vsep $ map pretty ftr++-- | Create a command; convenience function.+createCommand ::+  String ->+  [String] ->+  [String] ->+  Parser a ->+  (a -> b) ->+  Mod CommandFields b+createCommand nm dsc ftr p f = command nm $ f <$> parserInfo dsc' ftr' p+  where+    dsc' = if null dsc then Nothing else Just $ vsep $ map pretty dsc+    ftr' = if null ftr then Nothing else Just $ vsep $ map pretty ftr++-- Fill a string so that it becomes a paragraph with line breaks. Useful for+-- descriptions, headers and footers.+fillParagraph :: String -> Doc+fillParagraph = fillSep . map text . words++elynxFooter :: [Doc]+elynxFooter =+  [ text "ELynx",+    text "-----",+    fillParagraph+      "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.",+    empty,+    fill 9 (text "slynx")+      <+> text "Analyze, modify, and simulate evolutionary sequences.",+    fill 9 (text "tlynx")+      <+> text "Analyze, modify, and simulate phylogenetic trees.",+    fill 9 (text "elynx") <+> text "Validate and redo past analyses.",+    empty,+    text "Get help for sub commands:",+    text "  slynx examine --help"+  ]

@@ -19,35 +19,14 @@ -- -- 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,+  ( -- * Reproduction+    SeedOpt (..),     Reproducible (..),     getReproductionHash,     Reproduction (..),     writeReproduction,     hashFile, -    -- * Misc-    createCommandReproducible,-    createCommand,-    elynxParserInfo,-     -- * Re-exports     Generic,     FromJSON,@@ -56,253 +35,25 @@ 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 qualified Data.Vector.Unboxed as VU 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 Options.Applicative import Paths_elynx_tools import System.Environment --- Be careful; it is necessary to synchronize the version numbers across packages.-versionString :: String-versionString = "ELynx Suite version " ++ showVersion version ++ "."--copyrightString :: String-copyrightString = "Developed by Dominik Schrempf."--compilationString :: String-compilationString =-  "Compiled on "-    ++ $( 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 = [versionString, copyrightString, compilationString]--time :: IO String-time =-  formatTime defaultTimeLocale "%B %-e, %Y, at %H:%M %P, %Z."-    `fmap` Data.Time.getCurrentTime---- | Short, globally usable string preceding all logs with obligatory description.-logHeader :: String -> [String] -> IO String-logHeader h dsc = do-  t <- time-  p <- getProgName-  as <- getArgs-  return $-    intercalate "\n" $-      ("=== " <> h) :-      dsc-        ++ hdr-        ++ ["Start time: " ++ t, "Command line: " ++ p ++ " " ++ unwords as]---- | See 'logHeader' but footer.-logFooter :: IO String-logFooter = do-  t <- time-  let timeStr = "=== End time: " ++ t-  return $ intercalate "\n" [timeStr]--versionOpt :: Parser (a -> a)-versionOpt =-  infoOption-    (intercalate "\n" hdr)-    ( long "version"-        -- Lower case 'v' clashes with verbosity.-        <> short 'V'-        <> help "Show version"-        <> hidden-    )--elynxFooter :: [Doc]-elynxFooter =-  [ text "ELynx",-    text "-----",-    fillParagraph-      "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.",-    empty,-    fill 9 (text "slynx")-      <+> text "Analyze, modify, and simulate evolutionary sequences.",-    fill 9 (text "tlynx")-      <+> text "Analyze, modify, and simulate phylogenetic trees.",-    fill 9 (text "elynx") <+> text "Validate and redo past analyses.",-    empty,-    text "Get help for sub commands:",-    text "  slynx examine --help"-  ]---- | Verbosity levels.-data Verbosity = Quiet | Warning | Info | Debug-  deriving (Show, Read, Eq, Enum, Bounded, Ord, Generic)--instance FromJSON Verbosity--instance ToJSON Verbosity---- | Conert verbosity option to log level.-toLogLevel :: Verbosity -> LogLevel-toLogLevel Quiet = LevelError-toLogLevel Warning = LevelWarn-toLogLevel Info = LevelInfo-toLogLevel Debug = LevelDebug---- | Exit when output exists, or overwrite.-newtype Force = Force Bool-  deriving (Eq, Show, 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-  { verbosity :: Verbosity,-    outFileBaseName :: Maybe FilePath,-    forceReanalysis :: Force,-    writeElynxFile :: Bool-  }-  deriving (Eq, Show, Generic)--instance FromJSON GlobalArguments--instance ToJSON GlobalArguments---- | See 'GlobalArguments', parser function.-globalArguments :: Parser GlobalArguments-globalArguments =-  GlobalArguments <$> verbosityOpt <*> optional outFileBaseNameOpt <*> forceOpt <*> writeELynxOpt---- | Boolean option; be verbose; default NO.-verbosityOpt :: Parser Verbosity-verbosityOpt =-  option-    auto-    ( long "verbosity"-        <> short 'v'-        <> metavar "VALUE"-        <> value Info-        <> showDefault-        <> help ("Be verbose; one of: " ++ unwords (map show vs))-    )-  where-    vs = allValues :: [Verbosity]---- | Output filename.-outFileBaseNameOpt :: Parser FilePath-outFileBaseNameOpt =-  strOption-    ( long "output-file-basename" <> short 'o' <> metavar "NAME"-        <> help-          "Specify base name of output file"-    )---- | Force option parser.-forceOpt :: Parser Force-forceOpt =-  flag-    (Force False)-    (Force True)-    -- DO NOT CHANGE --force nor -f; they are used by 'elynx redo'.-    ( long "force" <> short 'f'-        <> help-          "Ignore previous analysis and overwrite existing output files."-    )--writeELynxOpt :: Parser Bool-writeELynxOpt = flag True False ( long "no-elynx-file"-                                  <> help "Do not write data required to reproduce an analysis." )- -- | Random or fixed seed.-data Seed = Random | Fixed (Vector Word32)-  deriving (Show, Generic)---- | Upon equality check, a random seed is not different from a fixed one.-instance Eq Seed where-  Random == _ = True-  _ == Random = True-  Fixed s == Fixed t = s == t--instance FromJSON Seed--instance ToJSON Seed---- | Seed option for MWC. Defaults to Random.-seedOpt :: Parser Seed-seedOpt = toSeed <$> seedPar--toSeed :: Maybe (Vector Word32) -> Seed-toSeed Nothing = Random-toSeed (Just w) = Fixed w--seedPar :: Parser (Maybe (Vector Word32))-seedPar =-  optional $-    option-      auto-      ( long "seed" <> short 'S' <> metavar "[INT]"-          <> help-            ( "Seed for random number generator; "-                ++ "list of 32 bit integers with up to 256 elements (default: random)"-            )-      )---- | Argument skeleton to be used with all commands.-data Arguments a = Arguments-  { global :: GlobalArguments,-    local :: a-  }-  deriving (Eq, Show, Generic)--instance FromJSON a => FromJSON (Arguments a)--instance ToJSON a => ToJSON (Arguments a)--instance Reproducible a => Reproducible (Arguments a) where-  inFiles = inFiles . local-  outSuffixes = outSuffixes . local-  getSeed = getSeed . local-  setSeed (Arguments g l) s = Arguments g $ setSeed l s-  parser = argumentsParser (parser @a)-  cmdName = cmdName @a-  cmdDsc = cmdDsc @a-  cmdFtr = cmdFtr @a--argumentsParser :: Parser a -> Parser (Arguments a)-argumentsParser p = Arguments <$> globalArguments <*> p--elynxParser :: Parser a -> Parser a-elynxParser p = helper <*> versionOpt <*> p+data SeedOpt = RandomUnset | RandomSet (VU.Vector Word32) | Fixed (VU.Vector Word32)+  deriving (Eq, Generic, Show) --- | 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 =-  execParser $-    elynxParserInfo (cmdDsc @a) (cmdFtr @a) (argumentsParser $ parser @a)+instance FromJSON SeedOpt --- | Logging transformer to be used with all executables.-type ELynx a = ReaderT (Arguments a) (LoggingT IO)+instance ToJSON SeedOpt  -- | Reproducible commands have --   - a set of input files to be checked for consistency,@@ -314,8 +65,8 @@ class Reproducible a where   inFiles :: a -> [FilePath]   outSuffixes :: a -> [String]-  getSeed :: a -> Maybe Seed-  setSeed :: a -> Vector Word32 -> a+  getSeed :: a -> Maybe SeedOpt+  setSeed :: a -> SeedOpt -> a   parser :: Parser a   cmdName :: String   cmdDsc :: [String]@@ -391,53 +142,3 @@   let cs' = map BS.unpack cs       s = Reproduction pn as version Nothing fs cs' r   void $ encodeFile (bn <> ".elynx") (setHash s)---- | Create a command; convenience function.-createCommandReproducible ::-  forall a b. Reproducible a => (a -> b) -> Mod CommandFields b-createCommandReproducible f =-  command (cmdName @a) $-    f-      <$> parserInfo-        dsc'-        ftr'-        (parser @a)-  where-    dsc = cmdDsc @a-    ftr = cmdFtr @a-    dsc' = if null dsc then Nothing else Just $ vsep $ map pretty dsc-    ftr' = if null ftr then Nothing else Just $ vsep $ map pretty ftr---- | Create a command; convenience function.-createCommand ::-  String ->-  [String] ->-  [String] ->-  Parser a ->-  (a -> b) ->-  Mod CommandFields b-createCommand nm dsc ftr p f = command nm $ f <$> parserInfo dsc' ftr' p-  where-    dsc' = if null dsc then Nothing else Just $ vsep $ map pretty dsc-    ftr' = if null ftr then Nothing else Just $ vsep $ map pretty ftr---- | ELynx parser info; convenience function.-elynxParserInfo :: [String] -> [String] -> Parser a -> ParserInfo a-elynxParserInfo dsc ftr = parserInfo dsc' ftr'-  where-    dsc' = if null dsc then Nothing else Just $ vsep $ map pretty dsc-    ftr' = Just . vsep $ map pretty ftr ++ elynxFooter---- Short version of ELynx parser info for sub commands.-parserInfo :: Maybe Doc -> Maybe Doc -> Parser a -> ParserInfo a-parserInfo dsc ftr p =-  info-    (elynxParser p)-    (fullDesc <> headerDoc (Just hdr') <> progDescDoc dsc <> footerDoc ftr)-  where-    hdr' = vsep $ map pretty hdr---- | Fill a string so that it becomes a paragraph with line breaks. Useful for--- descriptions, headers and footers.-fillParagraph :: String -> Doc-fillParagraph = fillSep . map text . words

@@ -1,34 +0,0 @@--- |--- Module      :  ELynx.Tools.Text--- Copyright   :  (c) Dominik Schrempf 2021--- License     :  GPL-3.0-or-later------ Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable--- Portability :  portable------ Creation date: Thu Feb 14 13:24:53 2019.------ indispensable tools for ByteString handling :).-module ELynx.Tools.Text-  ( -- * Text handling-    tShow,-    fromBs,-  )-where--import qualified Data.ByteString.Lazy.Char8 as BL-import Data.Text-  ( Text,-    pack,-  )-import Data.Text.Lazy (toStrict)-import Data.Text.Lazy.Encoding (decodeUtf8)---- | Conversion to 'Text' from showable values.-tShow :: Show a => a -> Text-tShow = pack . show---- | Conversion to 'Text' from bytestring.-fromBs :: BL.ByteString -> Text-fromBs = toStrict . decodeUtf8