Hello community,
here is the log from the commit of package ghc-optparse-generic for
openSUSE:Factory checked in at 2017-05-06 18:28:48
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-optparse-generic (Old)
and /work/SRC/openSUSE:Factory/.ghc-optparse-generic.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-optparse-generic"
Sat May 6 18:28:48 2017 rev:3 rq:491481 version:1.1.5
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-optparse-generic/ghc-optparse-generic.changes
2017-03-03 17:51:22.403167600 +0100
+++
/work/SRC/openSUSE:Factory/.ghc-optparse-generic.new/ghc-optparse-generic.changes
2017-05-06 18:28:49.678199194 +0200
@@ -1,0 +2,5 @@
+Wed Apr 19 13:32:37 UTC 2017 - [email protected]
+
+- Update to version 1.1.5 with cabal2obs.
+
+-------------------------------------------------------------------
Old:
----
optparse-generic-1.1.4.tar.gz
New:
----
optparse-generic-1.1.5.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-optparse-generic.spec ++++++
--- /var/tmp/diff_new_pack.7VsmuQ/_old 2017-05-06 18:28:50.710053594 +0200
+++ /var/tmp/diff_new_pack.7VsmuQ/_new 2017-05-06 18:28:50.714053029 +0200
@@ -18,7 +18,7 @@
%global pkg_name optparse-generic
Name: ghc-%{pkg_name}
-Version: 1.1.4
+Version: 1.1.5
Release: 0
Summary: Auto-generate a command-line parser for your datatype
License: BSD-3-Clause
++++++ optparse-generic-1.1.4.tar.gz -> optparse-generic-1.1.5.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/optparse-generic-1.1.4/optparse-generic.cabal
new/optparse-generic-1.1.5/optparse-generic.cabal
--- old/optparse-generic-1.1.4/optparse-generic.cabal 2016-12-20
07:26:29.000000000 +0100
+++ new/optparse-generic-1.1.5/optparse-generic.cabal 2017-04-12
18:32:44.000000000 +0200
@@ -1,5 +1,5 @@
Name: optparse-generic
-Version: 1.1.4
+Version: 1.1.5
Cabal-Version: >=1.8.0.2
Build-Type: Simple
License: BSD3
@@ -27,7 +27,7 @@
system-filepath >= 0.3.1 && < 0.5 ,
text < 1.3 ,
transformers >= 0.2.0.0 && < 0.6 ,
- optparse-applicative >= 0.11.0 && < 0.14,
+ optparse-applicative >= 0.12.0 && < 0.14,
time >= 1.5 && < 1.7 ,
void < 0.8 ,
bytestring < 0.11,
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/optparse-generic-1.1.4/src/Options/Generic.hs
new/optparse-generic-1.1.5/src/Options/Generic.hs
--- old/optparse-generic-1.1.4/src/Options/Generic.hs 2016-12-20
07:26:29.000000000 +0100
+++ new/optparse-generic-1.1.5/src/Options/Generic.hs 2017-04-12
18:32:44.000000000 +0200
@@ -1,12 +1,16 @@
+{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
-- | This library auto-generates command-line parsers for data types using
@@ -86,6 +90,36 @@
-- > $ stack runghc Example.hs -- --foo 1 --bar 2.5
-- > Example {foo = Helpful {unHelpful = 1}, bar = Helpful {unHelpful = 2.5}}
--
+-- To avoid this, while still being able to document your fields, you may
+-- generalize the definition of your record with a parameter 'w', and use
+-- 'unwrapRecord'.
+--
+-- > {-# LANGUAGE DataKinds #-}
+-- > {-# LANGUAGE DeriveGeneric #-}
+-- > {-# LANGUAGE FlexibleInstances #-} -- One more extension.
+-- > {-# LANGUAGE OverloadedStrings #-}
+-- > {-# LANGUAGE StandaloneDeriving #-} -- To derive Show
+-- > {-# LANGUAGE TypeOperators #-}
+-- >
+-- > import Options.Generic
+-- >
+-- > data Example w = Example
+-- > { foo :: w ::: Int <?> "Documentation for the foo flag"
+-- > , bar :: w ::: Double <?> "Documentation for the bar flag"
+-- > } deriving (Generic)
+-- >
+-- > instance ParseRecord (Example Wrapped)
+-- > deriving instance Show (Example Unwrapped)
+-- >
+-- > main = do
+-- > x <- unwrapRecord "Test program"
+-- > print (x :: Example Unwrapped)
+--
+-- @Example Unwrapped@ is equivalent to a record type with simple fields:
+--
+-- > $ stack runghc Example.hs -- --foo 1 --bar 2.5
+-- > Example {foo = 1, bar = 2.5}
+--
-- For the following examples I encourage you to test what @--help@ output they
-- generate.
--
@@ -208,6 +242,8 @@
-- * Parsers
getRecord
, getRecordPure
+ , unwrapRecord
+ , unwrapRecordPure
, ParseRecord(..)
, ParseFields(..)
, ParseField(..)
@@ -216,9 +252,14 @@
, Modifiers(..)
, parseRecordWithModifiers
, defaultModifiers
+ , lispCaseModifiers
-- * Help
, type (<?>)(..)
+ , type (:::)
+ , Wrapped
+ , Unwrapped
+ , Unwrappable
-- * Re-exports
, Generic
@@ -233,7 +274,7 @@
import Control.Applicative
import Control.Monad.IO.Class (MonadIO(..))
-import Data.Char (toLower, toUpper)
+import Data.Char (isUpper, toLower, toUpper)
import Data.Monoid
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.Proxy
@@ -613,6 +654,22 @@
defaultModifiers :: Modifiers
defaultModifiers = Modifiers id (map toLower)
+-- | Convert field and constructor names from @CamelCase@ to @lisp-case@.
+--
+-- Leading underscores are dropped, allowing one to use option names
+-- which are Haskell keywords or otherwise conflicting identifiers.
+--
+-- > BuildCommand -> build-command
+-- > someFlag -> --some-flag
+-- > _type -> --type
+-- > _splitAt -> --split-at
+lispCaseModifiers :: Modifiers
+lispCaseModifiers = Modifiers lispCase lispCase
+ where
+ lispCase = dropWhile (== '-') . (>>= lower) . dropWhile (== '_')
+ lower c | isUpper c = ['-', toLower c]
+ | otherwise = [c]
+
class GenericParseRecord f where
genericParseRecord :: Modifiers -> Parser (f p)
@@ -783,14 +840,9 @@
=> Text
-- ^ Program description
-> io a
-getRecord desc = liftIO (Options.customExecParser prefs info)
+getRecord desc = liftIO (Options.customExecParser defaultParserPrefs info)
where
- prefs = Options.defaultPrefs
- { Options.prefMultiSuffix = "..."
- }
-
header = Options.header (Data.Text.unpack desc)
-
info = Options.info parseRecord header
{-| Pure version of `getRecord`
@@ -809,18 +861,71 @@
-- ^ Command-line arguments
-> Maybe a
getRecordPure args = do
- let prefs = Options.ParserPrefs
- { prefMultiSuffix = "..."
- , prefDisambiguate = False
- , prefShowHelpOnError = False
- , prefBacktrack = True
- , prefColumns = 80
-#if MIN_VERSION_optparse_applicative(0,13,0)
- , prefShowHelpOnEmpty = False
-#else
-#endif
- }
let header = Options.header ""
let info = Options.info parseRecord header
let args' = map Data.Text.unpack args
- Options.getParseResult (Options.execParserPure prefs info args')
+ Options.getParseResult (Options.execParserPure defaultParserPrefs info
args')
+
+-- | @optparse-generic@'s flavor of options.
+defaultParserPrefs :: Options.ParserPrefs
+defaultParserPrefs = Options.defaultPrefs
+ { Options.prefMultiSuffix = "..."
+ }
+
+-- | A type family to extract fields wrapped using '(<?>)'
+type family (:::) wrap wrapped
+type instance Wrapped ::: wrapped = wrapped
+type instance Unwrapped ::: (field <?> helper) = field
+
+infixr 0 :::
+
+-- | Flag to keep fields wrapped
+data Wrapped
+
+-- | Flag to unwrap fields annotated using '(<?>)'
+data Unwrapped
+
+-- | Constraint for types whose fields can be unwrapped
+type Unwrappable f = (Generic (f Wrapped), Generic (f Unwrapped),
GenericUnwrappable (Rep (f Wrapped)) (Rep (f Unwrapped)))
+
+class GenericUnwrappable f f' where
+ genericUnwrap :: f p -> f' p
+
+instance GenericUnwrappable U1 U1 where
+ genericUnwrap = id
+
+instance GenericUnwrappable f f' => GenericUnwrappable (M1 i c f) (M1 i c f')
where
+ genericUnwrap = M1 . genericUnwrap . unM1
+
+instance (GenericUnwrappable f f', GenericUnwrappable g g') =>
GenericUnwrappable (f :+: g) (f' :+: g') where
+ genericUnwrap (L1 f) = L1 (genericUnwrap f)
+ genericUnwrap (R1 g) = R1 (genericUnwrap g)
+
+instance (GenericUnwrappable f f', GenericUnwrappable g g') =>
GenericUnwrappable (f :*: g) (f' :*: g') where
+ genericUnwrap (f :*: g) = genericUnwrap f :*: genericUnwrap g
+
+instance GenericUnwrappable (K1 i c) (K1 i c) where
+ genericUnwrap = id
+
+instance GenericUnwrappable (K1 i (field <?> helper)) (K1 i field) where
+ genericUnwrap (K1 c) = K1 (unHelpful c)
+
+-- | Unwrap the fields of a constructor
+unwrap :: forall f . Unwrappable f => f Wrapped -> f Unwrapped
+unwrap = to . genericUnwrap . from
+
+-- | Marshal any value that implements 'ParseRecord' from the command line
+-- and unwrap its fields
+unwrapRecord
+ :: (Functor io, MonadIO io, ParseRecord (f Wrapped), Unwrappable f)
+ => Text
+ -> io (f Unwrapped)
+unwrapRecord = fmap unwrap . getRecord
+
+-- | Pure version of `unwrapRecord`
+unwrapRecordPure
+ :: (ParseRecord (f Wrapped), Unwrappable f)
+ => [Text]
+ -- ^ Command-line arguments
+ -> Maybe (f Unwrapped)
+unwrapRecordPure = fmap unwrap . getRecordPure
