summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorOmariNorman <>2013-09-12 20:59:23 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2013-09-12 20:59:23 (GMT)
commitda870b71db40cda6be98b091cb3ecb918bf98344 (patch)
tree9da1ce9ad97e2207c19f7d67af5fbfb99649f9e7
parentb67cc94075608a507ece9ef4146b00aa5c3f4d55 (diff)
version 0.30.0.00.30.0.0
-rw-r--r--lib/Penny/Brenner.hs2
-rw-r--r--lib/Penny/Brenner/Import.hs2
-rw-r--r--lib/Penny/Cabin/Balance/Convert/Parser.hs6
-rw-r--r--lib/Penny/Cabin/Posts/Parser.hs89
-rw-r--r--lib/Penny/Liberty.hs123
-rw-r--r--lib/Penny/Wheat.hs6
-rw-r--r--lib/Penny/Zinc.hs28
-rw-r--r--penny.cabal45
8 files changed, 151 insertions, 150 deletions
diff --git a/lib/Penny/Brenner.hs b/lib/Penny/Brenner.hs
index f0ef940..97d9bc3 100644
--- a/lib/Penny/Brenner.hs
+++ b/lib/Penny/Brenner.hs
@@ -62,7 +62,7 @@ globalOpts
-> MA.Opts GetHelp Y.FitAcctName
globalOpts v = MA.optsHelpVersion help (Ly.version v)
[ MA.OptSpec ["fit-account"] "f"
- (MA.OneArg (Y.FitAcctName . X.pack))
+ (MA.OneArg (return . Y.FitAcctName . X.pack))
]
-- | Pre-processes global options for a pre-compiled configuration.
diff --git a/lib/Penny/Brenner/Import.hs b/lib/Penny/Brenner/Import.hs
index f4c76f5..3541893 100644
--- a/lib/Penny/Brenner/Import.hs
+++ b/lib/Penny/Brenner/Import.hs
@@ -42,7 +42,7 @@ mode mayFa = MA.modeHelp
where
opts =
[ MA.OptSpec ["new"] "n" (MA.NoArg AAllowNew)
- , MA.OptSpec ["unumber"] "u" . MA.OneArgE $ \s -> do
+ , MA.OptSpec ["unumber"] "u" . MA.OneArg $ \s -> do
i <- MA.reader s
return $ AUNumber i
]
diff --git a/lib/Penny/Cabin/Balance/Convert/Parser.hs b/lib/Penny/Cabin/Balance/Convert/Parser.hs
index b00455a..7a9aaf9 100644
--- a/lib/Penny/Cabin/Balance/Convert/Parser.hs
+++ b/lib/Penny/Cabin/Balance/Convert/Parser.hs
@@ -62,7 +62,7 @@ parseZeroBalances = fmap f P.zeroBalances
parseCommodity :: C.OptSpec (Opts -> Opts)
-parseCommodity = C.OptSpec ["commodity"] "c" (C.OneArgE f)
+parseCommodity = C.OptSpec ["commodity"] "c" (C.OneArg f)
where
f a1 =
case Parsec.parse Pc.lvl1Cmdty "" (X.pack a1) of
@@ -75,7 +75,7 @@ parseAuto = C.OptSpec ["auto-commodity"] "" (C.NoArg f)
f os = os { target = AutoTarget }
parseDate :: C.OptSpec (Opts -> Opts)
-parseDate = C.OptSpec ["date"] "d" (C.OneArgE f)
+parseDate = C.OptSpec ["date"] "d" (C.OneArg f)
where
f a1 =
case Parsec.parse Pc.dateTime "" (X.pack a1) of
@@ -101,7 +101,7 @@ parsePct = C.OptSpec ["percent"] "%" (C.NoArg f)
++ "error: zero is not non-negative"
parseRound :: C.OptSpec (Opts -> Opts)
-parseRound = C.OptSpec ["round"] "r" (C.OneArgE f)
+parseRound = C.OptSpec ["round"] "r" (C.OneArg f)
where
f a = do
i <- C.reader a
diff --git a/lib/Penny/Cabin/Posts/Parser.hs b/lib/Penny/Cabin/Posts/Parser.hs
index 832d4ff..e458923 100644
--- a/lib/Penny/Cabin/Posts/Parser.hs
+++ b/lib/Penny/Cabin/Posts/Parser.hs
@@ -54,21 +54,23 @@ allSpecs
:: S.Runtime -> [MA.OptSpec (State -> Either Error State)]
allSpecs rt =
operand rt
- ++ boxFilters
- ++ parsePostFilter
- ++ (map (fmap (pure .)) matcherSelect)
- ++ (map (fmap (pure .)) caseSelect)
- ++ (map (fmap (pure .)) operator)
- ++ map (fmap (pure .)) parseExprType
- ++ [ parseWidth
+ ++ listToErr boxFilters
+ ++ listToErr parsePostFilter
+ ++ listToErr matcherSelect
+ ++ listToErr caseSelect
+ ++ listToErr operator
+ ++ listToErr parseExprType
+ ++ listToErr [ parseWidth
, showField
, hideField
- , fmap (pure .) showAllFields
- , fmap (pure .) hideAllFields
- , fmap (pure .) parseZeroBalances
- , fmap (pure .) parseShowExpression
- , fmap (pure .) parseVerboseFilter
+ , showAllFields
+ , hideAllFields
+ , parseZeroBalances
+ , parseShowExpression
+ , parseVerboseFilter
]
+ where
+ listToErr = map (fmap (fmap return))
operand
@@ -93,40 +95,40 @@ optBoxSerial
-> (Ly.LibertyMeta -> Int)
-- ^ Pulls the serial from the PostMeta
- -> C.OptSpec (State -> Either Error State)
+ -> C.OptSpec (State -> State)
optBoxSerial nm f = C.OptSpec [nm] "" (C.TwoArg g)
where
- g a1 a2 st = do
- i <- Ly.parseInt a2
+ g a1 a2 = do
+ i <- Ly.parseIntMA a2
let getPd = Pt.compareBy (X.pack . show $ i)
("serial " <> X.pack nm) cmp
cmp l = compare (f . fst $ l) i
pd <- Ly.parseComparer a1 getPd
let tok = Exp.operand pd
- return $ st { tokens = tokens st ++ [tok] }
+ return $ \st -> st { tokens = tokens st ++ [tok] }
-optFilteredNum :: C.OptSpec (State -> Either Error State)
+optFilteredNum :: C.OptSpec (State -> State)
optFilteredNum = optBoxSerial "filtered" f
where
f = L.forward . Ly.unFilteredNum . Ly.filteredNum
-optRevFilteredNum :: C.OptSpec (State -> Either Error State)
+optRevFilteredNum :: C.OptSpec (State -> State)
optRevFilteredNum = optBoxSerial "revFiltered" f
where
f = L.backward . Ly.unFilteredNum . Ly.filteredNum
-optSortedNum :: C.OptSpec (State -> Either Error State)
+optSortedNum :: C.OptSpec (State -> State)
optSortedNum = optBoxSerial "sorted" f
where
f = L.forward . Ly.unSortedNum . Ly.sortedNum
-optRevSortedNum :: C.OptSpec (State -> Either Error State)
+optRevSortedNum :: C.OptSpec (State -> State)
optRevSortedNum = optBoxSerial "revSorted" f
where
f = L.backward . Ly.unSortedNum . Ly.sortedNum
-boxFilters :: [C.OptSpec (State -> Either Error State)]
+boxFilters :: [C.OptSpec (State -> State)]
boxFilters =
[ optFilteredNum
, optRevFilteredNum
@@ -135,13 +137,11 @@ boxFilters =
]
-parsePostFilter :: [C.OptSpec (State -> Either Error State)]
+parsePostFilter :: [C.OptSpec (State -> State)]
parsePostFilter = [fmap f optH, fmap f optT]
where
(optH, optT) = Ly.postFilterSpecs
- f exc st = fmap g exc
- where
- g pff = st { postFilter = postFilter st ++ [pff] }
+ f pff st = st { postFilter = postFilter st ++ [pff] }
matcherSelect :: [C.OptSpec (State -> State)]
@@ -160,14 +160,14 @@ operator = map (fmap f) Ly.operatorSpecs
where
f oo st = st { tokens = tokens st ++ [oo] }
-parseWidth :: C.OptSpec (State -> Either Error State)
+parseWidth :: C.OptSpec (State -> State)
parseWidth = C.OptSpec ["width"] "" (C.OneArg f)
where
- f a1 st = do
- i <- Ly.parseInt a1
- return $ st { width = Ty.ReportWidth i }
+ f a1 = do
+ i <- Ly.parseIntMA a1
+ return $ \st -> st { width = Ty.ReportWidth i }
-parseField :: String -> Either Error (F.Fields Bool)
+parseField :: String -> Either MA.InputError (F.Fields Bool)
parseField str =
let lower = map toLower str
checkField s =
@@ -177,11 +177,11 @@ parseField str =
flds = checkField <$> F.fieldNames
in case checkFields flds of
Left e -> case e of
- NoMatchingFields -> Left
- $ "no field matches the name \"" <> X.pack str <> "\"\n"
- MultipleMatchingFields ts -> Left
- $ "multiple fields match the name \"" <> X.pack str
- <> "\" matches: " <> mtchs <> "\n"
+ NoMatchingFields -> Left . MA.ErrorMsg
+ $ "no matching fields"
+ MultipleMatchingFields ts -> Left . MA.ErrorMsg
+ $ "multiple matching fields: "
+ <> X.unpack mtchs <> "\n"
where
mtchs = X.intercalate " "
. map (\x -> "\"" <> x <> "\"")
@@ -220,21 +220,24 @@ fieldOff old new = f <$> old <*> new
f o False = o
f _ True = False
-showField :: C.OptSpec (State -> Either Error State)
+showField :: C.OptSpec (State -> State)
showField = C.OptSpec ["show"] "" (C.OneArg f)
where
- f a1 st = do
+ f a1 = do
fl <- parseField a1
- let newFl = fieldOn (fields st) fl
- return $ st { fields = newFl }
+ return $ \st ->
+ let newFl = fieldOn (fields st) fl
+ in st { fields = newFl }
+
-hideField :: C.OptSpec (State -> Either Error State)
+hideField :: C.OptSpec (State -> State)
hideField = C.OptSpec ["hide"] "" (C.OneArg f)
where
- f a1 st = do
+ f a1 = do
fl <- parseField a1
- let newFl = fieldOff (fields st) fl
- return $ st { fields = newFl }
+ return $ \st ->
+ let newFl = fieldOff (fields st) fl
+ in st { fields = newFl }
showAllFields :: C.OptSpec (State -> State)
showAllFields = C.OptSpec ["show-all"] "" (C.NoArg f)
diff --git a/lib/Penny/Liberty.hs b/lib/Penny/Liberty.hs
index 2da6f59..f60b96f 100644
--- a/lib/Penny/Liberty.hs
+++ b/lib/Penny/Liberty.hs
@@ -22,6 +22,7 @@ module Penny.Liberty (
processPostFilters,
parsePredicate,
parseInt,
+ parseIntMA,
parseInfix,
parseRPN,
exprDesc,
@@ -59,8 +60,10 @@ import qualified Data.Text as X
import qualified Data.Text.IO as TIO
import qualified Data.Time as Time
import qualified System.Console.MultiArg as MA
+import System.Console.MultiArg (InputError(..))
import qualified System.Console.MultiArg.Combinator as C
import System.Console.MultiArg.Combinator (OptSpec)
+import Text.Read (readMaybe)
import Text.Parsec (parse)
import qualified Penny.Copper.Parsec as Pc
@@ -225,25 +228,26 @@ getMatcher s cs f
parseComparer
:: String
-> (Ordering -> E.Pdct a)
- -> Either Error (E.Pdct a)
-parseComparer s f = maybe (Left ("bad comparer: " <> pack s <> "\n"))
- Right $ E.parseComparer (pack s) f
+ -> Either InputError (E.Pdct a)
+parseComparer s f
+ = maybe (Left . MA.ErrorMsg $ "bad comparer")
+ Right $ E.parseComparer (pack s) f
-- | Parses a date from the command line. On failure, throws back the
-- error message from the failed parse.
-parseDate :: String -> Either Error Time.UTCTime
+parseDate :: String -> Either InputError Time.UTCTime
parseDate arg =
either (Left . err) (Right . L.toUTC)
. parse Pc.dateTime ""
. pack
$ arg
where
- err msg = "bad date: \"" <> pack arg <> "\" - " <> (pack . show $ msg)
+ err msg = MA.ErrorMsg $ "bad date - " <> show msg
type Operand = E.Pdct L.Posting
-- | OptSpec for a date.
-date :: OptSpec (Either Error Operand)
+date :: OptSpec Operand
date = C.OptSpec ["date"] ['d'] (C.TwoArg f)
where
f a1 a2 = do
@@ -259,10 +263,15 @@ current dt = C.OptSpec ["current"] [] (C.NoArg f)
-- | Parses exactly one integer; fails if it cannot read exactly one.
parseInt :: String -> Either Error Int
parseInt t =
- case reads t of
- ((i, ""):[]) -> return i
- _ -> Left $ "could not parse integer: \"" <> pack t <> "\"\n"
+ case readMaybe t of
+ Just i -> return i
+ _ -> Left $ "could not parse integer: \"" <> pack t <> "\""
+
+parseIntMA :: String -> Either MA.InputError Int
+parseIntMA t
+ = maybe (Left (ErrorMsg "could not parse integer")) Right
+ $ readMaybe t
-- | Creates options that add an operand that matches the posting if a
-- particluar field matches the pattern given.
@@ -282,7 +291,7 @@ patternOption ::
patternOption str mc f = C.OptSpec [str] so (C.OneArg g)
where
so = maybe [] (:[]) mc
- g a1 cs fty = f <$> getMatcher a1 cs fty
+ g a1 = return $ \cs fty -> f <$> getMatcher a1 cs fty
-- | The account option; matches if the pattern given matches the
@@ -292,9 +301,7 @@ account :: OptSpec ( CaseSensitive
-> Either Error Operand )
account = C.OptSpec ["account"] "a" (C.OneArg f)
where
- f a1 cs fty
- = fmap P.account
- $ getMatcher a1 cs fty
+ f a1 = return $ \cs fty -> fmap P.account (getMatcher a1 cs fty)
-- | The account-level option; matches if the account at the given
@@ -304,8 +311,8 @@ accountLevel :: OptSpec ( CaseSensitive
-> Either Error Operand)
accountLevel = C.OptSpec ["account-level"] "" (C.TwoArg f)
where
- f a1 a2 cs fty
- = P.accountLevel <$> parseInt a1 <*> getMatcher a2 cs fty
+ f a1 a2 = return $ \cs fty ->
+ P.accountLevel <$> parseInt a1 <*> getMatcher a2 cs fty
-- | The accountAny option; returns True if the matcher given matches
@@ -364,14 +371,14 @@ debit = C.OptSpec ["debit"] [] (C.NoArg P.debit)
credit :: OptSpec Operand
credit = C.OptSpec ["credit"] [] (C.NoArg P.credit)
-qtyOption :: OptSpec (Either Error Operand)
+qtyOption :: OptSpec Operand
qtyOption = C.OptSpec ["qty"] "q" (C.TwoArg f)
where
f a1 a2 = do
qt <- parseQty a2
parseComparer a1 (flip P.qty qt)
parseQty a = case parse Pc.unquotedQtyRepWithSpaces "" (pack a) of
- Left _ -> Left $ "failed to parse quantity"
+ Left _ -> Left . ErrorMsg $ "failed to parse quantity"
Right g -> pure . L.toQty $ g
@@ -386,8 +393,8 @@ serialOption ::
-> String
-- ^ Name of the command line option, such as @global-transaction@
- -> ( OptSpec (Either Error Operand)
- , OptSpec (Either Error Operand) )
+ -> ( OptSpec Operand
+ , OptSpec Operand )
-- ^ Parses both descending and ascending serial options.
serialOption getSerial n = (osA, osD)
@@ -398,7 +405,7 @@ serialOption getSerial n = (osA, osD)
in C.OptSpec [name] []
(C.TwoArg (f name L.backward))
f name getInt a1 a2 = do
- num <- parseInt a2
+ num <- parseIntMA a2
let getPdct = E.compareByMaybe (pack . show $ num) (pack name) cmp
cmp l = case getSerial l of
Nothing -> Nothing
@@ -418,8 +425,8 @@ siblingSerialOption
-> (Int -> Ordering -> E.Pdct L.Posting)
-- ^ Function that returns a Pdct for reverse serial
- -> ( OptSpec (Either Error Operand)
- , OptSpec (Either Error Operand) )
+ -> ( OptSpec Operand
+ , OptSpec Operand )
-- ^ Parses both descending and ascending serial options.
siblingSerialOption n fFwd fBak = (osA, osD)
@@ -428,7 +435,7 @@ siblingSerialOption n fFwd fBak = (osA, osD)
osD = let name = addPrefix "rev" n
in C.OptSpec ["s-" ++ name] [] (C.TwoArg (f fBak))
f getPdct a1 a2 = do
- num <- parseInt a2
+ num <- parseIntMA a2
parseComparer a1 (getPdct num)
@@ -441,26 +448,26 @@ addPrefix pre suf = pre ++ suf' where
"" -> ""
x:xs -> toUpper x : xs
-globalTransaction :: ( OptSpec (Either Error Operand)
- , OptSpec (Either Error Operand) )
+globalTransaction :: ( OptSpec Operand
+ , OptSpec Operand )
globalTransaction =
let f = fmap L.unGlobalTransaction . Q.globalTransaction
in serialOption f "globalTransaction"
-globalPosting :: ( OptSpec (Either Error Operand)
- , OptSpec (Either Error Operand) )
+globalPosting :: ( OptSpec Operand
+ , OptSpec Operand )
globalPosting =
let f = fmap L.unGlobalPosting . Q.globalPosting
in serialOption f "globalPosting"
-filePosting :: ( OptSpec (Either Error Operand)
- , OptSpec (Either Error Operand) )
+filePosting :: ( OptSpec Operand
+ , OptSpec Operand )
filePosting =
let f = fmap L.unFilePosting . Q.filePosting
in serialOption f "filePosting"
-fileTransaction :: ( OptSpec (Either Error Operand)
- , OptSpec (Either Error Operand) )
+fileTransaction :: ( OptSpec Operand
+ , OptSpec Operand )
fileTransaction =
let f = fmap L.unFileTransaction . Q.fileTransaction
in serialOption f "fileTransaction"
@@ -473,7 +480,7 @@ operandSpecs
-> Either Error Operand)]
operandSpecs dt =
- [ fmap (const . const) date
+ [ fmap (const . const) (fmap Right date)
, fmap (const . const . pure) (current dt)
, account
, accountLevel
@@ -488,7 +495,7 @@ operandSpecs dt =
, filename
, fmap (const . const . pure) debit
, fmap (const . const . pure) credit
- , fmap (const . const) qtyOption
+ , fmap (const . const) (fmap Right qtyOption)
, sAccount
, sAccountLevel
@@ -501,7 +508,7 @@ operandSpecs dt =
, sPostingMemo
, fmap (const . const . pure) sDebit
, fmap (const . const. pure) sCredit
- , fmap (const . const) sQtyOption
+ , fmap (const . const) (fmap Right sQtyOption)
]
++ serialSpecs
@@ -518,10 +525,11 @@ serialSpecs
unDouble
:: Functor f
- => (f (Either Error a),
- f (Either Error a ))
+ => (f a, f a)
-> [ f (x -> y -> Either Error a) ]
-unDouble (o1, o2) = [fmap (const . const) o1, fmap (const . const) o2]
+unDouble (o1, o2) =
+ [ fmap (const . const) (fmap Right o1)
+ , fmap (const . const) (fmap Right o2)]
------------------------------------------------------------
@@ -533,25 +541,24 @@ unDouble (o1, o2) = [fmap (const . const) o1, fmap (const . const) o2]
data BadHeadTailError = BadHeadTailError Text
deriving Show
-optHead :: OptSpec (Either Error PostFilterFn)
+optHead :: OptSpec PostFilterFn
optHead = C.OptSpec ["head"] [] (C.OneArg f)
where
f a = do
- num <- parseInt a
+ num <- parseIntMA a
let g _ ii = ii < (ItemIndex num)
return g
-optTail :: OptSpec (Either Error PostFilterFn)
+optTail :: OptSpec PostFilterFn
optTail = C.OptSpec ["tail"] [] (C.OneArg f)
where
f a = do
- num <- parseInt a
+ num <- parseIntMA a
let g (ListLength len) (ItemIndex ii) = ii >= len - num
return g
postFilterSpecs
- :: ( OptSpec (Either Error PostFilterFn)
- , OptSpec (Either Error PostFilterFn))
+ :: ( OptSpec PostFilterFn , OptSpec PostFilterFn)
postFilterSpecs = (optHead, optTail)
------------------------------------------------------------
@@ -637,26 +644,26 @@ verboseFilter = C.OptSpec ["verbose-filter"] "" (C.NoArg ())
-- Siblings
--
-sGlobalPosting :: ( OptSpec (Either Error Operand)
- , OptSpec (Either Error Operand) )
+sGlobalPosting :: ( OptSpec Operand
+ , OptSpec Operand )
sGlobalPosting =
siblingSerialOption "globalPosting"
PS.fwdGlobalPosting PS.backGlobalPosting
-sFilePosting :: ( OptSpec (Either Error Operand)
- , OptSpec (Either Error Operand) )
+sFilePosting :: ( OptSpec Operand
+ , OptSpec Operand )
sFilePosting =
siblingSerialOption "filePosting"
PS.fwdFilePosting PS.backFilePosting
-sGlobalTransaction :: ( OptSpec (Either Error Operand)
- , OptSpec (Either Error Operand) )
+sGlobalTransaction :: ( OptSpec Operand
+ , OptSpec Operand )
sGlobalTransaction =
siblingSerialOption "globalTransaction"
PS.fwdGlobalTransaction PS.backGlobalTransaction
-sFileTransaction :: ( OptSpec (Either Error Operand)
- , OptSpec (Either Error Operand) )
+sFileTransaction :: ( OptSpec Operand
+ , OptSpec Operand )
sFileTransaction =
siblingSerialOption "filePosting"
PS.fwdFileTransaction PS.backFileTransaction
@@ -667,16 +674,16 @@ sAccount :: OptSpec ( CaseSensitive
-> Either Error Operand )
sAccount = C.OptSpec ["s-account"] "" (C.OneArg f)
where
- f a1 cs fty = fmap PS.account
- $ getMatcher a1 cs fty
+ f a1 = return $ \cs fty -> fmap PS.account
+ $ getMatcher a1 cs fty
sAccountLevel :: OptSpec ( CaseSensitive
-> MatcherFactory
-> Either Error Operand )
sAccountLevel = C.OptSpec ["s-account-level"] "" (C.TwoArg f)
where
- f a1 a2 cs fty
- = PS.accountLevel <$> parseInt a1 <*> getMatcher a2 cs fty
+ f a1 a2 = return $ \cs fty
+ -> PS.accountLevel <$> parseInt a1 <*> getMatcher a2 cs fty
sAccountAny :: OptSpec ( CaseSensitive
-> MatcherFactory
@@ -721,14 +728,14 @@ sDebit = C.OptSpec ["s-debit"] [] (C.NoArg PS.debit)
sCredit :: OptSpec Operand
sCredit = C.OptSpec ["s-credit"] [] (C.NoArg PS.credit)
-sQtyOption :: OptSpec (Either Error Operand)
+sQtyOption :: OptSpec Operand
sQtyOption = C.OptSpec ["s-qty"] [] (C.TwoArg f)
where
f a1 a2 = do
qt <- parseQty a2
parseComparer a1 (flip PS.qty qt)
parseQty a = case parse Pc.unquotedQtyRepWithSpaces "" (pack a) of
- Left _ -> Left "could not parse quantity"
+ Left _ -> Left . ErrorMsg $ "could not parse quantity"
Right g -> pure . L.toQty $ g
--
@@ -754,7 +761,7 @@ version v pn = unlines
-- | An option for where the user would like to send output.
output :: MA.OptSpec (X.Text -> IO ())
-output = MA.OptSpec ["output"] "o" . MA.OneArg $ \s ->
+output = MA.OptSpec ["output"] "o" . MA.OneArg $ \s -> return $
if s == "-"
then TIO.putStr
else TIO.writeFile s
diff --git a/lib/Penny/Wheat.hs b/lib/Penny/Wheat.hs
index 8eaa335..e02e311 100644
--- a/lib/Penny/Wheat.hs
+++ b/lib/Penny/Wheat.hs
@@ -123,10 +123,10 @@ parseRegexp s = case M.pcre M.Sensitive (X.pack s) of
allOpts :: [MA.OptSpec (WheatConf -> WheatConf)]
allOpts =
[ MA.OptSpec ["indentation"] "i"
- (fmap (\i p -> p { indentAmt = i }) (MA.OneArgE MA.reader))
+ (fmap (\i p -> p { indentAmt = i }) (MA.OneArg MA.reader))
, MA.OptSpec ["test-regexp"] "t"
- (fmap (\f p -> p { testPred = f }) (MA.OneArgE parseRegexp))
+ (fmap (\f p -> p { testPred = f }) (MA.OneArg parseRegexp))
, MA.OptSpec ["stop-on-failure"] ""
( MA.NoArg (\p -> p { stopOnFail
@@ -137,7 +137,7 @@ allOpts =
= not (colorToFile p) }))
, MA.OptSpec ["base-date"] ""
- (fmap (\d p -> p { baseTime = d }) (MA.OneArgE parseBaseTime))
+ (fmap (\d p -> p { baseTime = d }) (MA.OneArg parseBaseTime))
]
-- | Applied to the default WheatConf, returns a new WheatConf based
diff --git a/lib/Penny/Zinc.hs b/lib/Penny/Zinc.hs
index 5434639..91f994d 100644
--- a/lib/Penny/Zinc.hs
+++ b/lib/Penny/Zinc.hs
@@ -153,29 +153,23 @@ newtype ShowExpression = ShowExpression Bool
newtype VerboseFilter = VerboseFilter Bool
deriving (Show, Eq)
-type Error = Text
-
data OptResult
= ROperand (M.CaseSensitive
-> Ly.MatcherFactory
-> Either Ly.Error Ly.Operand)
- | RPostFilter (Either Ly.Error Ly.PostFilterFn)
+ | RPostFilter Ly.PostFilterFn
| RMatcherSelect Ly.MatcherFactory
| RCaseSelect M.CaseSensitive
| ROperator (X.Token L.Posting)
- | RSortSpec (Either Error Orderer)
+ | RSortSpec Orderer
| RColorToFile ColorToFile
| RScheme E.Changers
| RExprDesc X.ExprDesc
| RShowExpression
| RVerboseFilter
-getPostFilters
- :: [OptResult]
- -> Either Ly.Error [Ly.PostFilterFn]
-getPostFilters =
- sequence
- . mapMaybe f
+getPostFilters :: [OptResult] -> [Ly.PostFilterFn]
+getPostFilters = mapMaybe f
where
f o = case o of
RPostFilter pf -> Just pf
@@ -195,15 +189,15 @@ getExprDesc df os = case mapMaybe f os of
getSortSpec
:: Orderer
-> [OptResult]
- -> Either Error Orderer
+ -> Orderer
getSortSpec i ls =
let getSpec o = case o of
RSortSpec x -> Just x
_ -> Nothing
exSpecs = mapMaybe getSpec ls
in if null exSpecs
- then return i
- else fmap mconcat . sequence $ exSpecs
+ then i
+ else mconcat exSpecs
type Factory = M.CaseSensitive
-> Text -> Either Text M.Matcher
@@ -355,8 +349,8 @@ processFiltOpts
-> [OptResult]
-> Either String FilterOpts
processFiltOpts ord df os = either (Left . unpack) Right $ do
- postFilts <- getPostFilters os
- sortSpec <- getSortSpec ord os
+ let postFilts = getPostFilters os
+ sortSpec = getSortSpec ord os
(toks, (rs, rf)) <- makeTokens df os
let ctf = getColorToFile df os
sch = getScheme df os
@@ -514,14 +508,14 @@ argMatch s1 s2 = case (s1, s2) of
(x == y) && ((map toUpper xs) `isPrefixOf` (map toUpper ys))
_ -> True
-sortSpecs :: MA.OptSpec (Either Error Orderer)
+sortSpecs :: MA.OptSpec Orderer
sortSpecs = MA.OptSpec ["sort"] ['s'] (MA.OneArg f)
where
f a =
let matches = filter (\p -> a `argMatch` (fst p)) ords
in case matches of
x:[] -> return $ snd x
- _ -> Left $ "bad sort specification: " <> pack a <> "\n"
+ _ -> Left . MA.ErrorMsg $ "bad sort specification"
diff --git a/penny.cabal b/penny.cabal
index 636d05f..3fed94d 100644
--- a/penny.cabal
+++ b/penny.cabal
@@ -1,5 +1,5 @@
Name: penny
-Version: 0.28.0.0
+Version: 0.30.0.0
Cabal-version: >=1.8
Build-Type: Simple
License: BSD3
@@ -186,8 +186,8 @@ Library
, bytestring ==0.10.*
, cereal ==0.3.*
, containers ==0.5.*
- , matchers ==0.10.*
- , multiarg ==0.22.*
+ , matchers ==0.12.*
+ , multiarg ==0.24.*
, ofx ==0.4.*
, old-locale ==1.0.*
, parsec >= 3.1.2 && < 3.2
@@ -312,7 +312,7 @@ Executable penny-selloff
, semigroups ==0.9.*
, text ==0.11.*
, parsec ==3.1.*
- , multiarg ==0.22.*
+ , multiarg ==0.24.*
, transformers ==0.3.*
other-modules: Paths_penny
@@ -334,7 +334,7 @@ Executable penny-diff
penny
, base ==4.6.*
, text ==0.11.*
- , multiarg ==0.22.*
+ , multiarg ==0.24.*
hs-source-dirs: bin
Main-is: penny-diff.hs
@@ -354,7 +354,7 @@ Executable penny-reprint
Build-depends:
penny
, base ==4.6.*
- , multiarg ==0.22.*
+ , multiarg ==0.24.*
, pretty-show ==1.5.*
, text ==0.11.*
@@ -374,7 +374,7 @@ Executable penny-reconcile
penny
, base ==4.6.*
, text ==0.11.*
- , multiarg ==0.22.*
+ , multiarg ==0.24.*
hs-source-dirs: bin
main-is: penny-reconcile.hs
@@ -387,7 +387,8 @@ Flag build-reconcile
Description: Build the penny-reconcile executable
Default: True
-Executable penny-test
+Test-Suite penny-test
+ type: exitcode-stdio-1.0
Main-is: penny-test.hs
other-modules:
Copper
@@ -412,22 +413,18 @@ Executable penny-test
-- For details on why penny is a dependency here, see
-- http://stackoverflow.com/questions/6711151
- if flag(test)
- build-depends:
- penny
- , QuickCheck ==2.5.*
- , random-shuffle ==0.0.4
-
- , base ==4.6.*
- , multiarg ==0.22.*
- , parsec >= 3.1.2 && < 3.2
- , semigroups ==0.9.*
- , text ==0.11.*
- , time ==1.4.*
- , transformers == 0.3.*
+ build-depends:
+ penny
+ , QuickCheck ==2.5.*
+ , random-shuffle ==0.0.4
- else
- buildable: False
+ , base ==4.6.*
+ , multiarg ==0.24.*
+ , parsec >= 3.1.2 && < 3.2
+ , semigroups ==0.9.*
+ , text ==0.11.*
+ , time ==1.4.*
+ , transformers == 0.3.*
ghc-options: -Wall
@@ -446,7 +443,7 @@ Executable penny-gibberish
, random ==1.0.*
, base ==4.6.*
- , multiarg ==0.22.*
+ , multiarg ==0.24.*
, semigroups ==0.9.*
, text ==0.11.*
, time ==1.4.*