penny 0.26.0.0 → 0.28.0.0
raw patch · 28 files changed
+248/−278 lines, 28 filesdep +eitherdep −binarydep −explicit-exceptiondep ~matchersdep ~multiargdep ~ofx
Dependencies added: either
Dependencies removed: binary, explicit-exception
Dependency ranges changed: matchers, multiarg, ofx, prednote
Files
- bin/penny-selloff.hs +20/−23
- doc/man/penny.1 +0/−5
- lib/Penny/Brenner.hs +16/−7
- lib/Penny/Brenner/Clear.hs +2/−3
- lib/Penny/Brenner/Import.hs +3/−4
- lib/Penny/Brenner/Info.hs +1/−2
- lib/Penny/Brenner/OFX.hs +26/−13
- lib/Penny/Brenner/Print.hs +3/−4
- lib/Penny/Brenner/Types.hs +2/−3
- lib/Penny/Brenner/Util.hs +8/−7
- lib/Penny/Cabin/Balance/Convert.hs +6/−7
- lib/Penny/Cabin/Balance/Convert/Parser.hs +3/−4
- lib/Penny/Cabin/Interface.hs +3/−4
- lib/Penny/Cabin/Posts.hs +4/−7
- lib/Penny/Cabin/Posts/Parser.hs +20/−21
- lib/Penny/Cabin/Scheme.hs +1/−1
- lib/Penny/Copper/Parsec.hs +6/−7
- lib/Penny/Liberty.hs +69/−73
- lib/Penny/Lincoln/Bits/Qty.hs +6/−5
- lib/Penny/Lincoln/Matchers.hs +1/−2
- lib/Penny/Lincoln/PriceDb.hs +5/−6
- lib/Penny/Lincoln/Serial.hs +1/−5
- lib/Penny/Steel/Sums.hs +2/−9
- lib/Penny/Wheat.hs +5/−6
- lib/Penny/Zinc.hs +18/−25
- penny.cabal +12/−18
- tests/penny-gibberish.hs +4/−5
- tests/penny-test.hs +1/−2
bin/penny-selloff.hs view
@@ -95,8 +95,8 @@ import Control.Arrow (first) import Control.Applicative ((<$>), (<*>), pure)-import qualified Control.Monad.Exception.Synchronous as Ex import Control.Monad (when)+import qualified Control.Monad.Trans.Either as Ei import qualified Control.Monad.Trans.State as St import Control.Monad.Trans.Class (lift) import Data.List (find)@@ -119,7 +119,7 @@ import qualified Paths_penny as PPB import qualified Penny as P -type Err = Ex.Exceptional Error+type Err = Either Error data Error = ParseFail MA.Error@@ -153,8 +153,7 @@ x:xs <- case as of [] -> fail (show NoInputArgs) r -> return r- a <- Ex.switch (fail . show . ProceedsParseFailed) return- . Ex.fromEither+ a <- either (fail . show . ProceedsParseFailed) return $ Parsec.parse CP.lvl1Acct "" (pack x) l <- Cop.open xs return $ ParseResult (ProceedsAcct a) l@@ -202,16 +201,15 @@ :: ProceedsAcct -> [(L.Account, L.Balance)] -> Err SelloffInfo selloffInfo (ProceedsAcct pa) bals = do bal <- fmap snd- . Ex.fromMaybe NoSelloffAccount+ . maybe (Left NoSelloffAccount) Right . find ((== pa) . fst) $ bals (g, d) <- case L.unAccount pa of _ : s2 : s3 : [] -> return (s2, s3)- _ -> Ex.throw NotThreeSelloffSubAccounts+ _ -> Left NotThreeSelloffSubAccounts (sStock, sCurr) <- selloffStockCurr bal date <- fmap SaleDate- . Ex.mapException SaleDateParseFailed- . Ex.fromEither+ . either (Left . SaleDateParseFailed) Right . Parsec.parse CP.dateTime "" $ (L.text d) return $ SelloffInfo (Group g) date sStock sCurr@@ -219,12 +217,12 @@ selloffStockCurr :: L.Balance -> Err (SelloffStock, SelloffCurrency) selloffStockCurr bal = do let m = L.unBalance bal- when (M.size m /= 2) $ Ex.throw BadSelloffBalance+ when (M.size m /= 2) $ Left BadSelloffBalance let toPair (cy, bl) = case bl of Bal.Zero -> Nothing Bal.NonZero col -> Just (cy, col) ps = mapMaybe toPair . M.toList $ m- findBal dc = Ex.fromMaybe BadSelloffBalance+ findBal dc = maybe (Left BadSelloffBalance) Right . find ((== dc) . Bal.colDrCr . snd) $ ps (cyStock, (Bal.Column _ qtyStock)) <- findBal L.Debit@@ -276,9 +274,8 @@ purchaseInfo sStock sCurr (ss, bal) = do dateSub <- case ss of s1:[] -> return s1- _ -> Ex.throw $ NotThreePurchaseSubAccounts ss- date <- Ex.mapException BadPurchaseDate- . Ex.fromEither+ _ -> Left $ NotThreePurchaseSubAccounts ss+ date <- either (Left . BadPurchaseDate) Right . Parsec.parse CP.dateTime "" . L.text $ dateSub@@ -292,18 +289,18 @@ -> Err (PurchaseStockQty, PurchaseCurrencyQty) purchaseQtys (SelloffStock sStock) (SelloffCurrency sCurr) bal = do let m = L.unBalance bal- when (M.size m /= 2) $ Ex.throw BadPurchaseBalance+ when (M.size m /= 2) $ Left BadPurchaseBalance let toPair (cy, bl) = case bl of Bal.Zero -> Nothing Bal.NonZero col -> Just (cy, col) ps = mapMaybe toPair . M.toList $ m- findBal dc = Ex.fromMaybe BadPurchaseBalance+ findBal dc = maybe (Left BadPurchaseBalance) Right . find ((== dc) . Bal.colDrCr . snd) $ ps (cyStock, (Bal.Column _ qtyStock)) <- findBal L.Credit (cyCurr, (Bal.Column _ qtyCurr)) <- findBal L.Debit- when (cyStock /= L.commodity sStock) $ Ex.throw BadPurchaseBalance- when (cyCurr /= L.commodity sCurr) $ Ex.throw BadPurchaseBalance+ when (cyStock /= L.commodity sStock) $ Left BadPurchaseBalance+ when (cyCurr /= L.commodity sCurr) $ Left BadPurchaseBalance return (PurchaseStockQty qtyStock, PurchaseCurrencyQty qtyCurr) @@ -332,7 +329,7 @@ -- basis cannot be allocated. stRealizeBasis :: PurchaseInfo- -> Ex.ExceptionalT Error+ -> Ei.EitherT Error (St.State (Maybe CostSharesSold, Maybe StillToRealize)) (Maybe (PurchaseInfo, BasisRealiztn)) stRealizeBasis p = do@@ -387,11 +384,11 @@ let stReal = Just . StillToRealize . L.qty . unSelloffStock $ sellStck (exRs, (mayCss, mayTr)) = St.runState- (Ex.runExceptionalT (mapM stRealizeBasis ps))+ (Ei.runEitherT (mapM stRealizeBasis ps)) (Nothing, stReal) rs <- exRs- when (isJust mayTr) $ Ex.throw InsufficientSharePurchases- css <- Ex.fromMaybe ZeroCostSharesSold mayCss+ when (isJust mayTr) $ Left InsufficientSharePurchases+ css <- maybe (Left ZeroCostSharesSold) Right mayCss return (catMaybes rs, css) newtype CapitalChange = CapitalChange { unCapitalChange :: L.Qty }@@ -421,7 +418,7 @@ in case mayGainLoss of Nothing -> return . NoChange $ ls Just (qt, gl) -> do- nePurchs <- Ex.fromMaybe NoPurchaseInformation+ nePurchs <- maybe (Left NoPurchaseInformation) Right . uncons $ ls let qtys = mapNE (unPurchaseCurrencyQty . piCurrencyQty . fst) nePurchs@@ -615,7 +612,7 @@ handleParseResult :: ParseResult -> IO () handleParseResult (ParseResult pa ldgr) =- Ex.switch (error . show) TIO.putStr . makeOutput pa $ ldgr+ either (error . show) TIO.putStr . makeOutput pa $ ldgr defaultRadGroup :: S.S3 L.Radix L.PeriodGrp L.CommaGrp defaultRadGroup = S.S3a L.Period
doc/man/penny.1 view
@@ -458,11 +458,6 @@ .BR pcresyntax "(3) and " pcrepattern (3)) .TP-.B --posix-Use the "posix" matcher, which uses POSIX regular expressions (see-.BR regex (7))--.TP .B "--exact | -x" Use the "exact" matcher, which matches if the given pattern is a letter-for-letter match of the target text, with case sensitivity
lib/Penny/Brenner.hs view
@@ -18,6 +18,7 @@ , usePayeeOrDesc , brennerMain , ofxParser+ , ofxPrepassParser ) where import qualified Penny.Brenner.Types as Y@@ -37,7 +38,6 @@ import qualified System.Console.MultiArg as MA import System.Environment (getProgName) import qualified System.Exit as Exit-import qualified Control.Monad.Exception.Synchronous as Ex -- | Brenner, with a pre-compiled configuration. brennerMain@@ -69,7 +69,7 @@ preProcessor :: Y.Config -> [Y.FitAcctName]- -> Ex.Exceptional String+ -> Either String (Either (IO ()) [MA.Mode (MA.ProgName -> String) (IO ())]) preProcessor cf args = do@@ -82,11 +82,11 @@ Nothing -> Y.moreFitAccts cf Just d -> d : Y.moreFitAccts cf in case filter pdct toFilter of- [] -> Ex.throw $+ [] -> Left $ "financial institution account " ++ (X.unpack . Y.unFitAcctName $ s) ++ " not configured." c:[] -> return $ Just c- _ -> Ex.throw $+ _ -> Left $ "more than one financial institution account " ++ "named " ++ (X.unpack . Y.unFitAcctName $ s) ++ " configured."@@ -187,7 +187,7 @@ -- commodity and the quantity , parser :: ( Y.ParserDesc- , Y.FitFileLocation -> IO (Ex.Exceptional String [Y.Posting]))+ , Y.FitFileLocation -> IO (Either String [Y.Posting])) -- ^ Parses a file of transactions from the financial -- institution. The function must open the file and parse it. This -- is in the IO monad not only because the function must open the@@ -214,7 +214,7 @@ -- created by the merge command. - } deriving Show+ } convertFitAcct :: FitAcct -> Y.FitAcct convertFitAcct (FitAcct fn fd db ax df cy gs tl sd sb ps tlp) = Y.FitAcct@@ -235,7 +235,7 @@ data Config = Config { defaultFitAcct :: Maybe FitAcct , moreFitAccts :: [FitAcct]- } deriving Show+ } convertConfig :: Config -> Y.Config convertConfig (Config d m) = Y.Config@@ -253,3 +253,12 @@ -- | Parser for OFX data. ofxParser :: (Y.ParserDesc, Y.ParserFn) ofxParser = O.parser++-- | Parser for OFX data, with a prepass phase. Any incoming data is+-- first filtered through the given function. This allows you to+-- correct broken OFX statements. For example, Bank of America issues+-- OFX files that do not properly escape ampersands. Using this+-- function you can change every ampersand to something properly+-- escaped (or just change it to the word \"and\".)+ofxPrepassParser :: (String -> String) -> (Y.ParserDesc, Y.ParserFn)+ofxPrepassParser = O.prepassParser
lib/Penny/Brenner/Clear.hs view
@@ -1,7 +1,6 @@ module Penny.Brenner.Clear (mode) where import Control.Applicative-import qualified Control.Monad.Exception.Synchronous as Ex import Control.Monad (guard, mzero, when) import Data.Maybe (mapMaybe, fromMaybe) import Data.Monoid (mconcat, First(..))@@ -57,7 +56,7 @@ { csvLocation :: Y.FitFileLocation , ledgerLocations :: [String] , printer :: X.Text -> IO ()- } deriving Show+ } mode :: Y.Mode@@ -84,7 +83,7 @@ dbList <- U.loadDb (Y.AllowNew False) (Y.dbLocation c) let db = M.fromList dbList (_, prsr) = Y.parser c- txns <- fmap (Ex.switch fail return) $ prsr (csvLocation os)+ txns <- fmap (either fail return) $ prsr (csvLocation os) leds <- C.open (ledgerLocations os) toClear <- case mapM (findUNumber db) (concat txns) of Nothing -> fail $ "at least one posting was not found in the"
lib/Penny/Brenner/Import.hs view
@@ -1,7 +1,6 @@ module Penny.Brenner.Import (mode) where import Control.Applicative ((<|>))-import qualified Control.Monad.Exception.Synchronous as Ex import Data.Maybe (mapMaybe) import qualified System.Console.MultiArg as MA import qualified Penny.Brenner.Types as Y@@ -28,7 +27,7 @@ { fitFile :: Y.FitFileLocation , allowNew :: Y.AllowNew , parser :: Y.FitFileLocation- -> IO (Ex.Exceptional String [Y.Posting])+ -> IO (Either String [Y.Posting]) , newUNumber :: Maybe Integer } @@ -111,8 +110,8 @@ txnsOld <- U.loadDb (allowNew os) dbLoc parseResult <- parser os (fitFile os) ins <- case parseResult of- Ex.Exception e -> fail e- Ex.Success g -> return g+ Left e -> fail e+ Right g -> return g (new, len) <- case appendNew (newUNumber os) txnsOld ins of Just r -> return r Nothing -> fail "invalid new U number given."
lib/Penny/Brenner/Info.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} module Penny.Brenner.Info (mode) where -import qualified Control.Monad.Exception.Synchronous as Ex import qualified Penny.Brenner.Types as Y import qualified Data.Text as X import qualified Data.Text.IO as TIO@@ -29,7 +28,7 @@ MA.Intersperse -- Interspersion processPa -- Posarg processor where- processPa = const . Ex.throw . MA.ErrorMsg+ processPa = const . Left . MA.ErrorMsg $ "this mode does not accept positional arguments" process :: Y.Config -> IO ()
lib/Penny/Brenner/OFX.hs view
@@ -6,10 +6,12 @@ -- Description field. Information from the OFX Payee field is placed -- into the Payee field of the Posting record. -module Penny.Brenner.OFX (parser) where+module Penny.Brenner.OFX+ ( parser+ , prepassParser+ ) where import Control.Applicative-import qualified Control.Monad.Exception.Synchronous as Ex import Data.List (isPrefixOf) import qualified Data.OFX as O import qualified Data.Text as X@@ -19,7 +21,17 @@ -- | Parser for OFX files. parser :: ( Y.ParserDesc, Y.ParserFn )-parser = (Y.ParserDesc d, loadIncoming)+parser = prepassParser id+++-- | Parser for OFX files. Any incoming data is first filtered+-- through the given function. This allows you to correct broken+-- OFX statements. For example, Bank of America issues OFX files that+-- do not properly escape ampersands. Using this function you can+-- change every ampersand to something properly escaped (or just+-- change it to the word \"and\".)+prepassParser :: (String -> String) -> ( Y.ParserDesc, Y.ParserFn )+prepassParser f = (Y.ParserDesc d, loadIncoming f) where d = X.unlines [ "Parses OFX 1.0-series files."@@ -33,13 +45,14 @@ ] loadIncoming- :: Y.FitFileLocation- -> IO (Ex.Exceptional String [Y.Posting])-loadIncoming (Y.FitFileLocation fn) = do- contents <- readFile fn+ :: (String -> String)+ -- ^ Prepass function+ -> Y.FitFileLocation+ -> IO (Either String [Y.Posting])+loadIncoming pp (Y.FitFileLocation fn) = do+ contents <- fmap pp $ readFile fn return $- ( Ex.mapException show- . Ex.fromEither+ ( either (Left . show) Right $ P.parse O.ofxFile fn contents ) >>= O.transactions >>= mapM txnToPosting@@ -47,7 +60,7 @@ txnToPosting :: O.Transaction- -> Ex.Exceptional String Y.Posting+ -> Either String Y.Posting txnToPosting t = Y.Posting <$> pure (Y.Date ( T.utctDay . T.zonedTimeToUTC . O.txDTPOSTED $ t))@@ -65,8 +78,8 @@ incDec = if "-" `isPrefixOf` amtStr then Y.Decrease else Y.Increase amt = case amtStr of- [] -> Ex.throw "empty amount"+ [] -> Left "empty amount" x:xs -> let str = if x == '-' || x == '+' then xs else amtStr- in Ex.fromMaybe ("could not parse amount: " ++ amtStr)- $ Y.mkAmount str+ in maybe (Left ("could not parse amount: " ++ amtStr))+ Right $ Y.mkAmount str
lib/Penny/Brenner/Print.hs view
@@ -7,7 +7,6 @@ import qualified Penny.Brenner.Types as Y import qualified Penny.Brenner.Util as U import qualified System.Console.MultiArg as MA-import qualified Control.Monad.Exception.Synchronous as Ex import Data.Maybe (mapMaybe) help :: String -> String@@ -41,7 +40,7 @@ doPrint (snd . Y.parser $ fa) ls doPrint- :: (Y.FitFileLocation -> IO (Ex.Exceptional String [Y.Posting]))+ :: (Y.FitFileLocation -> IO (Either String [Y.Posting])) -> [Arg] -> IO () doPrint prsr ls = mapM_ f . mapMaybe toFile $ ls@@ -49,9 +48,9 @@ f file = do r <- prsr file case r of- Ex.Exception s -> do+ Left s -> do fail $ "penny-fit print: error: " ++ s- Ex.Success ps -> mapM putStr . map U.showPosting $ ps+ Right ps -> mapM putStr . map U.showPosting $ ps toFile a = case a of ArgFile s -> Just (Y.FitFileLocation s)
lib/Penny/Brenner/Types.hs view
@@ -28,7 +28,6 @@ ) where import Control.Applicative ((<$>), (<*>))-import qualified Control.Monad.Exception.Synchronous as Ex import qualified Data.Map as M import qualified Data.Time as Time import qualified Penny.Lincoln as L@@ -289,7 +288,7 @@ -- commodity and the quantity , parser :: ( ParserDesc- , FitFileLocation -> IO (Ex.Exceptional String [Posting]))+ , FitFileLocation -> IO (Either String [Posting])) -- ^ Parses a file of transactions from the financial -- institution. The function must open the file and parse it. This -- is in the IO monad not only because the function must open the@@ -336,5 +335,5 @@ -- | All parsers must be of this type. type ParserFn = FitFileLocation- -> IO (Ex.Exceptional String [Posting])+ -> IO (Either String [Posting])
lib/Penny/Brenner/Util.hs view
@@ -1,6 +1,5 @@ module Penny.Brenner.Util where -import Control.Monad.Exception.Synchronous as Ex import qualified Penny.Brenner.Types as Y import qualified Data.ByteString as BS import qualified System.IO.Error as IOE@@ -47,8 +46,8 @@ then return [] else IOE.ioError e Right g -> case readDbTuple g of- Ex.Exception e -> fail e- Ex.Success good -> return good+ Left e -> fail e+ Right good -> return good -- | File version. Increment this when anything in the file format -- changes.@@ -60,12 +59,14 @@ readDbTuple :: BS.ByteString- -> Ex.Exceptional String Y.DbList+ -> Either String Y.DbList readDbTuple bs = do- (s, v, ls) <- Ex.fromEither $ S.decode bs- Ex.assert "database file format not recognized." $ s == brenner- Ex.assert "wrong database version." $ v == version+ (s, v, ls) <- S.decode bs+ assert "database file format not recognized." $ s == brenner+ assert "wrong database version." $ v == version return ls+ where+ assert e b = if b then Right () else Left e saveDbTuple :: Y.DbList -> BS.ByteString saveDbTuple ls = S.encode (brenner, version, ls)
lib/Penny/Cabin/Balance/Convert.hs view
@@ -11,7 +11,6 @@ ) where import Control.Applicative ((<$>), (<*>))-import qualified Control.Monad.Exception.Synchronous as Ex import qualified Data.Tree as E import qualified Data.Traversable as Tvbl import qualified Penny.Cabin.Options as CO@@ -68,7 +67,7 @@ -> L.DateTime -> L.To -> L.Balance- -> Ex.Exceptional X.Text L.BottomLine+ -> Either X.Text L.BottomLine convertBalance db dt to bal = fmap mconcat r where r = mapM (convertOne db dt to) . M.assocs . L.unBalance $ bal@@ -80,11 +79,11 @@ -> L.DateTime -> L.To -> (L.Commodity, L.BottomLine)- -> Ex.Exceptional X.Text L.BottomLine+ -> Either X.Text L.BottomLine convertOne db dt to (cty, bl) = case bl of L.Zero -> return L.Zero- L.NonZero (L.Column dc qt) -> Ex.mapExceptional e g ex+ L.NonZero (L.Column dc qt) -> either (Left . e) (Right . g) ex where ex = L.convertAsOf db dt to am am = L.Amount qt cty@@ -214,7 +213,7 @@ :: Opts -> [L.PricePoint] -> [(a, L.Posting)]- -> Ex.Exceptional X.Text [Rb.Chunk]+ -> Either X.Text [Rb.Chunk] report os@(Opts eiFmt _ _ tgt _ txtFormats) ps bs = do fstBl <- sumConvertSort os ps bs return $ case eiFmt of@@ -258,7 +257,7 @@ noDefault = X.pack "no default price found" f = fromParsedOpts chgrs op' pr fmt ts pps = do- rptOpts <- Ex.fromMaybe noDefault $ f pps fmt+ rptOpts <- maybe (Left noDefault) Right $ f pps fmt let boxes = fsf ts report rptOpts pps boxes in (posArgs, pr)@@ -272,7 +271,7 @@ :: Opts -> [L.PricePoint] -> [(a, L.Posting)]- -> Ex.Exceptional X.Text ForestAndBL+ -> Either X.Text ForestAndBL sumConvertSort os ps bs = mkResult <$> convertedFrst <*> convertedTot where (Opts _ szb str tgt dt _) = os
lib/Penny/Cabin/Balance/Convert/Parser.hs view
@@ -8,7 +8,6 @@ ) where -import qualified Control.Monad.Exception.Synchronous as Ex import qualified Data.Text as X import qualified Penny.Cabin.Options as CO import qualified Penny.Cabin.Parsers as P@@ -67,7 +66,7 @@ where f a1 = case Parsec.parse Pc.lvl1Cmdty "" (X.pack a1) of- Left _ -> Ex.throw . C.ErrorMsg $ "invalid commodity"+ Left _ -> Left . C.ErrorMsg $ "invalid commodity" Right g -> return $ \os -> os { target = ManualTarget . L.To $ g } parseAuto :: C.OptSpec (Opts -> Opts)@@ -80,7 +79,7 @@ where f a1 = case Parsec.parse Pc.dateTime "" (X.pack a1) of- Left _ -> Ex.throw . C.ErrorMsg $ "invalid date"+ Left _ -> Left . C.ErrorMsg $ "invalid date" Right g -> return $ \os -> os { dateTime = g } parseSort :: C.OptSpec (Opts -> Opts)@@ -107,5 +106,5 @@ f a = do i <- C.reader a case L.nonNegative i of- Nothing -> Ex.throw . C.ErrorMsg $ "argument is negative"+ Nothing -> Left . C.ErrorMsg $ "argument is negative" Just g -> return $ \o -> o { percentRpt = Just (RoundTo g) }
lib/Penny/Cabin/Interface.hs view
@@ -4,7 +4,6 @@ import qualified Data.Prednote.Expressions as Exp import qualified Penny.Cabin.Scheme as S-import Control.Monad.Exception.Synchronous (Exceptional) import qualified Data.Text as X import Text.Matchers (CaseSensitive) import qualified Text.Matchers as TM@@ -31,7 +30,7 @@ -- indicated with a Text. The name of the executable and the word -- @error@ will be prepended to this Text; otherwise, it is printed -- as-is, so be sure to include any trailing newline if needed.-type ParseResult = Exceptional X.Text ArgsAndReport+type ParseResult = Either X.Text ArgsAndReport type PrintReport = (L.Amount L.Qty -> X.Text)@@ -48,7 +47,7 @@ -- ^ PricePoints to be included in the report - -> Exceptional X.Text [R.Chunk]+ -> Either X.Text [R.Chunk] -- ^ The exception type is a strict Text, containing the error -- message. The success type is a list of either a Chunk or a PreChunk -- containing the resulting report. This allows for errors after the@@ -65,7 +64,7 @@ -- case sensitivity (this may have been changed in the filtering -- options) - -> (CaseSensitive -> X.Text -> Exceptional X.Text TM.Matcher)+ -> (CaseSensitive -> X.Text -> Either X.Text TM.Matcher) -- ^ Result from previous parsers indicating the matcher factory the -- user wishes to use
lib/Penny/Cabin/Posts.hs view
@@ -53,7 +53,6 @@ ) where import Control.Applicative ((<$>), (<*>))-import qualified Control.Monad.Exception.Synchronous as Ex import Data.List.Split (chunksOf) import qualified Data.Either as Ei import qualified Data.Text as X@@ -121,7 +120,7 @@ specs :: Sh.Runtime- -> [MA.OptSpec (Either String (P.State -> Ex.Exceptional X.Text P.State))]+ -> [MA.OptSpec (Either String (P.State -> Either X.Text P.State))] specs = map (fmap Right) . P.allSpecs @@ -132,8 +131,8 @@ -> E.Changers -> Exp.ExprDesc -> ([L.Transaction] -> [(Ly.LibertyMeta, L.Posting)])- -> [Either String (P.State -> Ex.Exceptional X.Text P.State)]- -> Ex.Exceptional X.Text I.ArgsAndReport+ -> [Either String (P.State -> Either X.Text P.State)]+ -> Either X.Text I.ArgsAndReport process os cs fty ch expr fsf ls = let (posArgs, clOpts) = Ei.partitionEithers ls pState = newParseState cs fty expr os@@ -212,7 +211,7 @@ getPredicate :: Exp.ExprDesc -> [Exp.Token ((Ly.LibertyMeta, L.Posting))]- -> Ex.Exceptional Error (Pe.Pdct ((Ly.LibertyMeta, L.Posting)))+ -> Either Error (Pe.Pdct ((Ly.LibertyMeta, L.Posting))) getPredicate d ts = case ts of [] -> return $ Pe.always@@ -517,8 +516,6 @@ , " Use \"within\" matcher" , "--pcre" , " Use \"pcre\" matcher"- , "--posix"- , " Use \"posix\" matcher" , "--exact" , " Use \"exact\" matcher" , ""
lib/Penny/Cabin/Posts/Parser.hs view
@@ -10,7 +10,6 @@ import Control.Applicative ((<$>), pure, (<*>), Applicative)-import qualified Control.Monad.Exception.Synchronous as Ex import Data.Char (toLower) import qualified Data.Foldable as Fdbl import Data.Monoid ((<>))@@ -52,7 +51,7 @@ type Error = X.Text allSpecs- :: S.Runtime -> [MA.OptSpec (State -> Ex.Exceptional Error State)]+ :: S.Runtime -> [MA.OptSpec (State -> Either Error State)] allSpecs rt = operand rt ++ boxFilters@@ -74,7 +73,7 @@ operand :: S.Runtime- -> [MA.OptSpec (State -> Ex.Exceptional Error State)]+ -> [MA.OptSpec (State -> Either Error State)] operand rt = map (fmap f) (Ly.operandSpecs (S.currentTime rt)) where f lyFn st = do@@ -94,7 +93,7 @@ -> (Ly.LibertyMeta -> Int) -- ^ Pulls the serial from the PostMeta - -> C.OptSpec (State -> Ex.Exceptional Error State)+ -> C.OptSpec (State -> Either Error State) optBoxSerial nm f = C.OptSpec [nm] "" (C.TwoArg g) where@@ -107,27 +106,27 @@ let tok = Exp.operand pd return $ st { tokens = tokens st ++ [tok] } -optFilteredNum :: C.OptSpec (State -> Ex.Exceptional Error State)+optFilteredNum :: C.OptSpec (State -> Either Error State) optFilteredNum = optBoxSerial "filtered" f where f = L.forward . Ly.unFilteredNum . Ly.filteredNum -optRevFilteredNum :: C.OptSpec (State -> Ex.Exceptional Error State)+optRevFilteredNum :: C.OptSpec (State -> Either Error State) optRevFilteredNum = optBoxSerial "revFiltered" f where f = L.backward . Ly.unFilteredNum . Ly.filteredNum -optSortedNum :: C.OptSpec (State -> Ex.Exceptional Error State)+optSortedNum :: C.OptSpec (State -> Either Error State) optSortedNum = optBoxSerial "sorted" f where f = L.forward . Ly.unSortedNum . Ly.sortedNum -optRevSortedNum :: C.OptSpec (State -> Ex.Exceptional Error State)+optRevSortedNum :: C.OptSpec (State -> Either Error State) optRevSortedNum = optBoxSerial "revSorted" f where f = L.backward . Ly.unSortedNum . Ly.sortedNum -boxFilters :: [C.OptSpec (State -> Ex.Exceptional Error State)]+boxFilters :: [C.OptSpec (State -> Either Error State)] boxFilters = [ optFilteredNum , optRevFilteredNum@@ -136,7 +135,7 @@ ] -parsePostFilter :: [C.OptSpec (State -> Ex.Exceptional Error State)]+parsePostFilter :: [C.OptSpec (State -> Either Error State)] parsePostFilter = [fmap f optH, fmap f optT] where (optH, optT) = Ly.postFilterSpecs@@ -161,14 +160,14 @@ where f oo st = st { tokens = tokens st ++ [oo] } -parseWidth :: C.OptSpec (State -> Ex.Exceptional Error State)+parseWidth :: C.OptSpec (State -> Either Error State) parseWidth = C.OptSpec ["width"] "" (C.OneArg f) where f a1 st = do i <- Ly.parseInt a1 return $ st { width = Ty.ReportWidth i } -parseField :: String -> Ex.Exceptional Error (F.Fields Bool)+parseField :: String -> Either Error (F.Fields Bool) parseField str = let lower = map toLower str checkField s =@@ -177,17 +176,17 @@ else (s, False) flds = checkField <$> F.fieldNames in case checkFields flds of- Ex.Exception e -> case e of- NoMatchingFields -> Ex.throw+ Left e -> case e of+ NoMatchingFields -> Left $ "no field matches the name \"" <> X.pack str <> "\"\n"- MultipleMatchingFields ts -> Ex.throw+ MultipleMatchingFields ts -> Left $ "multiple fields match the name \"" <> X.pack str <> "\" matches: " <> mtchs <> "\n" where mtchs = X.intercalate " " . map (\x -> "\"" <> x <> "\"") $ ts- Ex.Success g -> return g+ Right g -> return g -- | Turns a field on if it is True.@@ -221,7 +220,7 @@ f o False = o f _ True = False -showField :: C.OptSpec (State -> Ex.Exceptional Error State)+showField :: C.OptSpec (State -> Either Error State) showField = C.OptSpec ["show"] "" (C.OneArg f) where f a1 st = do@@ -229,7 +228,7 @@ let newFl = fieldOn (fields st) fl return $ st { fields = newFl } -hideField :: C.OptSpec (State -> Ex.Exceptional Error State)+hideField :: C.OptSpec (State -> Either Error State) hideField = C.OptSpec ["hide"] "" (C.OneArg f) where f a1 st = do@@ -275,12 +274,12 @@ -- | Checks the fields with the True value to ensure there is only one. checkFields :: F.Fields (String, Bool)- -> Ex.Exceptional BadFieldError (F.Fields Bool)+ -> Either BadFieldError (F.Fields Bool) checkFields fs = let f (s, b) ls = if b then s:ls else ls in case Fdbl.foldr f [] fs of- [] -> Ex.throw NoMatchingFields+ [] -> Left NoMatchingFields _:[] -> return (snd <$> fs)- ms -> Ex.throw . MultipleMatchingFields . map X.pack $ ms+ ms -> Left . MultipleMatchingFields . map X.pack $ ms
lib/Penny/Cabin/Scheme.hs view
@@ -55,7 +55,7 @@ -- as @for dark background terminals@ , changers :: Changers- } deriving Show+ } getEvenOdd :: EvenOdd -> EvenAndOdd a -> a
lib/Penny/Copper/Parsec.hs view
@@ -13,7 +13,6 @@ import Control.Applicative ((<$>), (<$), (<*>), (*>), (<*), (<|>), optional) import Control.Monad (replicateM, when)-import qualified Control.Monad.Exception.Synchronous as Ex import Data.List.NonEmpty (NonEmpty((:|))) import qualified Penny.Lincoln as L import qualified Penny.Steel.Sums as S@@ -509,13 +508,13 @@ :: Text -- ^ Contents of file to be parsed - -> Ex.Exceptional String [I.ParsedItem]+ -> Either String [I.ParsedItem] -- ^ Returns items if successfully parsed; otherwise, returns an -- error message. parse s = let parser = P.spaces *> P.many item <* P.spaces <* P.eof- in Ex.mapException show . Ex.fromEither+ in either (Left . show) Right $ P.parse parser "" s @@ -543,16 +542,16 @@ parseStdinOnly = do txt <- getStdin case parse txt of- Ex.Exception err -> handleParseError "standard input" err- Ex.Success g -> return (L.Filename . X.pack $ "<stdin>", g)+ Left err -> handleParseError "standard input" err+ Right g -> return (L.Filename . X.pack $ "<stdin>", g) parseFromFilename :: String -> IO (L.Filename, [I.ParsedItem]) parseFromFilename s = do (fn, txt) <- getFileContentsStdin s case parse txt of- Ex.Exception err ->+ Left err -> handleParseError (X.unpack . L.unFilename $ fn) err- Ex.Success g -> return (fn, g)+ Right g -> return (fn, g) handleParseError :: String
lib/Penny/Liberty.hs view
@@ -51,7 +51,6 @@ import Control.Arrow (first, second) import Control.Applicative ((<*>), (<$>), pure, Applicative)-import qualified Control.Monad.Exception.Synchronous as Ex import Data.Char (toUpper) import Data.Monoid ((<>)) import Data.List (sortBy)@@ -109,7 +108,7 @@ parsePredicate :: X.ExprDesc -> [X.Token a]- -> Ex.Exceptional Error (E.Pdct a)+ -> Either Error (E.Pdct a) parsePredicate d ls = case ls of [] -> return E.always _ -> X.parseExpression d ls@@ -177,7 +176,7 @@ type MatcherFactory = CaseSensitive -> Text- -> Ex.Exceptional Text TM.Matcher+ -> Either Text TM.Matcher newtype ListLength = ListLength { unListLength :: Int } deriving (Eq, Ord, Show)@@ -211,10 +210,10 @@ :: String -> CaseSensitive -> MatcherFactory- -> Ex.Exceptional Error TM.Matcher+ -> Either Error TM.Matcher getMatcher s cs f- = Ex.mapException mkError+ = either (Left . mkError) Right $ f cs (pack s) where mkError eMsg = "bad pattern: \"" <> pack s <> " - " <> eMsg@@ -226,16 +225,15 @@ parseComparer :: String -> (Ordering -> E.Pdct a)- -> Ex.Exceptional Error (E.Pdct a)-parseComparer s f = Ex.fromMaybe ("bad comparer: " <> pack s <> "\n")- $ E.parseComparer (pack s) f+ -> Either Error (E.Pdct a)+parseComparer s f = maybe (Left ("bad comparer: " <> pack s <> "\n"))+ 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 -> Ex.Exceptional Error Time.UTCTime+parseDate :: String -> Either Error Time.UTCTime parseDate arg =- Ex.mapExceptional err L.toUTC- . Ex.fromEither+ either (Left . err) (Right . L.toUTC) . parse Pc.dateTime "" . pack $ arg@@ -245,7 +243,7 @@ type Operand = E.Pdct L.Posting -- | OptSpec for a date.-date :: OptSpec (Ex.Exceptional Error Operand)+date :: OptSpec (Either Error Operand) date = C.OptSpec ["date"] ['d'] (C.TwoArg f) where f a1 a2 = do@@ -259,11 +257,11 @@ f = E.or [P.date LT (L.toUTC dt), P.date EQ (L.toUTC dt)] -- | Parses exactly one integer; fails if it cannot read exactly one.-parseInt :: String -> Ex.Exceptional Error Int+parseInt :: String -> Either Error Int parseInt t = case reads t of ((i, ""):[]) -> return i- _ -> Ex.throw $ "could not parse integer: \"" <> pack t <> "\"\n"+ _ -> Left $ "could not parse integer: \"" <> pack t <> "\"\n" -- | Creates options that add an operand that matches the posting if a@@ -280,7 +278,7 @@ -> OptSpec ( CaseSensitive -> MatcherFactory- -> Ex.Exceptional Error Operand )+ -> Either Error Operand ) patternOption str mc f = C.OptSpec [str] so (C.OneArg g) where so = maybe [] (:[]) mc@@ -291,7 +289,7 @@ -- colon-separated account name. account :: OptSpec ( CaseSensitive -> MatcherFactory- -> Ex.Exceptional Error Operand )+ -> Either Error Operand ) account = C.OptSpec ["account"] "a" (C.OneArg f) where f a1 cs fty@@ -303,7 +301,7 @@ -- level matches. accountLevel :: OptSpec ( CaseSensitive -> MatcherFactory- -> Ex.Exceptional Error Operand)+ -> Either Error Operand) accountLevel = C.OptSpec ["account-level"] "" (C.TwoArg f) where f a1 a2 cs fty@@ -314,49 +312,49 @@ -- a single sub-account name at any level. accountAny :: OptSpec ( CaseSensitive -> MatcherFactory- -> Ex.Exceptional Error Operand )+ -> Either Error Operand ) accountAny = patternOption "account-any" Nothing P.accountAny -- | The payee option; returns True if the matcher matches the payee -- name. payee :: OptSpec ( CaseSensitive -> MatcherFactory- -> Ex.Exceptional Error Operand )+ -> Either Error Operand ) payee = patternOption "payee" (Just 'p') P.payee tag :: OptSpec ( CaseSensitive -> MatcherFactory- -> Ex.Exceptional Error Operand)+ -> Either Error Operand) tag = patternOption "tag" (Just 't') P.tag number :: OptSpec ( CaseSensitive -> MatcherFactory- -> Ex.Exceptional Error Operand )+ -> Either Error Operand ) number = patternOption "number" (Just 'n') P.number flag :: OptSpec ( CaseSensitive -> MatcherFactory- -> Ex.Exceptional Error Operand)+ -> Either Error Operand) flag = patternOption "flag" (Just 'f') P.flag commodity :: OptSpec ( CaseSensitive -> MatcherFactory- -> Ex.Exceptional Error Operand)+ -> Either Error Operand) commodity = patternOption "commodity" (Just 'y') P.commodity filename :: OptSpec ( CaseSensitive -> MatcherFactory- -> Ex.Exceptional Error Operand )+ -> Either Error Operand ) filename = patternOption "filename" Nothing P.filename postingMemo :: OptSpec ( CaseSensitive -> MatcherFactory- -> Ex.Exceptional Error Operand)+ -> Either Error Operand) postingMemo = patternOption "posting-memo" Nothing P.postingMemo transactionMemo :: OptSpec ( CaseSensitive -> MatcherFactory- -> Ex.Exceptional Error Operand)+ -> Either Error Operand) transactionMemo = patternOption "transaction-memo" Nothing P.transactionMemo @@ -366,14 +364,14 @@ credit :: OptSpec Operand credit = C.OptSpec ["credit"] [] (C.NoArg P.credit) -qtyOption :: OptSpec (Ex.Exceptional Error Operand)+qtyOption :: OptSpec (Either Error 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 _ -> Ex.throw $ "failed to parse quantity"+ Left _ -> Left $ "failed to parse quantity" Right g -> pure . L.toQty $ g @@ -388,8 +386,8 @@ -> String -- ^ Name of the command line option, such as @global-transaction@ - -> ( OptSpec (Ex.Exceptional Error Operand)- , OptSpec (Ex.Exceptional Error Operand) )+ -> ( OptSpec (Either Error Operand)+ , OptSpec (Either Error Operand) ) -- ^ Parses both descending and ascending serial options. serialOption getSerial n = (osA, osD)@@ -420,8 +418,8 @@ -> (Int -> Ordering -> E.Pdct L.Posting) -- ^ Function that returns a Pdct for reverse serial - -> ( OptSpec (Ex.Exceptional Error Operand)- , OptSpec (Ex.Exceptional Error Operand) )+ -> ( OptSpec (Either Error Operand)+ , OptSpec (Either Error Operand) ) -- ^ Parses both descending and ascending serial options. siblingSerialOption n fFwd fBak = (osA, osD)@@ -443,26 +441,26 @@ "" -> "" x:xs -> toUpper x : xs -globalTransaction :: ( OptSpec (Ex.Exceptional Error Operand)- , OptSpec (Ex.Exceptional Error Operand) )+globalTransaction :: ( OptSpec (Either Error Operand)+ , OptSpec (Either Error Operand) ) globalTransaction = let f = fmap L.unGlobalTransaction . Q.globalTransaction in serialOption f "globalTransaction" -globalPosting :: ( OptSpec (Ex.Exceptional Error Operand)- , OptSpec (Ex.Exceptional Error Operand) )+globalPosting :: ( OptSpec (Either Error Operand)+ , OptSpec (Either Error Operand) ) globalPosting = let f = fmap L.unGlobalPosting . Q.globalPosting in serialOption f "globalPosting" -filePosting :: ( OptSpec (Ex.Exceptional Error Operand)- , OptSpec (Ex.Exceptional Error Operand) )+filePosting :: ( OptSpec (Either Error Operand)+ , OptSpec (Either Error Operand) ) filePosting = let f = fmap L.unFilePosting . Q.filePosting in serialOption f "filePosting" -fileTransaction :: ( OptSpec (Ex.Exceptional Error Operand)- , OptSpec (Ex.Exceptional Error Operand) )+fileTransaction :: ( OptSpec (Either Error Operand)+ , OptSpec (Either Error Operand) ) fileTransaction = let f = fmap L.unFileTransaction . Q.fileTransaction in serialOption f "fileTransaction"@@ -472,7 +470,7 @@ :: L.DateTime -> [OptSpec (CaseSensitive -> MatcherFactory- -> Ex.Exceptional Error Operand)]+ -> Either Error Operand)] operandSpecs dt = [ fmap (const . const) date@@ -509,7 +507,7 @@ serialSpecs :: [OptSpec (CaseSensitive -> MatcherFactory- -> Ex.Exceptional Error Operand)]+ -> Either Error Operand)] serialSpecs = concat $ [unDouble]@@ -520,9 +518,9 @@ unDouble :: Functor f- => (f (Ex.Exceptional Error a),- f (Ex.Exceptional Error a ))- -> [ f (x -> y -> Ex.Exceptional Error a) ]+ => (f (Either Error a),+ f (Either Error a ))+ -> [ f (x -> y -> Either Error a) ] unDouble (o1, o2) = [fmap (const . const) o1, fmap (const . const) o2] @@ -535,7 +533,7 @@ data BadHeadTailError = BadHeadTailError Text deriving Show -optHead :: OptSpec (Ex.Exceptional Error PostFilterFn)+optHead :: OptSpec (Either Error PostFilterFn) optHead = C.OptSpec ["head"] [] (C.OneArg f) where f a = do@@ -543,7 +541,7 @@ let g _ ii = ii < (ItemIndex num) return g -optTail :: OptSpec (Ex.Exceptional Error PostFilterFn)+optTail :: OptSpec (Either Error PostFilterFn) optTail = C.OptSpec ["tail"] [] (C.OneArg f) where f a = do@@ -552,8 +550,8 @@ return g postFilterSpecs- :: ( OptSpec (Ex.Exceptional Error PostFilterFn)- , OptSpec (Ex.Exceptional Error PostFilterFn))+ :: ( OptSpec (Either Error PostFilterFn)+ , OptSpec (Either Error PostFilterFn)) postFilterSpecs = (optHead, optTail) ------------------------------------------------------------@@ -576,17 +574,15 @@ return (TM.within c t) pcre :: OptSpec MatcherFactory-pcre = C.OptSpec ["pcre"] "r" (C.NoArg TM.pcre)--posix :: OptSpec MatcherFactory-posix = C.OptSpec ["posix"] "" (C.NoArg TM.tdfa)+pcre = C.OptSpec ["pcre"] "r"+ (C.NoArg (\cs x -> TM.pcre cs x)) exact :: OptSpec MatcherFactory exact = C.OptSpec ["exact"] "x" . C.NoArg $ \c t -> return (TM.exact c t) matcherSelectSpecs :: [OptSpec MatcherFactory]-matcherSelectSpecs = [within, pcre, posix, exact]+matcherSelectSpecs = [within, pcre, exact] caseSelectSpecs :: [OptSpec CaseSensitive] caseSelectSpecs = [parseInsensitive, parseSensitive]@@ -641,26 +637,26 @@ -- Siblings -- -sGlobalPosting :: ( OptSpec (Ex.Exceptional Error Operand)- , OptSpec (Ex.Exceptional Error Operand) )+sGlobalPosting :: ( OptSpec (Either Error Operand)+ , OptSpec (Either Error Operand) ) sGlobalPosting = siblingSerialOption "globalPosting" PS.fwdGlobalPosting PS.backGlobalPosting -sFilePosting :: ( OptSpec (Ex.Exceptional Error Operand)- , OptSpec (Ex.Exceptional Error Operand) )+sFilePosting :: ( OptSpec (Either Error Operand)+ , OptSpec (Either Error Operand) ) sFilePosting = siblingSerialOption "filePosting" PS.fwdFilePosting PS.backFilePosting -sGlobalTransaction :: ( OptSpec (Ex.Exceptional Error Operand)- , OptSpec (Ex.Exceptional Error Operand) )+sGlobalTransaction :: ( OptSpec (Either Error Operand)+ , OptSpec (Either Error Operand) ) sGlobalTransaction = siblingSerialOption "globalTransaction" PS.fwdGlobalTransaction PS.backGlobalTransaction -sFileTransaction :: ( OptSpec (Ex.Exceptional Error Operand)- , OptSpec (Ex.Exceptional Error Operand) )+sFileTransaction :: ( OptSpec (Either Error Operand)+ , OptSpec (Either Error Operand) ) sFileTransaction = siblingSerialOption "filePosting" PS.fwdFileTransaction PS.backFileTransaction@@ -668,7 +664,7 @@ sAccount :: OptSpec ( CaseSensitive -> MatcherFactory- -> Ex.Exceptional Error Operand )+ -> Either Error Operand ) sAccount = C.OptSpec ["s-account"] "" (C.OneArg f) where f a1 cs fty = fmap PS.account@@ -676,7 +672,7 @@ sAccountLevel :: OptSpec ( CaseSensitive -> MatcherFactory- -> Ex.Exceptional Error Operand )+ -> Either Error Operand ) sAccountLevel = C.OptSpec ["s-account-level"] "" (C.TwoArg f) where f a1 a2 cs fty@@ -684,39 +680,39 @@ sAccountAny :: OptSpec ( CaseSensitive -> MatcherFactory- -> Ex.Exceptional Error Operand )+ -> Either Error Operand ) sAccountAny = patternOption "s-account-any" Nothing PS.accountAny -- | The payee option; returns True if the matcher matches the payee -- name. sPayee :: OptSpec ( CaseSensitive -> MatcherFactory- -> Ex.Exceptional Error Operand )+ -> Either Error Operand ) sPayee = patternOption "s-payee" (Just 'p') PS.payee sTag :: OptSpec ( CaseSensitive -> MatcherFactory- -> Ex.Exceptional Error Operand)+ -> Either Error Operand) sTag = patternOption "s-tag" (Just 't') PS.tag sNumber :: OptSpec ( CaseSensitive -> MatcherFactory- -> Ex.Exceptional Error Operand )+ -> Either Error Operand ) sNumber = patternOption "s-number" Nothing PS.number sFlag :: OptSpec ( CaseSensitive -> MatcherFactory- -> Ex.Exceptional Error Operand)+ -> Either Error Operand) sFlag = patternOption "s-flag" Nothing PS.flag sCommodity :: OptSpec ( CaseSensitive -> MatcherFactory- -> Ex.Exceptional Error Operand)+ -> Either Error Operand) sCommodity = patternOption "s-commodity" Nothing PS.commodity sPostingMemo :: OptSpec ( CaseSensitive -> MatcherFactory- -> Ex.Exceptional Error Operand)+ -> Either Error Operand) sPostingMemo = patternOption "s-posting-memo" Nothing PS.postingMemo sDebit :: OptSpec Operand@@ -725,14 +721,14 @@ sCredit :: OptSpec Operand sCredit = C.OptSpec ["s-credit"] [] (C.NoArg PS.credit) -sQtyOption :: OptSpec (Ex.Exceptional Error Operand)+sQtyOption :: OptSpec (Either Error 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 _ -> Ex.throw "could not parse quantity"+ Left _ -> Left "could not parse quantity" Right g -> pure . L.toQty $ g --
lib/Penny/Lincoln/Bits/Qty.hs view
@@ -65,7 +65,6 @@ -- # Imports import Control.Applicative ((<|>))-import qualified Control.Monad.Exception.Synchronous as Ex import Data.Text (Text) import qualified Data.Text as X import Data.Ord(Down(..), comparing)@@ -765,12 +764,14 @@ largestRemainderMethod ts pvs = let err s = error $ "largestRemainderMethod: error: " ++ s- in Ex.resolve err $ do- Ex.assert "TotalSeats not positive" (ts > 0)- Ex.assert "sum of [PartyVotes] not positive" (sum pvs > 0)- Ex.assert "negative member of [PartyVotes]" (minimum pvs >= 0)+ in either err id $ do+ assert "TotalSeats not positive" (ts > 0)+ assert "sum of [PartyVotes] not positive" (sum pvs > 0)+ assert "negative member of [PartyVotes]" (minimum pvs >= 0) return (allocRemainder ts . allocAuto ts $ pvs) +assert :: e -> Bool -> Either e ()+assert e b = if b then Right () else Left e autoAndRemainder :: TotSeats -> TotVotes -> PartyVotes -> (AutoSeats, Remainder)
lib/Penny/Lincoln/Matchers.hs view
@@ -3,7 +3,6 @@ module Penny.Lincoln.Matchers where import qualified Data.Text as X-import qualified Control.Monad.Exception.Synchronous as Ex import qualified Text.Matchers as MT -- | A function that makes Matchers.@@ -15,7 +14,7 @@ -- ^ The pattern to use when testing for a match. For example, this -- might be a regular expression, or simply the text to be matched. - -> Ex.Exceptional X.Text MT.Matcher+ -> Either X.Text MT.Matcher -- ^ Sometimes producing a matcher might fail; for example, the user -- might have supplied a bad pattern. If so, an exception is -- returned. On success, a Matcher is returned.
lib/Penny/Lincoln/PriceDb.hs view
@@ -12,7 +12,6 @@ convertAsOf ) where -import qualified Control.Monad.Exception.Synchronous as Ex import qualified Data.Map as M import qualified Data.Time as T import qualified Penny.Lincoln.Bits as B@@ -65,17 +64,17 @@ -> B.From -> B.To -> B.DateTime- -> Ex.Exceptional PriceDbError B.CountPerUnit+ -> Either PriceDbError B.CountPerUnit getPrice (PriceDb db) fr to dt = do let utc = B.toUTC dt- toMap <- Ex.fromMaybe FromNotFound $ M.lookup fr db- cpuMap <- Ex.fromMaybe ToNotFound $ M.lookup to toMap+ toMap <- maybe (Left FromNotFound) Right $ M.lookup fr db+ cpuMap <- maybe (Left ToNotFound) Right $ M.lookup to toMap let (lower, exact, _) = M.splitLookup utc cpuMap case exact of Just c -> return c Nothing -> if M.null lower- then Ex.throw CpuNotFound+ then Left CpuNotFound else return . snd . M.findMax $ lower @@ -90,7 +89,7 @@ -> B.DateTime -> B.To -> B.Amount q- -> Ex.Exceptional PriceDbError B.Qty+ -> Either PriceDbError B.Qty convertAsOf db dt to (B.Amount qt fr) | fr == B.unTo to = return . B.toQty $ qt | otherwise = do
lib/Penny/Lincoln/Serial.hs view
@@ -9,8 +9,6 @@ import Data.Traversable (Traversable) import qualified Data.Traversable as Tr import qualified Data.Foldable as Fdbl-import GHC.Generics (Generic)-import Data.Binary (Binary) data SerialSt = SerialSt { nextFwd :: Int@@ -21,9 +19,7 @@ data Serial = Serial { forward :: Int , backward :: Int- } deriving (Eq, Show, Ord, Generic)--instance Binary Serial+ } deriving (Eq, Show, Ord) newtype GenSerial a = GenSerial (SerialSt -> (a, SerialSt))
lib/Penny/Steel/Sums.hs view
@@ -4,25 +4,18 @@ module Penny.Steel.Sums where -import Data.Binary (Binary)-import GHC.Generics (Generic)- data S3 a b c = S3a a | S3b b | S3c c- deriving (Eq, Ord, Show, Generic)--instance (Binary a, Binary b, Binary c) => Binary (S3 a b c)+ deriving (Eq, Ord, Show) data S4 a b c d = S4a a | S4b b | S4c c | S4d d- deriving (Eq, Ord, Show, Generic)--instance (Binary a, Binary b, Binary c, Binary d) => Binary (S4 a b c d)+ deriving (Eq, Ord, Show) partitionS3 :: [S3 a b c] -> ([a], [b], [c]) partitionS3 = foldr f ([], [], [])
lib/Penny/Wheat.hs view
@@ -24,7 +24,6 @@ , main ) where -import qualified Control.Monad.Exception.Synchronous as Ex import Data.Either (partitionEithers) import Data.Maybe (mapMaybe) import qualified Penny.Copper as Cop@@ -110,16 +109,16 @@ } -parseBaseTime :: String -> Ex.Exceptional MA.InputError Time.UTCTime+parseBaseTime :: String -> Either MA.InputError Time.UTCTime parseBaseTime s = case Parsec.parse CP.dateTime "" (X.pack s) of- Left e -> Ex.throw (MA.ErrorMsg $ "could not parse date: " ++ show e)+ Left e -> Left (MA.ErrorMsg $ "could not parse date: " ++ show e) Right g -> return . L.toUTC $ g -parseRegexp :: String -> Ex.Exceptional MA.InputError (TT.Name -> Bool)+parseRegexp :: String -> Either MA.InputError (TT.Name -> Bool) parseRegexp s = case M.pcre M.Sensitive (X.pack s) of- Ex.Exception e -> Ex.throw . MA.ErrorMsg $+ Left e -> Left . MA.ErrorMsg $ "could not parse regular expression: " ++ X.unpack e- Ex.Success m -> return . M.match $ m+ Right m -> return . M.match $ m allOpts :: [MA.OptSpec (WheatConf -> WheatConf)] allOpts =
lib/Penny/Zinc.hs view
@@ -24,7 +24,6 @@ import Control.Applicative ((<*>), pure, (<$)) import qualified Control.Monad.Trans.State as St-import qualified Control.Monad.Exception.Synchronous as Ex import Data.Char (toUpper, toLower) import Data.Either (partitionEithers) import Data.List (isPrefixOf)@@ -68,7 +67,6 @@ data Matcher = Within | Exact- | TDFA | PCRE deriving (Eq, Show) @@ -160,12 +158,12 @@ data OptResult = ROperand (M.CaseSensitive -> Ly.MatcherFactory- -> Ex.Exceptional Ly.Error Ly.Operand)- | RPostFilter (Ex.Exceptional Ly.Error Ly.PostFilterFn)+ -> Either Ly.Error Ly.Operand)+ | RPostFilter (Either Ly.Error Ly.PostFilterFn) | RMatcherSelect Ly.MatcherFactory | RCaseSelect M.CaseSensitive | ROperator (X.Token L.Posting)- | RSortSpec (Ex.Exceptional Error Orderer)+ | RSortSpec (Either Error Orderer) | RColorToFile ColorToFile | RScheme E.Changers | RExprDesc X.ExprDesc@@ -174,7 +172,7 @@ getPostFilters :: [OptResult]- -> Ex.Exceptional Ly.Error [Ly.PostFilterFn]+ -> Either Ly.Error [Ly.PostFilterFn] getPostFilters = sequence . mapMaybe f@@ -197,7 +195,7 @@ getSortSpec :: Orderer -> [OptResult]- -> Ex.Exceptional Error Orderer+ -> Either Error Orderer getSortSpec i ls = let getSpec o = case o of RSortSpec x -> Just x@@ -208,12 +206,12 @@ else fmap mconcat . sequence $ exSpecs type Factory = M.CaseSensitive- -> Text -> Ex.Exceptional Text M.Matcher+ -> Text -> Either Text M.Matcher makeToken :: OptResult -> St.State (M.CaseSensitive, Factory)- (Maybe (Ex.Exceptional Ly.Error (X.Token L.Posting)))+ (Maybe (Either Ly.Error (X.Token L.Posting))) makeToken o = case o of ROperand f -> do (s, fty) <- St.get@@ -234,15 +232,14 @@ makeTokens :: Defaults -> [OptResult]- -> Ex.Exceptional Ly.Error ( [X.Token L.Posting]+ -> Either Ly.Error ( [X.Token L.Posting] , (M.CaseSensitive, Factory) ) makeTokens df os = let initSt = (sensitive df, fty) fty = case matcher df of Within -> \c t -> return (M.within c t) Exact -> \c t -> return (M.exact c t)- TDFA -> M.tdfa- PCRE -> M.pcre+ PCRE -> \c t -> M.pcre c t lsSt = mapM makeToken os (ls, st') = St.runState lsSt initSt in fmap (\xs -> (xs, st')) . sequence . catMaybes $ ls@@ -344,20 +341,20 @@ -> Defaults -> [I.Report] -> [OptResult]- -> Ex.Exceptional String+ -> Either String (Either a [MA.Mode (MA.ProgName -> String) (IO ())]) processGlobal rt srt df rpts os = case processFiltOpts srt df os of- Ex.Exception s -> Ex.throw s- Ex.Success fo ->+ Left s -> Left s+ Right fo -> return . Right $ map (makeMode (formatQty df) rt fo) rpts processFiltOpts :: Orderer -> Defaults -> [OptResult]- -> Ex.Exceptional String FilterOpts-processFiltOpts ord df os = Ex.mapException unpack $ do+ -> Either String FilterOpts+processFiltOpts ord df os = either (Left . unpack) Right $ do postFilts <- getPostFilters os sortSpec <- getSortSpec ord os (toks, (rs, rf)) <- makeTokens df os@@ -384,7 +381,7 @@ (foExprDesc fo) (fmap snd (foSorterFilterer fo)) makeIO parseResult = do (posArgs, printRpt) <-- Ex.switch handleTextError return parseResult+ either handleTextError return parseResult items <- C.open posArgs let fmt = mkFmt items (txns, pps) = splitLedger items@@ -395,7 +392,7 @@ verbFiltChunks = (fst . foSorterFilterer fo $ txns) fmt showFilterExpression printer (foShowExpression fo) (foPredicate fo) showVerboseFilter printer (foVerboseFilter fo) verbFiltChunks- Ex.switch handleTextError (R.putChunks term)+ either handleTextError (R.putChunks term) $ printRpt fmt txns pps @@ -517,14 +514,14 @@ (x == y) && ((map toUpper xs) `isPrefixOf` (map toUpper ys)) _ -> True -sortSpecs :: MA.OptSpec (Ex.Exceptional Error Orderer)+sortSpecs :: MA.OptSpec (Either Error 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- _ -> Ex.throw $ "bad sort specification: " <> pack a <> "\n"+ _ -> Left $ "bad sort specification: " <> pack a <> "\n" @@ -641,10 +638,6 @@ , "-r, --pcre" , " Use \"pcre\" matcher" ++ ifDefault (matcher d == PCRE)-- , "--posix"- , " Use \"posix\" matcher"- ++ ifDefault (matcher d == TDFA) , "-x, --exact" , " Use \"exact\" matcher"
penny.cabal view
@@ -1,5 +1,5 @@ Name: penny-Version: 0.26.0.0+Version: 0.28.0.0 Cabal-version: >=1.8 Build-Type: Simple License: BSD3@@ -183,17 +183,15 @@ Build-depends: base ==4.6.* , action-permutations ==0.0.0.0- , binary ==0.7.* , bytestring ==0.10.* , cereal ==0.3.* , containers ==0.5.*- , explicit-exception ==0.1.*- , matchers ==0.6.*- , multiarg ==0.18.*- , ofx ==0.2.*+ , matchers ==0.10.*+ , multiarg ==0.22.*+ , ofx ==0.4.* , old-locale ==1.0.* , parsec >= 3.1.2 && < 3.2- , prednote == 0.14.*+ , prednote == 0.16.* , pretty-show ==1.5.* , rainbow ==0.4.* , semigroups ==0.9.*@@ -309,12 +307,12 @@ Build-depends: penny , base == 4.6.*- , explicit-exception ==0.1.* , containers ==0.5.*+ , either ==3.4.* , semigroups ==0.9.* , text ==0.11.* , parsec ==3.1.*- , multiarg ==0.18.*+ , multiarg ==0.22.* , transformers ==0.3.* other-modules: Paths_penny@@ -336,8 +334,7 @@ penny , base ==4.6.* , text ==0.11.*- , multiarg ==0.18.*- , explicit-exception == 0.1.*+ , multiarg ==0.22.* hs-source-dirs: bin Main-is: penny-diff.hs@@ -357,7 +354,7 @@ Build-depends: penny , base ==4.6.*- , multiarg ==0.18.*+ , multiarg ==0.22.* , pretty-show ==1.5.* , text ==0.11.* @@ -377,8 +374,7 @@ penny , base ==4.6.* , text ==0.11.*- , multiarg ==0.18.*- , explicit-exception ==0.1.*+ , multiarg ==0.22.* hs-source-dirs: bin main-is: penny-reconcile.hs@@ -423,8 +419,7 @@ , random-shuffle ==0.0.4 , base ==4.6.*- , explicit-exception ==0.1.*- , multiarg ==0.18.*+ , multiarg ==0.22.* , parsec >= 3.1.2 && < 3.2 , semigroups ==0.9.* , text ==0.11.*@@ -451,8 +446,7 @@ , random ==1.0.* , base ==4.6.*- , explicit-exception ==0.1.*- , multiarg ==0.18.*+ , multiarg ==0.22.* , semigroups ==0.9.* , text ==0.11.* , time ==1.4.*
tests/penny-gibberish.hs view
@@ -1,7 +1,6 @@ module Main where import qualified System.Console.MultiArg as MA-import qualified Control.Monad.Exception.Synchronous as Ex import qualified Test.QuickCheck.Gen as G import qualified System.Random as Rand import Control.Monad (replicateM)@@ -38,18 +37,18 @@ [ MA.OptSpec ["size"] "s" . MA.OneArgE $ \s -> do i <- MA.reader s if i < 1- then Ex.throw (MA.ErrorMsg "non-positive size parameter")+ then Left (MA.ErrorMsg "non-positive size parameter") else return (\os -> os { optSize = i }) , MA.OptSpec ["count"] "c" . MA.OneArgE $ \s -> do i <- MA.reader s if i < 1- then Ex.throw (MA.ErrorMsg "non-positive count parameter")+ then Left (MA.ErrorMsg "non-positive count parameter") else return (\os -> os { optCount = i }) ] -posArg :: a -> Ex.Exceptional MA.InputError b-posArg _ = Ex.throw (MA.ErrorMsg "no non-option arguments accepted")+posArg :: a -> Either MA.InputError b+posArg _ = Left (MA.ErrorMsg "no non-option arguments accepted") parse :: [(Opts -> Opts)] -> Opts parse os = foldl (flip (.)) id os defaultOpts
tests/penny-test.hs view
@@ -2,7 +2,6 @@ import qualified Lincoln as L import qualified Copper as C-import qualified Control.Monad.Exception.Synchronous as Ex import qualified System.Console.MultiArg as MA import qualified System.Exit as Exit import qualified Test.QuickCheck as Q@@ -36,7 +35,7 @@ main = do opts <- MA.simpleHelp help options MA.Intersperse- ( const . Ex.Exception . MA.ErrorMsg+ ( const . Left . MA.ErrorMsg $ "this command does not accept positional arguments") let args = foldl (flip (.)) id opts Q.stdArgs runner = Q.quickCheckWithResult args