ENH show errors in parallel
This commit is contained in:
parent
d3837feea5
commit
6a43a9a78a
|
@ -306,7 +306,7 @@ getDBState
|
||||||
:: MonadUnliftIO m
|
:: MonadUnliftIO m
|
||||||
=> Config
|
=> Config
|
||||||
-> SqlPersistT m (EitherErrs (FilePath -> DBState))
|
-> SqlPersistT m (EitherErrs (FilePath -> DBState))
|
||||||
getDBState c = mapM (uncurry go) $ mapError2 bi si (,)
|
getDBState c = mapM (uncurry go) $ concatEithers2 bi si (,)
|
||||||
where
|
where
|
||||||
bi = intervalMaybeBounds $ budgetInterval $ global c
|
bi = intervalMaybeBounds $ budgetInterval $ global c
|
||||||
si = intervalMaybeBounds $ statementInterval $ global c
|
si = intervalMaybeBounds $ statementInterval $ global c
|
||||||
|
|
|
@ -8,6 +8,7 @@ module Internal.Insert
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
import Data.Bitraversable
|
||||||
import Data.Hashable
|
import Data.Hashable
|
||||||
import Database.Persist.Class
|
import Database.Persist.Class
|
||||||
import Database.Persist.Sql hiding (Single, Statement)
|
import Database.Persist.Sql hiding (Single, Statement)
|
||||||
|
@ -122,7 +123,7 @@ insertBudget :: MonadUnliftIO m => Budget -> MappingT m [InsertError]
|
||||||
insertBudget Budget {income = is, expenses = es} = do
|
insertBudget Budget {income = is, expenses = es} = do
|
||||||
es1 <- mapM insertIncome is
|
es1 <- mapM insertIncome is
|
||||||
es2 <- mapM insertExpense es
|
es2 <- mapM insertExpense es
|
||||||
return $ catMaybes es1 ++ concat es2
|
return $ concat $ es1 ++ es2
|
||||||
|
|
||||||
-- TODO this hashes twice (not that it really matters)
|
-- TODO this hashes twice (not that it really matters)
|
||||||
whenHash
|
whenHash
|
||||||
|
@ -137,7 +138,7 @@ whenHash t o def f = do
|
||||||
hs <- asks kmNewCommits
|
hs <- asks kmNewCommits
|
||||||
if h `elem` hs then f =<< lift (insert $ CommitR h t) else return def
|
if h `elem` hs then f =<< lift (insert $ CommitR h t) else return def
|
||||||
|
|
||||||
insertIncome :: MonadUnliftIO m => Income -> MappingT m (Maybe InsertError)
|
insertIncome :: MonadUnliftIO m => Income -> MappingT m [InsertError]
|
||||||
insertIncome
|
insertIncome
|
||||||
i@Income
|
i@Income
|
||||||
{ incCurrency = cur
|
{ incCurrency = cur
|
||||||
|
@ -145,21 +146,18 @@ insertIncome
|
||||||
, incAccount = from
|
, incAccount = from
|
||||||
, incTaxes = ts
|
, incTaxes = ts
|
||||||
} =
|
} =
|
||||||
whenHash CTIncome i Nothing $ \c -> do
|
whenHash CTIncome i [] $ \c -> do
|
||||||
case balanceIncome i of
|
bounds <- (liftIO . resolveBounds) =<< asks kmBudgetInterval
|
||||||
Left m -> liftIO $ print m >> return Nothing
|
case (balanceIncome i, expandDatePat bounds dp) of
|
||||||
Right as -> do
|
(Right balanced, Right days) -> do
|
||||||
bounds <- (liftIO . resolveBounds) =<< asks kmBudgetInterval
|
forM_ days $ \day -> do
|
||||||
case expandDatePat bounds dp of
|
alloTx <- concat <$> mapM (allocationToTx from day) balanced
|
||||||
Left e -> return $ Just e
|
taxTx <- fmap (,Fixed) <$> mapM (taxToTx from day cur) ts
|
||||||
Right days -> do
|
lift $ mapM_ (\(t, b) -> insertTxBucket (Just b) c t) $ alloTx ++ taxTx
|
||||||
forM_ days $ \day -> do
|
return []
|
||||||
alloTx <- concat <$> mapM (allocationToTx from day) as
|
(a, b) -> return $ catMaybes [leftToMaybe a, leftToMaybe b]
|
||||||
taxTx <- fmap (,Fixed) <$> mapM (taxToTx from day cur) ts
|
|
||||||
lift $ mapM_ (\(t, b) -> insertTxBucket (Just b) c t) $ alloTx ++ taxTx
|
|
||||||
return Nothing
|
|
||||||
|
|
||||||
balanceIncome :: Income -> Either T.Text [BalAllocation]
|
balanceIncome :: Income -> EitherErr [BalAllocation]
|
||||||
balanceIncome
|
balanceIncome
|
||||||
Income
|
Income
|
||||||
{ incGross = g
|
{ incGross = g
|
||||||
|
@ -181,17 +179,19 @@ sumAllocations = sum . concatMap (fmap amtValue . alloAmts)
|
||||||
sumTaxes :: [Tax] -> Rational
|
sumTaxes :: [Tax] -> Rational
|
||||||
sumTaxes = sum . fmap (dec2Rat . taxValue)
|
sumTaxes = sum . fmap (dec2Rat . taxValue)
|
||||||
|
|
||||||
balancePostTax :: Rational -> [RawAllocation] -> Either T.Text [BalAllocation]
|
-- TODO these errors could be more descriptive by including an indicator
|
||||||
|
-- of the budget itself
|
||||||
|
balancePostTax :: Rational -> [RawAllocation] -> EitherErr [BalAllocation]
|
||||||
balancePostTax bal as
|
balancePostTax bal as
|
||||||
| null as = Left "no allocations to balance"
|
| null as = Left $ AllocationError NoAllocations
|
||||||
| otherwise = case partitionEithers $ fmap hasVal as of
|
| otherwise = case partitionEithers $ fmap hasVal as of
|
||||||
([([empty], nonmissing)], bs) ->
|
([([empty], nonmissing)], bs) ->
|
||||||
let s = bal - sumAllocations (nonmissing : bs)
|
let s = bal - sumAllocations (nonmissing : bs)
|
||||||
in if s < 0
|
in if s < 0
|
||||||
then Left "allocations exceed total"
|
then Left $ AllocationError ExceededTotal
|
||||||
else Right $ mapAmts (empty {amtValue = s} :) nonmissing : bs
|
else Right $ mapAmts (empty {amtValue = s} :) nonmissing : bs
|
||||||
([], _) -> Left "need one blank amount to balance"
|
([], _) -> Left $ AllocationError MissingBlank
|
||||||
_ -> Left "multiple blank amounts present"
|
_ -> Left $ AllocationError TooManyBlanks
|
||||||
where
|
where
|
||||||
hasVal a@Allocation {alloAmts = xs} =
|
hasVal a@Allocation {alloAmts = xs} =
|
||||||
case partitionEithers $ fmap maybeAmt xs of
|
case partitionEithers $ fmap maybeAmt xs of
|
||||||
|
@ -245,15 +245,12 @@ insertExpense
|
||||||
, expBucket = buc
|
, expBucket = buc
|
||||||
, expAmounts = as
|
, expAmounts = as
|
||||||
} = do
|
} = do
|
||||||
whenHash CTExpense e [] $ \key -> catMaybes <$> mapM (go key) as
|
whenHash CTExpense e [] $ \key -> concat <$> mapM (go key) as
|
||||||
where
|
where
|
||||||
go key amt = do
|
go key amt = do
|
||||||
res <- timeAmountToTx from to cur amt
|
res <- timeAmountToTx from to cur amt
|
||||||
case res of
|
unlessLeft res $
|
||||||
Left err -> return $ Just err
|
lift . mapM_ (insertTxBucket (Just buc) key)
|
||||||
Right txs -> do
|
|
||||||
lift $ mapM_ (insertTxBucket (Just buc) key) txs
|
|
||||||
return Nothing
|
|
||||||
|
|
||||||
timeAmountToTx
|
timeAmountToTx
|
||||||
:: MonadUnliftIO m
|
:: MonadUnliftIO m
|
||||||
|
@ -275,9 +272,7 @@ timeAmountToTx
|
||||||
}
|
}
|
||||||
} = do
|
} = do
|
||||||
bounds <- (liftIO . resolveBounds) =<< asks kmBudgetInterval
|
bounds <- (liftIO . resolveBounds) =<< asks kmBudgetInterval
|
||||||
case expandDatePat bounds dp of
|
bimapM return (mapM tx) $ expandDatePat bounds dp
|
||||||
Left e -> return $ Left e
|
|
||||||
Right days -> Right <$> mapM tx days
|
|
||||||
where
|
where
|
||||||
tx day = txPair day from to cur (dec2Rat v) d
|
tx day = txPair day from to cur (dec2Rat v) d
|
||||||
|
|
||||||
|
@ -285,15 +280,15 @@ timeAmountToTx
|
||||||
-- statements
|
-- statements
|
||||||
|
|
||||||
insertStatements :: MonadUnliftIO m => Config -> MappingT m [InsertError]
|
insertStatements :: MonadUnliftIO m => Config -> MappingT m [InsertError]
|
||||||
insertStatements conf = catMaybes <$> mapM insertStatement (statements conf)
|
insertStatements conf = concat <$> mapM insertStatement (statements conf)
|
||||||
|
|
||||||
-- unless (null es) $ throwIO $ InsertException es
|
-- unless (null es) $ throwIO $ InsertException es
|
||||||
|
|
||||||
insertStatement :: MonadUnliftIO m => Statement -> MappingT m (Maybe InsertError)
|
insertStatement :: MonadUnliftIO m => Statement -> MappingT m [InsertError]
|
||||||
insertStatement (StmtManual m) = insertManual m
|
insertStatement (StmtManual m) = insertManual m
|
||||||
insertStatement (StmtImport i) = insertImport i
|
insertStatement (StmtImport i) = insertImport i
|
||||||
|
|
||||||
insertManual :: MonadUnliftIO m => Manual -> MappingT m (Maybe InsertError)
|
insertManual :: MonadUnliftIO m => Manual -> MappingT m [InsertError]
|
||||||
insertManual
|
insertManual
|
||||||
m@Manual
|
m@Manual
|
||||||
{ manualDate = dp
|
{ manualDate = dp
|
||||||
|
@ -303,29 +298,23 @@ insertManual
|
||||||
, manualCurrency = u
|
, manualCurrency = u
|
||||||
, manualDesc = e
|
, manualDesc = e
|
||||||
} = do
|
} = do
|
||||||
whenHash CTManual m Nothing $ \c -> do
|
whenHash CTManual m [] $ \c -> do
|
||||||
bounds <- (liftIO . resolveBounds) =<< asks kmStatementInterval
|
bounds <- (liftIO . resolveBounds) =<< asks kmStatementInterval
|
||||||
case expandDatePat bounds dp of
|
unlessLeft (expandDatePat bounds dp) $ \days -> do
|
||||||
Left err -> return $ Just err
|
ts <- mapM tx days
|
||||||
Right days -> do
|
lift $ mapM_ (insertTx c) ts
|
||||||
ts <- mapM tx days
|
|
||||||
lift $ mapM_ (insertTx c) ts
|
|
||||||
return Nothing
|
|
||||||
where
|
where
|
||||||
tx day = txPair day from to u (dec2Rat v) e
|
tx day = txPair day from to u (dec2Rat v) e
|
||||||
|
|
||||||
insertImport :: MonadUnliftIO m => Import -> MappingT m (Maybe InsertError)
|
insertImport :: MonadUnliftIO m => Import -> MappingT m [InsertError]
|
||||||
insertImport i = whenHash CTImport i Nothing $ \c -> do
|
insertImport i = whenHash CTImport i [] $ \c -> do
|
||||||
bounds <- asks kmStatementInterval
|
bounds <- asks kmStatementInterval
|
||||||
res <- readImport i
|
res <- readImport i
|
||||||
-- TODO this isn't efficient, the whole file will be read and maybe no
|
-- TODO this isn't efficient, the whole file will be read and maybe no
|
||||||
-- transactions will be desired
|
-- transactions will be desired
|
||||||
case res of
|
unlessLefts res $ \bs -> do
|
||||||
Right bs -> do
|
rs <- mapM resolveTx $ filter (inMaybeBounds bounds . txDate) bs
|
||||||
rs <- mapM resolveTx $ filter (inMaybeBounds bounds . txDate) bs
|
lift $ mapM_ (insertTx c) rs
|
||||||
lift $ mapM_ (insertTx c) rs
|
|
||||||
return Nothing
|
|
||||||
Left e -> return $ Just e
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- low-level transaction stuff
|
-- low-level transaction stuff
|
||||||
|
|
|
@ -23,7 +23,7 @@ import qualified RIO.Vector as V
|
||||||
|
|
||||||
-- TODO this probably won't scale well (pipes?)
|
-- TODO this probably won't scale well (pipes?)
|
||||||
|
|
||||||
readImport :: MonadUnliftIO m => Import -> MappingT m (EitherErr [BalTx])
|
readImport :: MonadUnliftIO m => Import -> MappingT m (EitherErrs [BalTx])
|
||||||
readImport Import {..} =
|
readImport Import {..} =
|
||||||
matchRecords impMatches . L.sort . concat
|
matchRecords impMatches . L.sort . concat
|
||||||
<$> mapM (readImport_ impSkipLines impDelim impTxOpts) impPaths
|
<$> mapM (readImport_ impSkipLines impDelim impTxOpts) impPaths
|
||||||
|
@ -59,14 +59,15 @@ parseTxRecord p TxOpts {..} r = do
|
||||||
d' <- parseTimeM True defaultTimeLocale (T.unpack toDateFmt) d
|
d' <- parseTimeM True defaultTimeLocale (T.unpack toDateFmt) d
|
||||||
return $ Just $ TxRecord d' a e os p
|
return $ Just $ TxRecord d' a e os p
|
||||||
|
|
||||||
matchRecords :: [Match] -> [TxRecord] -> EitherErr [BalTx]
|
matchRecords :: [Match] -> [TxRecord] -> EitherErrs [BalTx]
|
||||||
matchRecords ms rs = do
|
matchRecords ms rs = do
|
||||||
(matched, unmatched, notfound) <- matchAll (matchPriorities ms) rs
|
(matched, unmatched, notfound) <- matchAll (matchPriorities ms) rs
|
||||||
-- TODO record number of times each match hits for debugging
|
case (matched, unmatched, notfound) of
|
||||||
matched_ <- mapM balanceTx matched
|
(ms_, [], []) -> do
|
||||||
case (matched_, unmatched, notfound) of
|
-- TODO record number of times each match hits for debugging
|
||||||
(xs, [], []) -> Right xs
|
matched_ <- first (: []) $ mapM balanceTx ms_
|
||||||
(_, us, ns) -> Left $ StatementError us ns
|
Right matched_
|
||||||
|
(_, us, ns) -> Left [StatementError us ns]
|
||||||
|
|
||||||
matchPriorities :: [Match] -> [MatchGroup]
|
matchPriorities :: [Match] -> [MatchGroup]
|
||||||
matchPriorities =
|
matchPriorities =
|
||||||
|
@ -100,7 +101,12 @@ resetZipper = initZipper . recoverZipper
|
||||||
recoverZipper :: Zipped a -> [a]
|
recoverZipper :: Zipped a -> [a]
|
||||||
recoverZipper (Zipped as bs) = reverse as ++ bs
|
recoverZipper (Zipped as bs) = reverse as ++ bs
|
||||||
|
|
||||||
zipperSlice :: Monad m => (a -> b -> m Ordering) -> b -> Zipped a -> m (Either (Zipped a) (Unzipped a))
|
zipperSlice
|
||||||
|
:: Monad m
|
||||||
|
=> (a -> b -> m Ordering)
|
||||||
|
-> b
|
||||||
|
-> Zipped a
|
||||||
|
-> m (Either (Zipped a) (Unzipped a))
|
||||||
zipperSlice f x = go
|
zipperSlice f x = go
|
||||||
where
|
where
|
||||||
go z@(Zipped _ []) = return $ Left z
|
go z@(Zipped _ []) = return $ Left z
|
||||||
|
@ -118,7 +124,7 @@ zipperSlice f x = go
|
||||||
EQ -> goEq $ Unzipped bs (a : cs) as
|
EQ -> goEq $ Unzipped bs (a : cs) as
|
||||||
LT -> return z
|
LT -> return z
|
||||||
|
|
||||||
zipperMatch :: Unzipped Match -> TxRecord -> EitherErr (Zipped Match, MatchRes RawTx)
|
zipperMatch :: Unzipped Match -> TxRecord -> EitherErrs (Zipped Match, MatchRes RawTx)
|
||||||
zipperMatch (Unzipped bs cs as) x = go [] cs
|
zipperMatch (Unzipped bs cs as) x = go [] cs
|
||||||
where
|
where
|
||||||
go _ [] = Right (Zipped bs $ cs ++ as, MatchFail)
|
go _ [] = Right (Zipped bs $ cs ++ as, MatchFail)
|
||||||
|
@ -131,7 +137,7 @@ zipperMatch (Unzipped bs cs as) x = go [] cs
|
||||||
ms' = maybe ms (: ms) (matchDec m)
|
ms' = maybe ms (: ms) (matchDec m)
|
||||||
in Right (Zipped bs $ ps ++ ms' ++ as, skipOrPass)
|
in Right (Zipped bs $ ps ++ ms' ++ as, skipOrPass)
|
||||||
|
|
||||||
zipperMatch' :: Zipped Match -> TxRecord -> EitherErr (Zipped Match, MatchRes RawTx)
|
zipperMatch' :: Zipped Match -> TxRecord -> EitherErrs (Zipped Match, MatchRes RawTx)
|
||||||
zipperMatch' z x = go z
|
zipperMatch' z x = go z
|
||||||
where
|
where
|
||||||
go (Zipped bs (a : as)) = do
|
go (Zipped bs (a : as)) = do
|
||||||
|
@ -147,7 +153,7 @@ matchDec m@Match {mTimes = t} =
|
||||||
where
|
where
|
||||||
t' = fmap pred t
|
t' = fmap pred t
|
||||||
|
|
||||||
matchAll :: [MatchGroup] -> [TxRecord] -> EitherErr ([RawTx], [TxRecord], [Match])
|
matchAll :: [MatchGroup] -> [TxRecord] -> EitherErrs ([RawTx], [TxRecord], [Match])
|
||||||
matchAll = go ([], [])
|
matchAll = go ([], [])
|
||||||
where
|
where
|
||||||
go (matched, unused) gs rs = case (gs, rs) of
|
go (matched, unused) gs rs = case (gs, rs) of
|
||||||
|
@ -157,13 +163,13 @@ matchAll = go ([], [])
|
||||||
(ts, unmatched, us) <- matchGroup g rs
|
(ts, unmatched, us) <- matchGroup g rs
|
||||||
go (ts ++ matched, us ++ unused) gs' unmatched
|
go (ts ++ matched, us ++ unused) gs' unmatched
|
||||||
|
|
||||||
matchGroup :: MatchGroup -> [TxRecord] -> EitherErr ([RawTx], [TxRecord], [Match])
|
matchGroup :: MatchGroup -> [TxRecord] -> EitherErrs ([RawTx], [TxRecord], [Match])
|
||||||
matchGroup MatchGroup {mgDate = ds, mgNoDate = ns} rs = do
|
matchGroup MatchGroup {mgDate = ds, mgNoDate = ns} rs = do
|
||||||
(md, rest, ud) <- matchDates ds rs
|
(md, rest, ud) <- matchDates ds rs
|
||||||
(mn, unmatched, un) <- matchNonDates ns rest
|
(mn, unmatched, un) <- matchNonDates ns rest
|
||||||
return (md ++ mn, unmatched, filter ((/= Nothing) . mTimes) $ ud ++ un)
|
return (md ++ mn, unmatched, filter ((/= Nothing) . mTimes) $ ud ++ un)
|
||||||
|
|
||||||
matchDates :: [Match] -> [TxRecord] -> EitherErr ([RawTx], [TxRecord], [Match])
|
matchDates :: [Match] -> [TxRecord] -> EitherErrs ([RawTx], [TxRecord], [Match])
|
||||||
matchDates ms = go ([], [], initZipper ms)
|
matchDates ms = go ([], [], initZipper ms)
|
||||||
where
|
where
|
||||||
go (matched, unmatched, z) [] =
|
go (matched, unmatched, z) [] =
|
||||||
|
@ -183,9 +189,9 @@ matchDates ms = go ([], [], initZipper ms)
|
||||||
MatchSkip -> (Nothing : matched, unmatched)
|
MatchSkip -> (Nothing : matched, unmatched)
|
||||||
MatchFail -> (matched, r : unmatched)
|
MatchFail -> (matched, r : unmatched)
|
||||||
go (m, u, z') rs
|
go (m, u, z') rs
|
||||||
findDate m r = maybe (Right EQ) (`compareDate` trDate r) $ mDate m
|
findDate m r = maybe (Right EQ) (first (: []) . (`compareDate` trDate r)) $ mDate m
|
||||||
|
|
||||||
matchNonDates :: [Match] -> [TxRecord] -> EitherErr ([RawTx], [TxRecord], [Match])
|
matchNonDates :: [Match] -> [TxRecord] -> EitherErrs ([RawTx], [TxRecord], [Match])
|
||||||
matchNonDates ms = go ([], [], initZipper ms)
|
matchNonDates ms = go ([], [], initZipper ms)
|
||||||
where
|
where
|
||||||
go (matched, unmatched, z) [] =
|
go (matched, unmatched, z) [] =
|
||||||
|
|
|
@ -511,6 +511,13 @@ data BalanceType = TooFewSplits | NotOneBlank deriving (Show)
|
||||||
|
|
||||||
data LookupField = AccountField | CurrencyField | OtherField deriving (Show)
|
data LookupField = AccountField | CurrencyField | OtherField deriving (Show)
|
||||||
|
|
||||||
|
data AllocationSuberr
|
||||||
|
= NoAllocations
|
||||||
|
| ExceededTotal
|
||||||
|
| MissingBlank
|
||||||
|
| TooManyBlanks
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
-- data ConversionSubError = Malformed | deriving (Show)
|
-- data ConversionSubError = Malformed | deriving (Show)
|
||||||
|
|
||||||
data InsertError
|
data InsertError
|
||||||
|
@ -519,6 +526,7 @@ data InsertError
|
||||||
| ConversionError T.Text
|
| ConversionError T.Text
|
||||||
| LookupError LookupField T.Text
|
| LookupError LookupField T.Text
|
||||||
| BalanceError BalanceType CurID [RawSplit]
|
| BalanceError BalanceType CurID [RawSplit]
|
||||||
|
| AllocationError AllocationSuberr
|
||||||
| StatementError [TxRecord] [Match]
|
| StatementError [TxRecord] [Match]
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
|
|
|
@ -293,6 +293,7 @@ showError other = (: []) $ case other of
|
||||||
(ConversionError x) -> T.append "Could not convert to rational number: " x
|
(ConversionError x) -> T.append "Could not convert to rational number: " x
|
||||||
-- TODO use the field indicator
|
-- TODO use the field indicator
|
||||||
(LookupError _ f) -> T.append "Could not find field: " f
|
(LookupError _ f) -> T.append "Could not find field: " f
|
||||||
|
(AllocationError _) -> "Could not balance allocation"
|
||||||
(BalanceError t cur rss) ->
|
(BalanceError t cur rss) ->
|
||||||
T.concat
|
T.concat
|
||||||
[ msg
|
[ msg
|
||||||
|
@ -412,3 +413,11 @@ concatEithersL = first concat . concatEitherL
|
||||||
leftToMaybe :: Either a b -> Maybe a
|
leftToMaybe :: Either a b -> Maybe a
|
||||||
leftToMaybe (Left a) = Just a
|
leftToMaybe (Left a) = Just a
|
||||||
leftToMaybe _ = Nothing
|
leftToMaybe _ = Nothing
|
||||||
|
|
||||||
|
unlessLeft :: (Monad m, MonadPlus n) => Either a b -> (b -> m ()) -> m (n a)
|
||||||
|
unlessLeft (Left es) _ = return (return es)
|
||||||
|
unlessLeft (Right rs) f = f rs >> return mzero
|
||||||
|
|
||||||
|
unlessLefts :: (Monad m, MonadPlus n) => Either (n a) b -> (b -> m ()) -> m (n a)
|
||||||
|
unlessLefts (Left es) _ = return es
|
||||||
|
unlessLefts (Right rs) f = f rs >> return mzero
|
||||||
|
|
Loading…
Reference in New Issue