ronn-optparse-applicative (empty) → 1.0.0.0
raw patch · 6 files changed
+284/−0 lines, 6 filesdep +basedep +hspecdep +optparse-applicative
Dependencies added: base, hspec, optparse-applicative, ronn, ronn-optparse-applicative, ronn-test, text
Files
- CHANGELOG.md +5/−0
- README.md +18/−0
- ronn-optparse-applicative.cabal +81/−0
- src/Ronn/Options/Applicative.hs +123/−0
- tests/Main.hs +10/−0
- tests/Ronn/Options/ApplicativeSpec.hs +47/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+## [_Unreleased_](https://github.com/pbrisbin/ronn/compare/ronn-optparse-applicative-v1.0.0.0...main)++## [v1.0.0.0](https://github.com/pbrisbin/ronn/tree/ronn-optparse-applicative-v1.0.0.0)++First tagged pre-release.
+ README.md view
@@ -0,0 +1,18 @@+# `ronn-optparse-applicative`++[](https://hackage.haskell.org/package/ronn-optparse-applicative)+[](http://stackage.org/nightly/package/ronn-optparse-applicative)+[](http://stackage.org/lts/package/ronn-optparse-applicative)++Automatically create a `Ronn` value from `Options.Applicative.Parser`.++## Usage++See [the test][test] and [the result][golden].++[test]: ./ronn-optparse-applicative/tests/Ronn/Options.Applicative.hs+[golden]: ./doc/ronn-optparse-applicative.1.ronn++---++[CHANGELOG](./ronn-optparse-applicative/CHANGELOG.md)
+ ronn-optparse-applicative.cabal view
@@ -0,0 +1,81 @@+cabal-version: 1.18+name: ronn-optparse-applicative+version: 1.0.0.0+license: AGPL-3+maintainer: Pat Brisbin+homepage: https://github.com/pbrisbin/ronn#readme+bug-reports: https://github.com/pbrisbin/ronn/issues+synopsis: Produce Ronn from OptEnvConf+description: Please see README.md+category: Documentation+build-type: Simple+extra-doc-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/pbrisbin/ronn++library+ exposed-modules: Ronn.Options.Applicative+ hs-source-dirs: src+ other-modules: Paths_ronn_optparse_applicative+ default-language: GHC2021+ default-extensions:+ DataKinds DeriveAnyClass DerivingStrategies DerivingVia+ DuplicateRecordFields GADTs LambdaCase NoFieldSelectors+ NoImplicitPrelude NoMonomorphismRestriction OverloadedRecordDot+ OverloadedStrings RecordWildCards TypeFamilies++ ghc-options:+ -fignore-optim-changes -fwrite-ide-info -Weverything+ -Wno-all-missed-specialisations -Wno-missing-exported-signatures+ -Wno-missing-import-lists -Wno-missing-kind-signatures+ -Wno-missing-local-signatures -Wno-missing-safe-haskell-mode+ -Wno-monomorphism-restriction -Wno-prepositive-qualified-module+ -Wno-safe -Wno-unsafe++ build-depends:+ base >=4.16.4.0 && <5,+ optparse-applicative >=0.17.1.0,+ ronn >=1.1.0.0,+ text >=1.2.5.0++ if impl(ghc >=9.8)+ ghc-options:+ -Wno-missing-role-annotations -Wno-missing-poly-kind-signatures++test-suite spec+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: tests+ other-modules:+ Ronn.Options.ApplicativeSpec+ Paths_ronn_optparse_applicative++ default-language: GHC2021+ default-extensions:+ DataKinds DeriveAnyClass DerivingStrategies DerivingVia+ DuplicateRecordFields GADTs LambdaCase NoFieldSelectors+ NoImplicitPrelude NoMonomorphismRestriction OverloadedRecordDot+ OverloadedStrings RecordWildCards TypeFamilies++ ghc-options:+ -fignore-optim-changes -fwrite-ide-info -Weverything+ -Wno-all-missed-specialisations -Wno-missing-exported-signatures+ -Wno-missing-import-lists -Wno-missing-kind-signatures+ -Wno-missing-local-signatures -Wno-missing-safe-haskell-mode+ -Wno-monomorphism-restriction -Wno-prepositive-qualified-module+ -Wno-safe -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N++ build-depends:+ base >=4.16.4.0 && <5,+ hspec >=2.9.7,+ optparse-applicative >=0.17.1.0,+ ronn-optparse-applicative,+ ronn-test++ if impl(ghc >=9.8)+ ghc-options:+ -Wno-missing-role-annotations -Wno-missing-poly-kind-signatures
+ src/Ronn/Options/Applicative.hs view
@@ -0,0 +1,123 @@+-- |+--+-- Module : Ronn.Options.Applicative+-- Copyright : (c) 2024 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Ronn.Options.Applicative+ ( optSynopsis+ , optDefinitions+ ) where++import Prelude++import Control.Monad (void)+import Data.List (intersperse, sortBy)+import Data.String (IsString (..))+import Data.Text (Text)+import Options.Applicative (Parser)+import Options.Applicative.Common (mapParser, treeMapParser)+import Options.Applicative.Help.Chunk (Chunk (..))+import Options.Applicative.Help.Pretty (Doc)+import Options.Applicative.Help.Pretty qualified as Pretty+import Options.Applicative.Types+ ( OptName (..)+ , OptProperties (..)+ , OptReader (..)+ , OptTree (..)+ , Option (..)+ )+import Ronn.AST++optSynopsis :: Parser a -> [Part]+optSynopsis = go False . treeMapParser (const void)+ where+ go :: Bool -> OptTree (Option ()) -> [Part]+ go nested = \case+ Leaf o -> [optSynopsisPart o]+ MultNode ts -> concatMap (go True) ts+ AltNode _ [Leaf o]+ | FlagReader {} <- optMain o -> [Brackets $ optSynopsisPart o] -- optional o+ | otherwise -> [optSynopsisPart o]+ AltNode _ ts ->+ [ (if nested then Parens else id) $+ Concat $+ intersperse " \\| " $+ concatMap (go True) ts+ ]+ BindNode t -> go True t++optSynopsisPart :: Option x -> Part+optSynopsisPart o = bracketize go+ where+ go = case optMain o of+ OptReader names _ _ ->+ let mv = propMetaVar $ optProps o+ in Concat $ intersperse "\\|" $ renderNames (Just mv) names+ FlagReader names _ ->+ Concat $ intersperse "\\|" $ renderNames Nothing names+ ArgReader {} ->+ case propShowDefault $ optProps o of+ Nothing -> Variable $ fromString $ propMetaVar $ optProps o+ Just {} -> Brackets $ fromString $ propMetaVar $ optProps o+ CmdReader {} -> "" -- TODO+ bracketize = case propShowDefault $ optProps o of+ Nothing -> id+ Just {} -> Brackets++optDefinitions :: Parser a -> [Definition]+optDefinitions = mapParser optDefinition++optDefinition :: a -> Option x -> Definition+optDefinition _ o =+ Definition+ { name = case optMain o of+ OptReader names _ _ ->+ let mv = propMetaVar $ optProps o+ in Concat $ intersperse ", " $ renderNames (Just mv) names+ FlagReader names _ ->+ Concat $ intersperse ", " $ renderNames Nothing names+ ArgReader {} -> Code $ fromString $ propMetaVar $ optProps o+ CmdReader {} -> undefined -- TODO+ , description =+ let+ help = Raw (docToText $ propHelp $ optProps o)+ suffix =+ maybe [] (pure . Parens . ("default " <>) . fromString) $+ propShowDefault $+ optProps o+ in+ Line $ help : suffix+ , content = Nothing+ }++docToText :: Chunk Doc -> Text+docToText =+ maybe+ ""+ ( Pretty.renderStrict+ . Pretty.layoutPretty Pretty.defaultLayoutOptions+ )+ . unChunk++renderNames :: Maybe String -> [OptName] -> [Part]+renderNames mArg = map (renderName mArg) . sortNames++renderName :: Maybe String -> OptName -> Part+renderName mArg = \case+ OptShort c -> Code $ fromString ['-', c]+ OptLong st -> addArg $ Code $ fromString $ "--" <> st+ where+ addArg :: Part -> Part+ addArg = case mArg of+ Nothing -> id+ Just arg -> Concat . (<> ["=", Variable $ fromString arg]) . pure++sortNames :: [OptName] -> [OptName]+sortNames = sortBy $ curry $ \case+ (OptShort a, OptShort b) -> compare a b+ (OptShort _, OptLong _) -> LT+ (OptLong a, OptLong b) -> compare a b+ (OptLong _, OptShort _) -> GT
+ tests/Main.hs view
@@ -0,0 +1,10 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -Wno-missing-export-lists #-}++-- |+--+-- Module : Main+-- Copyright : (c) 2024 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX
+ tests/Ronn/Options/ApplicativeSpec.hs view
@@ -0,0 +1,47 @@+{-# OPTIONS_GHC -Wno-orphans #-}++-- |+--+-- Module : Ronn.Options.ApplicativeSpec+-- Copyright : (c) 2024 Patrick Brisbin+-- License : AGPL-3+-- Maintainer : pbrisbin@gmail.com+-- Stability : experimental+-- Portability : POSIX+module Ronn.Options.ApplicativeSpec+ ( spec+ ) where++import Prelude++import Options.Applicative+import Ronn.Options.Applicative+import Ronn.Test+import Test.Hspec++instance HasSynopsis Parser where+ getSynopsis = Just . optSynopsis++instance HasOptDefinitions Parser where+ getOptDefinitions = Just . optDefinitions++instance HasEnvDefinitions Parser++spec :: Spec+spec = do+ specify "complete example" $+ ronnGolden "optparse-applicative" $+ (,,)+ <$> optional (switch (long "debug" <> help "Enable debug"))+ <*> option+ (str @String)+ ( mconcat+ [ short 'o'+ , long "output"+ , help "Output file"+ , metavar "FILE"+ , value "-"+ , showDefault+ ]+ )+ <*> argument (str @String) (help "Input file" <> metavar "INPUT")