getopt-generics 0.2 → 0.3

raw patch · 3 files changed

+64/−34 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• getopt-generics.cabal +1/−1
• src/System/Console/GetOpt/Generics.hs +15/−8
• src/System/Console/GetOpt/Generics/Modifier.hs +48/−25

@@ -1,6 +1,6 @@ -- This file has been generated from package.yaml by Cabalize. name: getopt-generics-version: 0.2+version: 0.3 synopsis: Simple command line argument parsing description:   "getopt-generics" tries to make it very simple to create command line argument parsers. An introductory example can be found in the <https://github.com/zalora/getopt-generics#getopt-generics README>.

@@ -10,6 +10,7 @@ {-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE TypeFamilies          #-} {-# LANGUAGE TypeSynonymInstances  #-}+{-# LANGUAGE ViewPatterns          #-}  {-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-} @@ -20,6 +21,7 @@ module System.Console.GetOpt.Generics (   -- * IO API   getArguments,+  modifiedGetArguments,   -- * Pure API   parseArguments,   Result(..),@@ -57,10 +59,15 @@ --     with exit-code @0@.) Help output is written to @stdout@. getArguments :: forall a . (Generic a, HasDatatypeInfo a, All2 Option (Code a)) =>   IO a-getArguments = do+getArguments = modifiedGetArguments []++-- | Like 'getArguments` but allows you to pass in 'Modifier's.+modifiedGetArguments :: forall a . (Generic a, HasDatatypeInfo a, All2 Option (Code a)) =>+  [Modifier] -> IO a+modifiedGetArguments modifiers = do   args <- getArgs   progName <- getProgName-  case parseArguments progName [] args of+  case parseArguments progName modifiers args of     Success a -> return a     OutputAndExit message -> do       putStrLn message@@ -91,7 +98,7 @@ --   Does not throw any exceptions. parseArguments :: forall a . (Generic a, HasDatatypeInfo a, All2 Option (Code a)) =>   String -> [Modifier] -> [String] -> Result a-parseArguments header modifiers args = case normalizedDatatypeInfo (Proxy :: Proxy a) of+parseArguments header (mkModifiers -> modifiers) args = case normalizedDatatypeInfo (Proxy :: Proxy a) of     ADT typeName _ (constructorInfo :* Nil) ->       case constructorInfo of         (Record _ fields) -> processFields header modifiers args fields@@ -112,7 +119,7 @@       Errors ["getopt-generics doesn't support " ++ message ++ " (" ++ typeName ++ ")."]  processFields :: forall a xs . (Generic a, Code a ~ '[xs], SingI xs, All Option xs) =>-  String -> [Modifier] -> [String] -> NP FieldInfo xs -> Result a+  String -> Modifiers -> [String] -> NP FieldInfo xs -> Result a processFields header modifiers args fields =   helpWrapper header modifiers args fields $   fmap (to . SOP . Z) $@@ -135,17 +142,17 @@     ignoreRight = either id (const mempty)  mkOptDescrs :: forall xs . All Option xs =>-  [Modifier] -> NP FieldInfo xs -> [OptDescr (NS FieldState xs)]+  Modifiers -> NP FieldInfo xs -> [OptDescr (NS FieldState xs)] mkOptDescrs modifiers fields =   map toOptDescr $ sumList $ npMap (mkOptDescr modifiers) fields  newtype OptDescrE a = OptDescrE (OptDescr (FieldState a)) -mkOptDescr :: forall a . Option a => [Modifier] -> FieldInfo a -> OptDescrE a+mkOptDescr :: forall a . Option a => Modifiers -> FieldInfo a -> OptDescrE a mkOptDescr modifiers (FieldInfo name) = OptDescrE $   Option     (mkShortOptions modifiers name)-    (mkLongOptions modifiers name)+    [mkLongOption modifiers name]     _toOption     "" @@ -167,7 +174,7 @@ data HelpFlag = HelpFlag  helpWrapper :: (All Option xs) =>-  String -> [Modifier] -> [String] -> NP FieldInfo xs -> Either [String] a -> Result a+  String -> Modifiers -> [String] -> NP FieldInfo xs -> Either [String] a -> Result a helpWrapper header modifiers args fields result =     case getOpt Permute [helpOption] args of       ([], _, _) -> case result of

@@ -3,12 +3,18 @@  module System.Console.GetOpt.Generics.Modifier (   Modifier(..),-  deriveShortOptions,+  Modifiers,+  mkModifiers,   mkShortOptions,-  mkLongOptions,+  mkLongOption,++  deriveShortOptions,++  -- exported for testing+  insertWith,  ) where -import           Data.List+import           Data.List                               (foldl', isPrefixOf) import           Data.Maybe import           Generics.SOP @@ -24,6 +30,32 @@     --   through the @fieldName@ by @customName@.   deriving (Show, Eq, Ord) +data Modifiers = Modifiers {+  _shortOptions :: [(String, [Char])],+  _renamings :: [(String, String)]+ }++mkModifiers :: [Modifier] -> Modifiers+mkModifiers = foldl' inner (Modifiers [] [])+  where+    inner :: Modifiers -> Modifier -> Modifiers+    inner (Modifiers shorts renamings) (AddShortOption option short) =+      Modifiers+        (insertWith (++) (slugify option) [short] shorts)+        renamings+    inner (Modifiers shorts renamings) (RenameOption from to) =+      Modifiers shorts (insert (slugify from) to renamings)++mkShortOptions :: Modifiers -> String -> [Char]+mkShortOptions (Modifiers shortMap _) option =+    fromMaybe [] (lookup option shortMap)++mkLongOption :: Modifiers -> String -> String+mkLongOption (Modifiers _ renamings) option =+  fromMaybe option (lookup option renamings)++-- * deriving Modifiers+ -- | Derives 'AddShortOption's for all fields of the datatype that start with a --   unique character. deriveShortOptions :: (HasDatatypeInfo a, SingI (Code a)) =>@@ -63,27 +95,18 @@         _ -> Nothing     inner [] = Nothing -mkShortOptions :: [Modifier] -> String -> [Char]-mkShortOptions modifiers option =-    mapMaybe inner modifiers-  where-    inner :: Modifier -> Maybe Char-    inner (AddShortOption modifierOption short)-      | matchesField modifierOption option-        = Just short-      | otherwise-        = Nothing-    inner _ = Nothing+-- * list utils to replace Data.Map -mkLongOptions :: [Modifier] -> String -> [String]-mkLongOptions modifiers option =-    inner (reverse modifiers)-  where-    inner (RenameOption renameOption newName : _)-      | renameOption `matchesField` option = [newName]-    inner [] = [option]-    inner (_ : r) = inner r+insertWith :: Eq a => (b -> b -> b) -> a -> b -> [(a, b)] -> [(a, b)]+insertWith _ key value [] = [(key, value)]+insertWith combine key value ((a, b) : r) =+  if a == key+    then (key, b `combine` value) : r+    else (a, b) : insertWith combine key value r -matchesField :: String -> String -> Bool-matchesField modifierOption option =-  modifierOption == option || slugify modifierOption == option+insert :: Eq a => a -> b -> [(a, b)] -> [(a, b)]+insert key value [] = [(key, value)]+insert key value ((a, b) : r) =+  if a == key+    then (key, value) : r+    else (a, b) : insert key value r