ENH don't use exact matching
This commit is contained in:
parent
966576ab1a
commit
137d56a139
|
@ -101,10 +101,7 @@ let MatchYMD = < Y : Natural | YM : GregorianM | YMD : Gregorian >
|
||||||
|
|
||||||
let MatchDate = < On : MatchYMD | In : { _1 : MatchYMD, _2 : Natural } >
|
let MatchDate = < On : MatchYMD | In : { _1 : MatchYMD, _2 : Natural } >
|
||||||
|
|
||||||
let MatchDesc = < Re : Text | Exact : Text >
|
let MatchOther = < Desc : Field Text Text | Val : Field Text MatchVal.Type >
|
||||||
|
|
||||||
let MatchOther =
|
|
||||||
< Desc : Field Text MatchDesc | Val : Field Text MatchVal.Type >
|
|
||||||
|
|
||||||
let SplitNum = < LookupN : Text | ConstN : Decimal | AmountN >
|
let SplitNum = < LookupN : Text | ConstN : Decimal | AmountN >
|
||||||
|
|
||||||
|
@ -141,7 +138,7 @@ let Match =
|
||||||
{ Type =
|
{ Type =
|
||||||
{ mDate : Optional MatchDate
|
{ mDate : Optional MatchDate
|
||||||
, mVal : MatchVal.Type
|
, mVal : MatchVal.Type
|
||||||
, mDesc : Optional MatchDesc
|
, mDesc : Optional Text
|
||||||
, mOther : List MatchOther
|
, mOther : List MatchOther
|
||||||
, mTx : Optional ToTx
|
, mTx : Optional ToTx
|
||||||
, mTimes : Optional Natural
|
, mTimes : Optional Natural
|
||||||
|
@ -150,7 +147,7 @@ let Match =
|
||||||
, default =
|
, default =
|
||||||
{ mDate = None MatchDate
|
{ mDate = None MatchDate
|
||||||
, mVal = MatchVal::{=}
|
, mVal = MatchVal::{=}
|
||||||
, mDesc = None MatchDesc
|
, mDesc = None Text
|
||||||
, mOther = [] : List MatchOther
|
, mOther = [] : List MatchOther
|
||||||
, mTx = None ToTx
|
, mTx = None ToTx
|
||||||
, mTimes = None Natural
|
, mTimes = None Natural
|
||||||
|
@ -235,7 +232,6 @@ in { CurID
|
||||||
, MatchVal
|
, MatchVal
|
||||||
, MatchYMD
|
, MatchYMD
|
||||||
, MatchDate
|
, MatchDate
|
||||||
, MatchDesc
|
|
||||||
, MatchOther
|
, MatchOther
|
||||||
, SplitNum
|
, SplitNum
|
||||||
, Field
|
, Field
|
||||||
|
|
|
@ -45,7 +45,6 @@ makeHaskellTypesWith (defaultGenerateOptions { generateToDhallInstance = False }
|
||||||
, MultipleConstructors "DatePat" "(./dhall/Types.dhall).DatePat"
|
, MultipleConstructors "DatePat" "(./dhall/Types.dhall).DatePat"
|
||||||
, MultipleConstructors "MatchYMD" "(./dhall/Types.dhall).MatchYMD"
|
, MultipleConstructors "MatchYMD" "(./dhall/Types.dhall).MatchYMD"
|
||||||
, MultipleConstructors "MatchDate" "(./dhall/Types.dhall).MatchDate"
|
, MultipleConstructors "MatchDate" "(./dhall/Types.dhall).MatchDate"
|
||||||
, MultipleConstructors "MatchDesc" "(./dhall/Types.dhall).MatchDesc"
|
|
||||||
, MultipleConstructors "SplitNum" "(./dhall/Types.dhall).SplitNum"
|
, MultipleConstructors "SplitNum" "(./dhall/Types.dhall).SplitNum"
|
||||||
, MultipleConstructors "Bucket" "(./dhall/Types.dhall).Bucket"
|
, MultipleConstructors "Bucket" "(./dhall/Types.dhall).Bucket"
|
||||||
|
|
||||||
|
@ -340,11 +339,7 @@ data Field k v = Field
|
||||||
|
|
||||||
type FieldMap k v = Field k (M.Map k v)
|
type FieldMap k v = Field k (M.Map k v)
|
||||||
|
|
||||||
deriving instance Eq MatchDesc
|
data MatchOther = Desc (Field T.Text T.Text)
|
||||||
deriving instance Show MatchDesc
|
|
||||||
deriving instance Hashable MatchDesc
|
|
||||||
|
|
||||||
data MatchOther = Desc (Field T.Text MatchDesc)
|
|
||||||
| Val (Field T.Text MatchVal)
|
| Val (Field T.Text MatchVal)
|
||||||
deriving (Show, Eq, Hashable, Generic, FromDhall)
|
deriving (Show, Eq, Hashable, Generic, FromDhall)
|
||||||
|
|
||||||
|
@ -358,7 +353,7 @@ data ToTx = ToTx
|
||||||
data Match = Match
|
data Match = Match
|
||||||
{ mDate :: Maybe MatchDate
|
{ mDate :: Maybe MatchDate
|
||||||
, mVal :: MatchVal
|
, mVal :: MatchVal
|
||||||
, mDesc :: Maybe MatchDesc
|
, mDesc :: Maybe Text
|
||||||
, mOther :: ![MatchOther]
|
, mOther :: ![MatchOther]
|
||||||
, mTx :: Maybe ToTx
|
, mTx :: Maybe ToTx
|
||||||
, mTimes :: Maybe Natural
|
, mTimes :: Maybe Natural
|
||||||
|
|
|
@ -19,10 +19,6 @@ import Internal.Types
|
||||||
import Text.Read
|
import Text.Read
|
||||||
import Text.Regex.TDFA
|
import Text.Regex.TDFA
|
||||||
|
|
||||||
descMatches :: MatchDesc -> T.Text -> Bool
|
|
||||||
descMatches (Re re) = (=~ re)
|
|
||||||
descMatches (Exact t) = (== t)
|
|
||||||
|
|
||||||
-- when bifunctor fails...
|
-- when bifunctor fails...
|
||||||
thrice :: (a -> d) -> (b -> e) -> (c -> f) -> (a, b, c) -> (d, e, f)
|
thrice :: (a -> d) -> (b -> e) -> (c -> f) -> (a, b, c) -> (d, e, f)
|
||||||
thrice f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z)
|
thrice f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z)
|
||||||
|
@ -123,7 +119,7 @@ matches Match {..} r@TxRecord {..}
|
||||||
where
|
where
|
||||||
allPass = checkMaybe (`dateMatches` trDate) mDate
|
allPass = checkMaybe (`dateMatches` trDate) mDate
|
||||||
&& valMatches mVal trAmount
|
&& valMatches mVal trAmount
|
||||||
&& checkMaybe (`descMatches` trDesc) mDesc
|
&& checkMaybe (=~ trDesc) mDesc
|
||||||
&& all (fieldMatches trOther) mOther
|
&& all (fieldMatches trOther) mOther
|
||||||
eval (ToTx cur a ss) = toTx cur a ss r
|
eval (ToTx cur a ss) = toTx cur a ss r
|
||||||
|
|
||||||
|
@ -134,7 +130,7 @@ fieldMatches dict m = case m of
|
||||||
(Just v) -> valMatches mv v
|
(Just v) -> valMatches mv v
|
||||||
_ -> error "you dummy"
|
_ -> error "you dummy"
|
||||||
Desc (Field n md) -> case M.lookup n dict of
|
Desc (Field n md) -> case M.lookup n dict of
|
||||||
(Just d) -> descMatches md d
|
(Just d) -> d =~ md
|
||||||
_ -> error "you dummy"
|
_ -> error "you dummy"
|
||||||
|
|
||||||
checkMaybe :: (a -> Bool) -> Maybe a -> Bool
|
checkMaybe :: (a -> Bool) -> Maybe a -> Bool
|
||||||
|
|
Loading…
Reference in New Issue