ENH finish make errors not suck
This commit is contained in:
parent
f9c1e36ee8
commit
d63e1eaa4c
|
|
@ -540,8 +540,8 @@ data AllocationSuberr
|
|||
|
||||
data InsertError
|
||||
= RegexError T.Text
|
||||
| -- | YearError MatchYMD
|
||||
ConversionError T.Text
|
||||
| MatchValPrecisionError Natural Natural
|
||||
| ConversionError T.Text
|
||||
| LookupError LookupSuberr T.Text
|
||||
| BalanceError BalanceType CurID [RawSplit]
|
||||
| AllocationError AllocationSuberr DatePat
|
||||
|
|
|
|||
|
|
@ -107,8 +107,8 @@ resolveBounds (s, e) = do
|
|||
|
||||
matches :: Match -> TxRecord -> EitherErrs (MatchRes RawTx)
|
||||
matches Match {..} r@TxRecord {..} = do
|
||||
res <- concatEither2 other desc (&&)
|
||||
if date && val && res
|
||||
res <- concatEither3 val other desc $ \x y z -> x && y && z
|
||||
if date && res
|
||||
then maybe (Right MatchSkip) (fmap MatchPass . convert) mTx
|
||||
else Right MatchFail
|
||||
where
|
||||
|
|
@ -138,11 +138,14 @@ toTx sc sa toSplits r@TxRecord {..} =
|
|||
acRes = concatEithers2 (resolveAcnt r sa) (resolveCurrency r sc) (,)
|
||||
ssRes = concatEithersL $ fmap (resolveSplit r) toSplits
|
||||
|
||||
valMatches :: MatchVal -> Rational -> Bool
|
||||
valMatches MatchVal {..} x =
|
||||
checkMaybe (s ==) mvSign
|
||||
&& checkMaybe (n ==) mvNum
|
||||
&& checkMaybe ((d * p ==) . fromIntegral) mvDen
|
||||
valMatches :: MatchVal -> Rational -> EitherErr Bool
|
||||
valMatches MatchVal {..} x
|
||||
| Just d_ <- mvDen, d_ >= p = Left $ MatchValPrecisionError d_ p
|
||||
| otherwise =
|
||||
Right $
|
||||
checkMaybe (s ==) mvSign
|
||||
&& checkMaybe (n ==) mvNum
|
||||
&& checkMaybe ((d * fromIntegral p ==) . fromIntegral) mvDen
|
||||
where
|
||||
(n, d) = properFraction $ abs x
|
||||
p = 10 ^ mvPrec
|
||||
|
|
@ -154,7 +157,7 @@ dateMatches md = (EQ ==) . compareDate md
|
|||
|
||||
otherMatches :: M.Map T.Text T.Text -> MatchOther -> EitherErr Bool
|
||||
otherMatches dict m = case m of
|
||||
Val (Field n mv) -> valMatches mv <$> (readRational =<< lookup_ MatchNumeric n)
|
||||
Val (Field n mv) -> valMatches mv =<< (readRational =<< lookup_ MatchNumeric n)
|
||||
Desc (Field n md) -> (`matchMaybe` md) =<< lookup_ MatchText n
|
||||
where
|
||||
lookup_ t n = lookupErr (MatchField t) n dict
|
||||
|
|
@ -277,7 +280,8 @@ showError (StatementError ts ms) = (showTx <$> ts) ++ (showMatch <$> ms)
|
|||
showError other = (: []) $ case other of
|
||||
(RegexError re) -> T.append "could not make regex from pattern: " re
|
||||
(ConversionError x) -> T.append "Could not convert to rational number: " x
|
||||
-- TODO use the field indicator
|
||||
(MatchValPrecisionError d p) ->
|
||||
T.unwords ["Match denominator", showT d, "must be less than", showT p]
|
||||
(LookupError t f) ->
|
||||
T.unwords
|
||||
[ "Could not find field"
|
||||
|
|
@ -318,7 +322,7 @@ showError other = (: []) $ case other of
|
|||
msg = case t of
|
||||
TooFewSplits -> "Need at least two splits to balance"
|
||||
NotOneBlank -> "Exactly one split must be blank"
|
||||
splits = T.intercalate ", " $ fmap showSplit rss
|
||||
splits = T.intercalate ", " $ fmap (singleQuote . showSplit) rss
|
||||
|
||||
showTx :: TxRecord -> T.Text
|
||||
showTx TxRecord {trDate = d, trAmount = v, trDesc = e, trFile = f} =
|
||||
|
|
@ -345,7 +349,7 @@ showMatch Match {mDate = d, mVal = v, mDesc = e, mOther = o, mTimes = n, mPriori
|
|||
]
|
||||
others = case o of
|
||||
[] -> Nothing
|
||||
xs -> Just $ T.concat $ showMatchOther <$> xs
|
||||
xs -> Just $ singleQuote $ T.concat $ showMatchOther <$> xs
|
||||
|
||||
-- | Convert match date to text
|
||||
-- Single date matches will just show the single date, and ranged matches will
|
||||
|
|
@ -381,28 +385,35 @@ showYMD_ md =
|
|||
YM_ y m -> [fromIntegral y, m]
|
||||
YMD_ y m d -> [fromIntegral y, m, d]
|
||||
|
||||
-- TODO there are errors that can be thrown here
|
||||
showMatchVal :: MatchVal -> Maybe T.Text
|
||||
showMatchVal MatchVal {mvSign = Nothing, mvNum = Nothing, mvDen = Nothing} = Nothing
|
||||
showMatchVal MatchVal {..} = Just $ T.concat [sign, num, ".", den]
|
||||
showMatchVal MatchVal {..} = Just $ singleQuote $ keyVals [(k, v) | (k, Just v) <- kvs]
|
||||
where
|
||||
sign = case mvSign of
|
||||
Nothing -> "+/-"
|
||||
Just s -> if s then "+" else "-"
|
||||
num = maybe "*" showT mvNum
|
||||
den = maybe "*" (lpadT '0' (fromIntegral mvPrec) . showT) mvDen
|
||||
kvs =
|
||||
[ ("sign", (\s -> if s then "+" else "-") <$> mvSign)
|
||||
, ("numerator", showT <$> mvNum)
|
||||
, ("denominator", showT <$> mvDen)
|
||||
, ("precision", Just $ showT mvPrec)
|
||||
]
|
||||
|
||||
showMatchOther :: MatchOther -> T.Text
|
||||
showMatchOther = undefined
|
||||
showMatchOther (Desc (Field f re)) =
|
||||
T.unwords ["desc field", singleQuote f, "with re", singleQuote re]
|
||||
showMatchOther (Val (Field f mv)) =
|
||||
T.unwords
|
||||
[ "val field"
|
||||
, singleQuote f
|
||||
, "with match value"
|
||||
, singleQuote $ fromMaybe "*" $ showMatchVal mv
|
||||
]
|
||||
|
||||
showSplit :: RawSplit -> T.Text
|
||||
showSplit Split {sAcnt = a, sValue = v, sComment = c} =
|
||||
singleQuote $
|
||||
keyVals
|
||||
[ ("account", a)
|
||||
, ("value", T.pack $ show ((fromRational <$> v) :: Maybe Float))
|
||||
, ("comment", doubleQuote c)
|
||||
]
|
||||
keyVals
|
||||
[ ("account", a)
|
||||
, ("value", T.pack $ show ((fromRational <$> v) :: Maybe Float))
|
||||
, ("comment", doubleQuote c)
|
||||
]
|
||||
|
||||
singleQuote :: T.Text -> T.Text
|
||||
singleQuote t = T.concat ["'", t, "'"]
|
||||
|
|
@ -427,10 +438,10 @@ concatEither2 a b fun = case (a, b) of
|
|||
(Right a_, Right b_) -> Right $ fun a_ b_
|
||||
_ -> Left $ catMaybes [leftToMaybe a, leftToMaybe b]
|
||||
|
||||
-- concatEither3 :: Either x a -> Either x b -> Either x c -> (a -> b -> c -> d) -> Either [x] d
|
||||
-- concatEither3 a b c fun = case (a, b, c) of
|
||||
-- (Right a_, Right b_, Right c_) -> Right $ fun a_ b_ c_
|
||||
-- _ -> Left $ catMaybes [leftToMaybe a, leftToMaybe b, leftToMaybe c]
|
||||
concatEither3 :: Either x a -> Either x b -> Either x c -> (a -> b -> c -> d) -> Either [x] d
|
||||
concatEither3 a b c fun = case (a, b, c) of
|
||||
(Right a_, Right b_, Right c_) -> Right $ fun a_ b_ c_
|
||||
_ -> Left $ catMaybes [leftToMaybe a, leftToMaybe b, leftToMaybe c]
|
||||
|
||||
concatEithers2 :: Either [x] a -> Either [x] b -> (a -> b -> c) -> Either [x] c
|
||||
concatEithers2 a b = merge . concatEither2 a b
|
||||
|
|
@ -485,8 +496,8 @@ uncurry3 f (a, b, c) = f a b c
|
|||
-- rpad :: a -> Int -> [a] -> [a]
|
||||
-- rpad c n s = s ++ replicate (n - length s) c
|
||||
|
||||
lpadT :: Char -> Int -> T.Text -> T.Text
|
||||
lpadT c n s = T.append (T.replicate (n - T.length s) (T.singleton c)) s
|
||||
-- lpadT :: Char -> Int -> T.Text -> T.Text
|
||||
-- lpadT c n s = T.append (T.replicate (n - T.length s) (T.singleton c)) s
|
||||
|
||||
matchMaybe :: RegexContext Regex query b => query -> T.Text -> EitherErr b
|
||||
matchMaybe q re = first (const $ RegexError re) $ pureTry $ q =~ re
|
||||
|
|
|
|||
Loading…
Reference in New Issue