diff --git a/lib/Internal/Types.hs b/lib/Internal/Types.hs index beb2367..a746545 100644 --- a/lib/Internal/Types.hs +++ b/lib/Internal/Types.hs @@ -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 diff --git a/lib/Internal/Utils.hs b/lib/Internal/Utils.hs index e3c900f..6e37dd1 100644 --- a/lib/Internal/Utils.hs +++ b/lib/Internal/Utils.hs @@ -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