hydrogen-util 0.7.1 → 0.8

raw patch · 6 files changed

+142/−22 lines, 6 filesdep ~hydrogen-preludePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hydrogen-prelude

API changes (from Hackage documentation)

Files

• README.md +0/−0
• hydrogen-util.cabal +9/−6
• src/Hydrogen/Util/CliArgs.hs +94/−0
• src/Hydrogen/Util/Parsec.hs +1/−0
• src/Hydrogen/Util/Parsec/Char.hs +21/−3
• src/Hydrogen/Util/Read.hs +17/−13

@@ -1,15 +1,15 @@ name:                 hydrogen-util-version:              0.7.1-homepage:             https://github.com/scravy/hydrogen-util+version:              0.8+homepage:             https://scravy.de/hydrogen-util/ synopsis:             Hydrogen Tools license:              BSD3 license-file:         LICENSE-extra-source-files:   CHANGELOG.md+extra-source-files:   CHANGELOG.md, README.md author:               Julian Fleischer-maintainer:           julfleischer@paypal.com+maintainer:           julian@scravy.de category:             Language build-type:           Simple-cabal-version:        >=1.18+cabal-version:        >=1.14  source-repository head     type:             git@@ -17,19 +17,22 @@  library   exposed-modules:    Hydrogen.Util+                      , Hydrogen.Util.CliArgs                       , Hydrogen.Util.Files                       , Hydrogen.Util.Parsec                       , Hydrogen.Util.Parsec.Char                       , Hydrogen.Util.Read   build-depends:      base ==4.7.*                       , containers ==0.5.*-                      , hydrogen-prelude ==0.7.1+                      , hydrogen-prelude ==0.8                       , parsec ==3.1.*                       , time ==1.4.*   hs-source-dirs:     src   ghc-options:        -Wall   default-language:   Haskell2010   default-extensions:  CPP+                       , DeriveDataTypeable+                       , DeriveGeneric                        , EmptyCase                        , FlexibleContexts                        , GADTs

@@ -0,0 +1,94 @@+module Hydrogen.Util.CliArgs (+    Option+  , switch+  , optarg+  , (~:)+  , getOpts+  , getOpts'+ ) where++import Hydrogen.Prelude.System+import qualified Data.Map as Map+import qualified Data.Set as Set++switch, optarg :: String -> Option++switch = OptSwitch+optarg = OptArg++(~:) :: Char -> Option -> Option+(~:) = OptShort++data Option =+    OptArg String+  | OptSwitch String+  | OptShort Char Option+  deriving (Eq, Show, Generic, Typeable)++isArg :: Option -> Bool+isArg = \case+    OptArg _ -> True+    OptShort _ x -> isArg x+    _ -> False++shorts :: Option -> [Char]+shorts = \case+    OptShort c xs -> c : shorts xs+    _ -> []++long :: Option -> String+long = \case+    OptArg x -> x+    OptSwitch x -> x+    OptShort _ xs -> long xs++getOpts :: [Option] -> IO (Map String String, Set String, [String])+getOpts opts = getOpts' opts <$> getArgs++getOpts' :: [Option] -> [String] -> (Map String String, Set String, [String])+getOpts' opts = readArgs Map.empty Set.empty++  where++    readArgs :: Map String String -> Set String -> [String]+        -> (Map String String, Set String, [String])+    readArgs args switches = \case+        x : xs+            | x =~ "^--[^-]" -> drop 2 x |> \case+                opt+                    | opt `elem` longArgs && not (null xs) -> readOptArg opt+                    | opt `elem` longSwitches -> readOptSwitch opt++                _ -> readArg++            | x =~ "^-[^-]$" -> x !! 1 |> \case+                shortOpt+                    | shortOpt `elem` shortArgs && not (null xs) -> readOptArg opt+                    | shortOpt `elem` shortSwitches -> readOptSwitch opt+                  where+                    opt = aliasMap ! shortOpt++                _ -> readArg++            | x == "--" -> (args, switches, xs)++            | otherwise -> readArg++          where+            readArg = (args', switches', x : xs')+            readOptArg opt = readArgs (Map.insert opt (head xs) args) switches (tail xs)+            readOptSwitch opt = readArgs args (Set.insert opt switches) xs+            (args', switches', xs') = readArgs args switches xs++        _ -> (args, switches, [])+            ++    (optArgs, optSwitches) = partition isArg opts+    +    (longArgs, longSwitches) = (map long optArgs, map long optSwitches)+    (shortArgs, shortSwitches) = (concatMap shorts optArgs, concatMap shorts optSwitches)+    +    aliasMap = foldr aliases Map.empty opts++    aliases opt = flip (foldr (flip Map.insert (long opt))) (shorts opt)+

@@ -3,6 +3,7 @@   , module Text.Parsec.Prim   , module Text.Parsec.Pos   , Parser+  , ParseError   , SomethingBad   , Tokens   , runTokenParser

@@ -17,6 +17,9 @@   , satisfy   , string   , number+  , positiveNumber+  , negativeNumber+  , decimal   , name   , name_   , keyword@@ -48,17 +51,32 @@ between' :: (Monad m, Stream s m Char) => Char -> Char -> ParsecT s u m t -> ParsecT s u m t between' a b = between (char a) (char b) +number, positiveNumber, negativeNumber+    :: (Monad m, Stream s m Char, Read a, Num a, Integral a) => ParsecT s u m a+ -- | Parses a negative or a positive number (indicated by an unary minus operator, does not accept an unary plus).-number :: (Monad m, Stream s m Char, Read a, Num a, Integral a) => ParsecT s u m a number = negativeNumber <|> positiveNumber  -- | Parses a positive integral number.-positiveNumber :: (Monad m, Stream s m Char, Read a, Num a, Integral a) => ParsecT s u m a positiveNumber = (read <$> many1 digit)  -- | Parses a negative integral number (indicated by an unary minus operator).-negativeNumber :: (Monad m, Stream s m Char, Read a, Num a, Integral a) => ParsecT s u m a negativeNumber = negate . read <$> (char '-' >> many1 digit)++decimal, positiveDecimal, negativeDecimal+    :: (Monad m, Stream s m Char, Read a, Num a, RealFrac a) => ParsecT s u m a++-- | Parses a decimal number+decimal = negativeDecimal <|> positiveDecimal++-- | Parses a positive decimal number+positiveDecimal = fst . head . readFloat <$> liftM2 (++) (many1 digit) (option "" (exp_ <|> digits))+  where+    digits = liftA2 (:) (char '.') (many1 digit)+    exp_ = concat <$> sequence [return <$> char 'e', option "" (string "-"), many1 digit]++-- | Parses a negative decimal number+negativeDecimal = negate <$> (char '-' >> positiveDecimal)  -- | Parses end of line, which maybe ('\n' or '\r' or "\r\n"). --

@@ -6,6 +6,23 @@  import Data.Time.Calendar.OrdinalDate ++tryRead :: (Monad m) => ReadS a -> String -> m a+tryRead p s = case p s of+    [(val, "")] -> return val+    [] -> fail "no parse"+    _ -> fail "ambiguous parse"++tryReads :: (Monad m, Read a) => String -> m a+tryReads = tryRead reads++firstJust :: [a -> Maybe b] -> a -> Maybe b+firstJust (f : fs) v = case f v of+    Nothing -> firstJust fs v+    x -> x+firstJust [] _ = Nothing++ ignoreUnderscores :: String -> String ignoreUnderscores = \case     x : xs -> x : ignore xs@@ -112,17 +129,4 @@     "False" -> return False     "FALSE" -> return False     _ -> Nothing--tryRead :: (Monad m) => ReadS a -> String -> m a-tryRead p s = case p s of-    [(val, "")] -> return val-    [] -> fail "no parse"-    _ -> fail "ambiguous parse"--firstJust :: [a -> Maybe b] -> a -> Maybe b-firstJust (f : fs) v = case f v of-    Nothing -> firstJust fs v-    x -> x-firstJust [] _ = Nothing-