optparse-simple 0.0.3 → 0.0.4

raw patch · 5 files changed

+201/−3 lines, 5 filesdep +bytestringdep +directorydep +optparse-simpledep ~basenew-uploader

Dependencies added: bytestring, directory, optparse-simple

Dependency ranges changed: base

Files

ChangeLog.md +3/−0
README.md +37/−0
optparse-simple.cabal +18/−2
src/Options/Applicative/Simple.hs +1/−1
test/Main.hs +142/−0

+ ChangeLog.md view

@@ -0,0 +1,3 @@+## 0.0.4++* Support `--help` on subcommands

+ README.md view

@@ -0,0 +1,37 @@+optparse-simple+=====++Simple interface to optparse-applicative++## Usage++Typical usage with no commands:++``` haskell+do (opts,()) <-+     simpleOptions "ver"+                   "header"+                   "desc"+                   (flag () () (long "some-flag"))+                   empty+   doThings opts+```++Typical usage with commands:++``` haskell+do (opts,runCmd) <-+     simpleOptions "ver"+                   "header"+                   "desc"+                   (pure ()) $+     do addCommand "delete"+                   "Delete the thing"+                   (const deleteTheThing)+                   (pure ())+        addCommand "create"+                   "Create a thing"+                   createAThing+                   (strOption (long "hello"))+   runCmd+```

optparse-simple.cabal view

@@ -1,5 +1,5 @@ name:                optparse-simple-version:             0.0.3+version:             0.0.4 synopsis:            Simple interface to optparse-applicative description:         Simple interface to optparse-applicative license:             BSD3@@ -10,10 +10,11 @@ category:            Options build-type:          Simple cabal-version:       >=1.8+extra-source-files:  README.md ChangeLog.md  library   hs-source-dirs:    src/-  ghc-options:       -Wall -O2+  ghc-options:       -Wall   exposed-modules:   Options.Applicative.Simple   build-depends:     base >= 4 && <5                    , template-haskell@@ -21,3 +22,18 @@                    , optparse-applicative                    , gitrev                    , either++test-suite test+  type:              exitcode-stdio-1.0+  main-is:           Main.hs+  build-depends:+                     base -any+                   , optparse-simple+                   , directory -any+                   , bytestring -any+  hs-source-dirs:    test+  ghc-options:       -Wall++source-repository head+  type:              git+  location:          https://github.com/fpco/optparse-simple

src/Options/Applicative/Simple.hs view

@@ -101,7 +101,7 @@            -> EitherT b (Writer (Mod CommandFields b)) () addCommand cmd title constr inner =   lift (tell (command cmd-                      (info (constr <$> inner)+                      (info (constr <$> (helper <*> inner))                             (progDesc title))))  -- | Add a command that takes sub-commands to the options dispatcher.

+ test/Main.hs view

@@ -0,0 +1,142 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}++import Options.Applicative.Simple hiding(action)+import GHC.IO.Handle+import System.IO+import System.Environment+import Control.Exception+import Control.Monad+import System.Directory+import System.Exit+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.Monoid ((<>))+++shouldBe :: (Show a, Eq a) => a -> a -> IO ()+shouldBe actual expected+  | expected == actual = return ()+  | otherwise = do+    putStrLn $ "expected: " ++ show expected+    putStrLn $ "actual  : " ++ show actual+    exitFailure++catchReturn :: Exception e => IO e -> IO e+catchReturn io = io `catch` return++catchExitCode :: IO () -> IO ExitCode+catchExitCode action = catchReturn $ do+  action+  return ExitSuccess++data FakeHandles = FakeHandles+  { fakeIn  :: Handle+  , fakeOut :: Handle+  , fakeErr :: Handle+  , realIn  :: Handle+  , realOut :: Handle+  , realErr :: Handle+  }++openFile' :: FilePath -> IO Handle+openFile' path = do+  removeIfExists path+  openFile path ReadWriteMode++removeIfExists :: FilePath -> IO ()+removeIfExists path = do+  exists <- doesFileExist path+  when exists $ do+    removeFile path++stdinFile :: FilePath+stdinFile = ".tmp.stdin"++stdoutFile :: FilePath+stdoutFile = ".tmp.stdout"++stderrFile :: FilePath+stderrFile = ".tmp.stderr"++beforeFH :: IO FakeHandles+beforeFH = do+  realIn <- hDuplicate stdin+  realOut <- hDuplicate stdout+  realErr <- hDuplicate stderr++  fakeIn <- openFile stdinFile ReadWriteMode+  fakeOut <- openFile' stdoutFile+  fakeErr <- openFile' stderrFile++  hDuplicateTo fakeIn stdin+  hDuplicateTo fakeOut stdout+  hDuplicateTo fakeErr stderr++  return FakeHandles{..}++afterFH :: FakeHandles -> IO ()+afterFH FakeHandles{..} = do+  hDuplicateTo realIn stdin+  hDuplicateTo realOut stdout+  hDuplicateTo realErr stderr++  hClose fakeIn+  hClose fakeOut+  hClose fakeErr++withFakeHandles :: IO a -> IO a+withFakeHandles = bracket beforeFH afterFH . const++withStdIn :: ByteString -> IO ()+  -> IO (ByteString, ByteString, ExitCode)+withStdIn inBS action = do+  BS.writeFile stdinFile inBS+  withFakeHandles $ do+    _ <- catchExitCode action+    hFlush stdout+    hFlush stderr+  out <- BS.readFile stdoutFile+  err <- BS.readFile stderrFile++  removeIfExists stdinFile+  removeIfExists stdoutFile+  removeIfExists stderrFile++  return (out, err, ExitSuccess)+++main :: IO ()+main = do+  (out, err, exitCode) <- withStdIn ""+    $ withArgs ["--version"]+    $ simpleProg+  exitCode `shouldBe` ExitSuccess+  err `shouldBe` ""+  out `shouldBe` "version\n"++  (out', err', exitCode') <- withStdIn ""+    $ withArgs ["--summary"]+    $ summaryProg+  exitCode' `shouldBe` ExitSuccess+  err' `shouldBe` ""+  out' `shouldBe` "A program summary\n"++  return ()+++simpleProg :: IO ()+simpleProg = do+  ((), ()) <- simpleOptions "version" "header" "desc" (pure ()) empty+  return ()++parserWithSummary :: Parser ()+parserWithSummary = summaryOption <*> pure () where+  summaryOption = infoOption "A program summary"+    $ long "summary"+   <> help "Show program summary"++summaryProg :: IO ()+summaryProg = do+  ((), ()) <- simpleOptions "version" "header" "desc" parserWithSummary empty+  return ()