├── .gitignore ├── .travis.yml ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.hs ├── example └── Simple.hs ├── package.yaml ├── src └── Options │ └── Applicative │ └── Simple.hs ├── stack.yaml └── test └── Main.hs /.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | *.hi 3 | *~ 4 | dist/ 5 | cabal-dev/ 6 | .hsenv 7 | TAGS 8 | tags 9 | *.tag 10 | .stack-work/ 11 | optparse-simple.cabal 12 | tarballs/ 13 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # This is the complex Travis configuration, which is intended for use 2 | # on open source libraries which need compatibility across multiple GHC 3 | # versions, must work with cabal-install, and should be 4 | # cross-platform. For more information and other options, see: 5 | # 6 | # https://docs.haskellstack.org/en/stable/travis_ci/ 7 | # 8 | # Copy these contents into the root directory of your Github project in a file 9 | # named .travis.yml 10 | 11 | # Use new container infrastructure to enable caching 12 | sudo: false 13 | 14 | # Do not choose a language; we provide our own build tools. 15 | language: generic 16 | 17 | # Caching so the next build will be fast too. 18 | cache: 19 | directories: 20 | - $HOME/.ghc 21 | - $HOME/.cabal 22 | - $HOME/.stack 23 | - $TRAVIS_BUILD_DIR/.stack-work 24 | 25 | # The different configurations we want to test. We have BUILD=cabal which uses 26 | # cabal-install, and BUILD=stack which uses Stack. More documentation on each 27 | # of those below. 28 | # 29 | # We set the compiler values here to tell Travis to use a different 30 | # cache file per set of arguments. 31 | # 32 | # If you need to have different apt packages for each combination in the 33 | # matrix, you can use a line such as: 34 | # addons: {apt: {packages: [libfcgi-dev,libgmp-dev]}} 35 | matrix: 36 | include: 37 | # We grab the appropriate GHC and cabal-install versions from hvr's PPA. See: 38 | # https://github.com/hvr/multi-ghc-travis 39 | #- env: BUILD=cabal GHCVER=7.0.4 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7 40 | # compiler: ": #GHC 7.0.4" 41 | # addons: {apt: {packages: [cabal-install-1.16,ghc-7.0.4,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 42 | #- env: BUILD=cabal GHCVER=7.2.2 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7 43 | # compiler: ": #GHC 7.2.2" 44 | # addons: {apt: {packages: [cabal-install-1.16,ghc-7.2.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 45 | #- env: BUILD=cabal GHCVER=7.4.2 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7 46 | # compiler: ": #GHC 7.4.2" 47 | # addons: {apt: {packages: [cabal-install-1.16,ghc-7.4.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 48 | # - env: BUILD=cabal GHCVER=7.6.3 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7 49 | # compiler: ": #GHC 7.6.3" 50 | # addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 51 | # - env: BUILD=cabal GHCVER=7.8.4 CABALVER=1.18 HAPPYVER=1.19.5 ALEXVER=3.1.7 52 | # compiler: ": #GHC 7.8.4" 53 | # addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 54 | # - env: BUILD=cabal GHCVER=7.10.3 CABALVER=1.22 HAPPYVER=1.19.5 ALEXVER=3.1.7 55 | # compiler: ": #GHC 7.10.3" 56 | # addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 57 | - env: BUILD=cabal GHCVER=8.0.2 CABALVER=1.24 HAPPYVER=1.19.5 ALEXVER=3.1.7 58 | compiler: ": #GHC 8.0.2" 59 | addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 60 | - env: BUILD=cabal GHCVER=8.2.2 CABALVER=2.0 HAPPYVER=1.19.5 ALEXVER=3.1.7 61 | compiler: ": #GHC 8.2.2" 62 | addons: {apt: {packages: [cabal-install-2.0,ghc-8.2.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 63 | - env: BUILD=cabal GHCVER=8.4.4 CABALVER=2.2 HAPPYVER=1.19.5 ALEXVER=3.1.7 64 | compiler: ": #GHC 8.4.4" 65 | addons: {apt: {packages: [cabal-install-2.2,ghc-8.4.4,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 66 | - env: BUILD=cabal GHCVER=8.6.3 CABALVER=2.4 HAPPYVER=1.19.5 ALEXVER=3.1.7 67 | compiler: ": #GHC 8.6.3" 68 | addons: {apt: {packages: [cabal-install-2.4,ghc-8.6.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 69 | 70 | # Build with the newest GHC and cabal-install. This is an accepted failure, 71 | # see below. 72 | - env: BUILD=cabal GHCVER=head CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7 73 | compiler: ": #GHC HEAD" 74 | addons: {apt: {packages: [cabal-install-head,ghc-head,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 75 | 76 | # The Stack builds. We can pass in arbitrary Stack arguments via the ARGS 77 | # variable, such as using --stack-yaml to point to a different file. 78 | - env: BUILD=stack ARGS="" 79 | compiler: ": #stack default" 80 | addons: {apt: {packages: [libgmp-dev]}} 81 | 82 | # - env: BUILD=stack ARGS="--resolver lts-2" 83 | # compiler: ": #stack 7.8.4" 84 | # addons: {apt: {packages: [libgmp-dev]}} 85 | 86 | # - env: BUILD=stack ARGS="--resolver lts-3" 87 | # compiler: ": #stack 7.10.2" 88 | # addons: {apt: {packages: [libgmp-dev]}} 89 | 90 | # - env: BUILD=stack ARGS="--resolver lts-6" 91 | # compiler: ": #stack 7.10.3" 92 | # addons: {apt: {packages: [libgmp-dev]}} 93 | 94 | # - env: BUILD=stack ARGS="--resolver lts-7" 95 | # compiler: ": #stack 8.0.1" 96 | # addons: {apt: {packages: [libgmp-dev]}} 97 | 98 | - env: BUILD=stack ARGS="--resolver lts-9" 99 | compiler: ": #stack 8.0.2" 100 | addons: {apt: {packages: [libgmp-dev]}} 101 | 102 | - env: BUILD=stack ARGS="--resolver lts-11" 103 | compiler: ": #stack 8.2.2" 104 | addons: {apt: {packages: [libgmp-dev]}} 105 | 106 | - env: BUILD=stack ARGS="--resolver lts-12" 107 | compiler: ": #stack 8.4.4" 108 | addons: {apt: {packages: [libgmp-dev]}} 109 | 110 | - env: BUILD=stack ARGS="--resolver lts-13" 111 | compiler: ": #stack 8.6.3" 112 | addons: {apt: {packages: [libgmp-dev]}} 113 | 114 | # Nightly builds are allowed to fail 115 | - env: BUILD=stack ARGS="--resolver nightly" 116 | compiler: ": #stack nightly" 117 | addons: {apt: {packages: [libgmp-dev]}} 118 | 119 | # Build on macOS in addition to Linux 120 | - env: BUILD=stack ARGS="" 121 | compiler: ": #stack default osx" 122 | os: osx 123 | 124 | # Travis includes an macOS which is incompatible with GHC 7.8.4 125 | #- env: BUILD=stack ARGS="--resolver lts-2" 126 | # compiler: ": #stack 7.8.4 osx" 127 | # os: osx 128 | 129 | # - env: BUILD=stack ARGS="--resolver lts-3" 130 | # compiler: ": #stack 7.10.2 osx" 131 | # os: osx 132 | 133 | # - env: BUILD=stack ARGS="--resolver lts-6" 134 | # compiler: ": #stack 7.10.3 osx" 135 | # os: osx 136 | 137 | # - env: BUILD=stack ARGS="--resolver lts-7" 138 | # compiler: ": #stack 8.0.1 osx" 139 | # os: osx 140 | 141 | - env: BUILD=stack ARGS="--resolver lts-9" 142 | compiler: ": #stack 8.0.2 osx" 143 | os: osx 144 | 145 | - env: BUILD=stack ARGS="--resolver lts-11" 146 | compiler: ": #stack 8.2.2 osx" 147 | os: osx 148 | 149 | - env: BUILD=stack ARGS="--resolver lts-12" 150 | compiler: ": #stack 8.4.4 osx" 151 | os: osx 152 | 153 | - env: BUILD=stack ARGS="--resolver lts-13" 154 | compiler: ": #stack 8.6.3 osx" 155 | os: osx 156 | 157 | - env: BUILD=stack ARGS="--resolver nightly" 158 | compiler: ": #stack nightly osx" 159 | os: osx 160 | 161 | allow_failures: 162 | - env: BUILD=cabal GHCVER=head CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7 163 | - env: BUILD=stack ARGS="--resolver nightly" 164 | 165 | before_install: 166 | # Using compiler above sets CC to an invalid value, so unset it 167 | - unset CC 168 | 169 | # We want to always allow newer versions of packages when building on GHC HEAD 170 | - CABALARGS="" 171 | - if [ "x$GHCVER" = "xhead" ]; then CABALARGS=--allow-newer; fi 172 | 173 | # Download and unpack the stack executable 174 | - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$HOME/.local/bin:/opt/alex/$ALEXVER/bin:/opt/happy/$HAPPYVER/bin:$HOME/.cabal/bin:$PATH 175 | - mkdir -p ~/.local/bin 176 | - | 177 | if [ `uname` = "Darwin" ] 178 | then 179 | travis_retry curl --insecure -L https://www.stackage.org/stack/osx-x86_64 | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin 180 | else 181 | travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 182 | fi 183 | 184 | # Use the more reliable S3 mirror of Hackage 185 | mkdir -p $HOME/.cabal 186 | echo 'remote-repo: hackage.haskell.org:http://hackage.fpcomplete.com/' > $HOME/.cabal/config 187 | echo 'remote-repo-cache: $HOME/.cabal/packages' >> $HOME/.cabal/config 188 | 189 | install: 190 | - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" 191 | - if [ -f configure.ac ]; then autoreconf -i; fi 192 | - | 193 | set -ex 194 | case "$BUILD" in 195 | stack) 196 | # Add in extra-deps for older snapshots, as necessary 197 | stack --no-terminal --install-ghc $ARGS test --bench --dry-run || ( \ 198 | stack --no-terminal $ARGS build cabal-install && \ 199 | stack --no-terminal $ARGS solver --update-config) 200 | 201 | # Build the dependencies 202 | stack --no-terminal --install-ghc $ARGS test --bench --only-dependencies 203 | ;; 204 | cabal) 205 | cabal --version 206 | travis_retry cabal update 207 | 208 | # Get the list of packages from the stack.yaml file. Note that 209 | # this will also implicitly run hpack as necessary to generate 210 | # the .cabal files needed by cabal-install. 211 | PACKAGES=$(stack --install-ghc query locals | grep '^ *path' | sed 's@^ *path:@@') 212 | 213 | cabal install --only-dependencies --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES 214 | ;; 215 | esac 216 | set +ex 217 | 218 | script: 219 | - | 220 | set -ex 221 | case "$BUILD" in 222 | stack) 223 | stack --no-terminal $ARGS test --bench --no-run-benchmarks --haddock --no-haddock-deps 224 | ;; 225 | cabal) 226 | cabal install --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES 227 | 228 | ORIGDIR=$(pwd) 229 | for dir in $PACKAGES 230 | do 231 | cd $dir 232 | cabal check || [ "$CABALVER" == "1.16" ] 233 | cabal sdist 234 | PKGVER=$(cabal info . | awk '{print $2;exit}') 235 | SRC_TGZ=$PKGVER.tar.gz 236 | cd dist 237 | tar zxfv "$SRC_TGZ" 238 | cd "$PKGVER" 239 | cabal configure --enable-tests 240 | cabal build 241 | cabal test 242 | cd $ORIGDIR 243 | done 244 | ;; 245 | esac 246 | set +ex 247 | -------------------------------------------------------------------------------- /ChangeLog.md: -------------------------------------------------------------------------------- 1 | # ChangeLog for optparse-simple 2 | 3 | ## 0.1.1.4 4 | 5 | * template-haskell 2.17 support [#15](https://github.com/fpco/optparse-simple/pull/15) 6 | 7 | ## 0.1.1.3 8 | 9 | * optparse-applicative 0.16.0.0 support [#14](https://github.com/fpco/optparse-simple/issues/14) 10 | 11 | ## 0.1.1.2 12 | 13 | * Run TH slice at the right time to get proper Git info [#13](https://github.com/fpco/optparse-simple/issues/13) 14 | 15 | ## 0.1.1.1 16 | 17 | * Add explicit signature to work around [#12](https://github.com/fpco/optparse-simple/issues/12) 18 | 19 | ## 0.1.1 20 | 21 | * Switch dependency `gitrev` to `githash` 22 | 23 | ## 0.1.0 24 | 25 | * Migrate from `EitherT` to `ExceptT` 26 | [#8](https://github.com/fpco/optparse-simple/issues/8) 27 | 28 | ## 0.0.4 29 | 30 | * Support `--help` on subcommands 31 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015, optparse-simple 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | * Redistributions of source code must retain the above copyright 7 | notice, this list of conditions and the following disclaimer. 8 | * Redistributions in binary form must reproduce the above copyright 9 | notice, this list of conditions and the following disclaimer in the 10 | documentation and/or other materials provided with the distribution. 11 | * Neither the name of optparse-simple nor the 12 | names of its contributors may be used to endorse or promote products 13 | derived from this software without specific prior written permission. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL BE LIABLE FOR ANY 19 | DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 22 | ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | optparse-simple 2 | ===== 3 | 4 | Simple interface to optparse-applicative 5 | 6 | ## Usage 7 | 8 | Typical usage with no commands: 9 | 10 | ``` haskell 11 | do (opts,()) <- 12 | simpleOptions "ver" 13 | "header" 14 | "desc" 15 | (flag () () (long "some-flag")) 16 | empty 17 | doThings opts 18 | ``` 19 | 20 | Typical usage with commands: 21 | 22 | ``` haskell 23 | do (opts,runCmd) <- 24 | simpleOptions "ver" 25 | "header" 26 | "desc" 27 | (pure ()) $ 28 | do addCommand "delete" 29 | "Delete the thing" 30 | (const deleteTheThing) 31 | (pure ()) 32 | addCommand "create" 33 | "Create a thing" 34 | createAThing 35 | (strOption (long "hello")) 36 | runCmd 37 | ``` 38 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /example/Simple.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | module Main (main) where 3 | 4 | import Options.Applicative.Simple (simpleVersion) 5 | import qualified Paths_optparse_simple as Meta 6 | 7 | main :: IO () 8 | main = putStrLn $(simpleVersion Meta.version) -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: optparse-simple 2 | version: 0.1.1.4 3 | synopsis: Simple interface to optparse-applicative 4 | description: Please see the README at 5 | category: Options 6 | author: FP Complete 7 | maintainer: chrisdone@fpcomplete.com 8 | copyright: 2015-2017 FP Complete 9 | license: BSD3 10 | github: fpco/optparse-simple 11 | 12 | extra-source-files: 13 | - README.md 14 | - ChangeLog.md 15 | 16 | dependencies: 17 | - base >= 4.9.1 && <5 18 | 19 | library: 20 | source-dirs: src/ 21 | ghc-options: -Wall 22 | dependencies: 23 | - template-haskell 24 | - optparse-applicative 25 | - githash >= 0.1.3.0 26 | - th-compat 27 | - transformers >= 0.4 28 | when: 29 | - condition: impl (ghc < 8.0) 30 | dependencies: semigroups == 0.18.* 31 | 32 | flags: 33 | build-example: 34 | default: False 35 | manual: True 36 | description: Build the example executable 37 | 38 | executables: 39 | simple: 40 | main: example/Simple.hs 41 | dependencies: 42 | - optparse-simple 43 | when: 44 | - condition: flag(build-example) 45 | then: 46 | buildable: true 47 | else: 48 | buildable: false 49 | 50 | tests: 51 | test: 52 | main: Main.hs 53 | source-dirs: test 54 | ghc-options: -Wall 55 | dependencies: 56 | - base 57 | - optparse-simple 58 | - directory 59 | - bytestring 60 | -------------------------------------------------------------------------------- /src/Options/Applicative/Simple.hs: -------------------------------------------------------------------------------- 1 | -- Try to ensure that https://github.com/fpco/optparse-simple/issues/12 doesn't recur. 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | {-# LANGUAGE TemplateHaskell #-} 5 | {-# LANGUAGE CPP #-} 6 | 7 | -- | Simple interface to program arguments. 8 | -- 9 | -- Typical usage with no commands: 10 | -- 11 | -- @ 12 | -- do (opts,()) <- 13 | -- simpleOptions "ver" 14 | -- "header" 15 | -- "desc" 16 | -- (flag () () (long "some-flag")) 17 | -- empty 18 | -- doThings opts 19 | -- @ 20 | -- 21 | -- Typical usage with commands: 22 | -- 23 | -- @ 24 | -- do (opts,runCmd) <- 25 | -- simpleOptions "ver" 26 | -- "header" 27 | -- "desc" 28 | -- (pure ()) $ 29 | -- do addCommand "delete" 30 | -- "Delete the thing" 31 | -- (const deleteTheThing) 32 | -- (pure ()) 33 | -- addCommand "create" 34 | -- "Create a thing" 35 | -- createAThing 36 | -- (strOption (long "hello")) 37 | -- runCmd 38 | -- @ 39 | 40 | module Options.Applicative.Simple 41 | ( module Options.Applicative.Simple 42 | , module Options.Applicative 43 | ) where 44 | 45 | import Control.Monad.Trans.Class (lift) 46 | import Control.Monad.Trans.Except 47 | import Control.Monad.Trans.Writer 48 | #if !MIN_VERSION_base(4,11,0) 49 | import Data.Semigroup 50 | #endif 51 | import Data.Version 52 | import GitHash (GitInfo, giDirty, giHash, tGitInfoCwdTry) 53 | import Language.Haskell.TH (Q,Exp) 54 | import qualified Language.Haskell.TH.Syntax as TH 55 | import Language.Haskell.TH.Syntax.Compat 56 | import Options.Applicative 57 | import System.Environment 58 | 59 | -- | Generate and execute a simple options parser. 60 | simpleOptions 61 | :: String 62 | -- ^ version string 63 | -> String 64 | -- ^ header 65 | -> String 66 | -- ^ program description 67 | -> Parser a 68 | -- ^ global settings 69 | -> ExceptT b (Writer (Mod CommandFields b)) () 70 | -- ^ commands (use 'addCommand') 71 | -> IO (a,b) 72 | simpleOptions versionString h pd globalParser commandParser = 73 | do args <- getArgs 74 | case execParserPure (prefs idm) parser args of 75 | Failure _ | null args -> withArgs ["--help"] (execParser parser) 76 | parseResult -> handleParseResult parseResult 77 | where parser = info (versionOption <*> simpleParser globalParser commandParser) desc 78 | desc = fullDesc <> header h <> progDesc pd 79 | versionOption = 80 | infoOption 81 | versionString 82 | (long "version" <> 83 | help "Show version") 84 | 85 | -- | Generate a string like @Version 1.2, Git revision 1234@. 86 | -- 87 | -- @$(simpleVersion …)@ @::@ 'String' 88 | simpleVersion :: Version -> Q Exp 89 | simpleVersion version = 90 | [|concat (["Version " 91 | ,$(TH.lift $ showVersion version) 92 | ] ++ 93 | case $(unTypeSplice tGitInfoCwdTry) :: Either String GitInfo of 94 | Left _ -> [] 95 | Right gi -> [ ", Git revision " 96 | , giHash gi 97 | , if giDirty gi then " (dirty)" else "" 98 | ] 99 | )|] 100 | 101 | -- | Add a command to the options dispatcher. 102 | addCommand :: String -- ^ command string 103 | -> String -- ^ title of command 104 | -> (a -> b) -- ^ constructor to wrap up command in common data type 105 | -> Parser a -- ^ command parser 106 | -> ExceptT b (Writer (Mod CommandFields b)) () 107 | addCommand cmd title constr inner = 108 | lift (tell (command cmd 109 | (info (constr <$> (helper <*> inner)) 110 | (progDesc title)))) 111 | 112 | -- | Add a command that takes sub-commands to the options dispatcher. 113 | -- 114 | -- Example: 115 | -- 116 | -- @ 117 | -- addSubCommands "thing" 118 | -- "Subcommands that operate on things" 119 | -- (do addCommand "delete" 120 | -- "Delete the thing" 121 | -- (const deleteTheThing) 122 | -- (pure ()) 123 | -- addCommand "create" 124 | -- "Create a thing" 125 | -- createAThing 126 | -- (strOption (long "hello"))) 127 | -- @ 128 | -- 129 | -- If there are common options between all the sub-commands, use 'addCommand' 130 | -- in combination with 'simpleParser' instead of 'addSubCommands'. 131 | addSubCommands 132 | :: String 133 | -- ^ command string 134 | -> String 135 | -- ^ title of command 136 | -> ExceptT b (Writer (Mod CommandFields b)) () 137 | -- ^ sub-commands (use 'addCommand') 138 | -> ExceptT b (Writer (Mod CommandFields b)) () 139 | addSubCommands cmd title commandParser = 140 | addCommand cmd 141 | title 142 | (\((), a) -> a) 143 | (simpleParser (pure ()) commandParser) 144 | 145 | -- | Generate a simple options parser. 146 | -- 147 | -- Most of the time you should use 'simpleOptions' instead, but 'simpleParser' 148 | -- can be used for sub-commands that need common options. For example: 149 | -- 150 | -- @ 151 | -- addCommand "thing" 152 | -- "Subcommands that operate on things" 153 | -- (\\(opts,runSubCmd) -> runSubCmd opts) 154 | -- (simpleParser (flag () () (long "some-flag")) $ 155 | -- do addCommand "delete" 156 | -- "Delete the thing" 157 | -- (const deleteTheThing) 158 | -- (pure ()) 159 | -- addCommand "create" 160 | -- "Create a thing" 161 | -- createAThing 162 | -- (strOption (long "hello"))) 163 | -- @ 164 | -- 165 | simpleParser 166 | :: Parser a 167 | -- ^ common settings 168 | -> ExceptT b (Writer (Mod CommandFields b)) () 169 | -- ^ commands (use 'addCommand') 170 | -> Parser (a,b) 171 | simpleParser commonParser commandParser = 172 | helpOption <*> config 173 | where helpOption = 174 | #if MIN_VERSION_optparse_applicative(0,16,0) 175 | abortOption (ShowHelpText Nothing) $ 176 | #else 177 | abortOption ShowHelpText $ 178 | #endif 179 | long "help" <> 180 | help "Show this help text" 181 | config = 182 | (,) <$> commonParser <*> 183 | case runWriter (runExceptT commandParser) of 184 | (Right (),d) -> subparser d 185 | (Left b,_) -> pure b 186 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-13.0 # ghc-8.6.3 2 | extra-deps: 3 | - githash-0.1.3.0 4 | flags: 5 | optparse-simple: 6 | build-example: true 7 | -------------------------------------------------------------------------------- /test/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | import Options.Applicative.Simple hiding(action) 5 | import GHC.IO.Handle 6 | import System.IO 7 | import System.Environment 8 | import Control.Exception 9 | import Control.Monad 10 | import System.Directory 11 | import System.Exit 12 | import Data.ByteString (ByteString) 13 | import qualified Data.ByteString as BS 14 | import Data.Monoid ((<>)) 15 | 16 | 17 | shouldBe :: (Show a, Eq a) => a -> a -> IO () 18 | shouldBe actual expected 19 | | expected == actual = return () 20 | | otherwise = do 21 | putStrLn $ "expected: " ++ show expected 22 | putStrLn $ "actual : " ++ show actual 23 | exitFailure 24 | 25 | catchReturn :: Exception e => IO e -> IO e 26 | catchReturn io = io `catch` return 27 | 28 | catchExitCode :: IO () -> IO ExitCode 29 | catchExitCode action = catchReturn $ do 30 | action 31 | return ExitSuccess 32 | 33 | data FakeHandles = FakeHandles 34 | { fakeIn :: Handle 35 | , fakeOut :: Handle 36 | , fakeErr :: Handle 37 | , realIn :: Handle 38 | , realOut :: Handle 39 | , realErr :: Handle 40 | } 41 | 42 | openFile' :: FilePath -> IO Handle 43 | openFile' path = do 44 | removeIfExists path 45 | openFile path ReadWriteMode 46 | 47 | removeIfExists :: FilePath -> IO () 48 | removeIfExists path = do 49 | exists <- doesFileExist path 50 | when exists $ do 51 | removeFile path 52 | 53 | stdinFile :: FilePath 54 | stdinFile = ".tmp.stdin" 55 | 56 | stdoutFile :: FilePath 57 | stdoutFile = ".tmp.stdout" 58 | 59 | stderrFile :: FilePath 60 | stderrFile = ".tmp.stderr" 61 | 62 | beforeFH :: IO FakeHandles 63 | beforeFH = do 64 | realIn <- hDuplicate stdin 65 | realOut <- hDuplicate stdout 66 | realErr <- hDuplicate stderr 67 | 68 | fakeIn <- openFile stdinFile ReadWriteMode 69 | fakeOut <- openFile' stdoutFile 70 | fakeErr <- openFile' stderrFile 71 | 72 | hDuplicateTo fakeIn stdin 73 | hDuplicateTo fakeOut stdout 74 | hDuplicateTo fakeErr stderr 75 | 76 | return FakeHandles{..} 77 | 78 | afterFH :: FakeHandles -> IO () 79 | afterFH FakeHandles{..} = do 80 | hDuplicateTo realIn stdin 81 | hDuplicateTo realOut stdout 82 | hDuplicateTo realErr stderr 83 | 84 | hClose fakeIn 85 | hClose fakeOut 86 | hClose fakeErr 87 | 88 | withFakeHandles :: IO a -> IO a 89 | withFakeHandles = bracket beforeFH afterFH . const 90 | 91 | withStdIn :: ByteString -> IO () 92 | -> IO (ByteString, ByteString, ExitCode) 93 | withStdIn inBS action = do 94 | BS.writeFile stdinFile inBS 95 | withFakeHandles $ do 96 | _ <- catchExitCode action 97 | hFlush stdout 98 | hFlush stderr 99 | out <- BS.readFile stdoutFile 100 | err <- BS.readFile stderrFile 101 | 102 | removeIfExists stdinFile 103 | removeIfExists stdoutFile 104 | removeIfExists stderrFile 105 | 106 | return (out, err, ExitSuccess) 107 | 108 | 109 | main :: IO () 110 | main = do 111 | (out, err, exitCode) <- withStdIn "" 112 | $ withArgs ["--version"] 113 | $ simpleProg 114 | exitCode `shouldBe` ExitSuccess 115 | err `shouldBe` "" 116 | out `shouldBe` "version\n" 117 | 118 | (out', err', exitCode') <- withStdIn "" 119 | $ withArgs ["--summary"] 120 | $ summaryProg 121 | exitCode' `shouldBe` ExitSuccess 122 | err' `shouldBe` "" 123 | out' `shouldBe` "A program summary\n" 124 | 125 | return () 126 | 127 | 128 | simpleProg :: IO () 129 | simpleProg = do 130 | ((), ()) <- simpleOptions "version" "header" "desc" (pure ()) empty 131 | return () 132 | 133 | parserWithSummary :: Parser () 134 | parserWithSummary = summaryOption <*> pure () where 135 | summaryOption = infoOption "A program summary" 136 | $ long "summary" 137 | <> help "Show program summary" 138 | 139 | summaryProg :: IO () 140 | summaryProg = do 141 | ((), ()) <- simpleOptions "version" "header" "desc" parserWithSummary empty 142 | return () 143 | --------------------------------------------------------------------------------