{-# LANGUAGE OverloadedStrings #-}

module Claims.Parser
  ( parseRule
  , parseRules
  , convertToInternalRule
  ) where

import Claims.Parser.AST
import qualified Claims.Types as T
import Claims.Types (Rule, ClaimType(..), ValidationResult)
import Text.Parsec
import Text.Parsec.String (Parser)
import Text.Parsec.Expr (buildExpressionParser, Operator(..), Assoc(..))
import qualified Text.Parsec.Token as P
import Text.Parsec.Language (emptyDef)
import Data.Text (pack)
import Data.Decimal (realFracToDecimal)

-- Lexer definition
lexer :: P.TokenParser ()
lexer :: TokenParser ()
lexer = GenLanguageDef String () Identity -> TokenParser ()
forall s (m :: * -> *) u.
Stream s m Char =>
GenLanguageDef s u m -> GenTokenParser s u m
P.makeTokenParser GenLanguageDef String () Identity
forall st. LanguageDef st
emptyDef
  { P.reservedNames = 
      [ "RULE", "DESCRIPTION", "WHEN", "THEN", "ELSE", "END"
      , "AND", "OR", "NOT", "BETWEEN"
      , "APPROVE", "REJECT", "REQUIRE_REVIEW"
      , "claim", "amount", "type", "place_of_service"
      , "has_diagnosis", "has_procedure"
      , "Inpatient", "Outpatient", "Professional"
      ]
  , P.reservedOpNames = [">", "<", "=", ">=", "<="]
  }

reserved :: String -> Parser ()
reserved :: String -> Parser ()
reserved = TokenParser () -> String -> Parser ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reserved TokenParser ()
lexer

reservedOp :: String -> Parser ()
reservedOp :: String -> Parser ()
reservedOp = TokenParser () -> String -> Parser ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reservedOp TokenParser ()
lexer

identifier :: Parser String
identifier :: Parser String
identifier = TokenParser () -> Parser String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
P.identifier TokenParser ()
lexer

stringLiteral :: Parser String
stringLiteral :: Parser String
stringLiteral = TokenParser () -> Parser String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
P.stringLiteral TokenParser ()
lexer

float :: Parser Double
float :: Parser Double
float = TokenParser () -> Parser Double
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Double
P.float TokenParser ()
lexer

natural :: Parser Integer
natural :: Parser Integer
natural = TokenParser () -> Parser Integer
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Integer
P.natural TokenParser ()
lexer

whiteSpace :: Parser ()
whiteSpace :: Parser ()
whiteSpace = TokenParser () -> Parser ()
forall s u (m :: * -> *). GenTokenParser s u m -> ParsecT s u m ()
P.whiteSpace TokenParser ()
lexer

dot :: Parser String
dot :: Parser String
dot = TokenParser () -> Parser String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
P.dot TokenParser ()
lexer

-- | Parse a complete rule
parseRule :: Parser ParsedRule
parseRule :: Parser ParsedRule
parseRule = do
  Parser ()
whiteSpace
  String -> Parser ()
reserved String
"RULE"
  String
name <- Parser String
identifier
  String -> Parser ()
reserved String
"DESCRIPTION"
  String
desc <- Parser String
stringLiteral
  String -> Parser ()
reserved String
"WHEN"
  Condition
cond <- Parser Condition
parseCondition
  String -> Parser ()
reserved String
"THEN"
  Action
act <- Parser Action
parseAction
  Maybe (Condition, Action)
elseAct <- ParsecT String () Identity (Condition, Action)
-> ParsecT String () Identity (Maybe (Condition, Action))
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ParsecT String () Identity (Condition, Action)
parseElseWhen
  String -> Parser ()
reserved String
"END"
  ParsedRule -> Parser ParsedRule
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParsedRule -> Parser ParsedRule)
-> ParsedRule -> Parser ParsedRule
forall a b. (a -> b) -> a -> b
$ String
-> String
-> Condition
-> Action
-> Maybe (Condition, Action)
-> ParsedRule
ParsedRule String
name String
desc Condition
cond Action
act Maybe (Condition, Action)
elseAct

-- | Parse ELSE WHEN clause
parseElseWhen :: Parser (Condition, Action)
parseElseWhen :: ParsecT String () Identity (Condition, Action)
parseElseWhen = do
  String -> Parser ()
reserved String
"ELSE"
  String -> Parser ()
reserved String
"WHEN"
  Condition
cond <- Parser Condition
parseCondition
  String -> Parser ()
reserved String
"THEN"
  Action
act <- Parser Action
parseAction
  (Condition, Action)
-> ParsecT String () Identity (Condition, Action)
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Condition
cond, Action
act)

-- | Parse a condition expression
parseCondition :: Parser Condition
parseCondition :: Parser Condition
parseCondition = OperatorTable String () Identity Condition
-> Parser Condition -> Parser Condition
forall s (m :: * -> *) t u a.
Stream s m t =>
OperatorTable s u m a -> ParsecT s u m a -> ParsecT s u m a
buildExpressionParser OperatorTable String () Identity Condition
table Parser Condition
term
  where
    table :: OperatorTable String () Identity Condition
table = 
      [ [ParsecT String () Identity (Condition -> Condition)
-> Operator String () Identity Condition
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a) -> Operator s u m a
Prefix (String -> Parser ()
reserved String
"NOT" Parser ()
-> ParsecT String () Identity (Condition -> Condition)
-> ParsecT String () Identity (Condition -> Condition)
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Condition -> Condition)
-> ParsecT String () Identity (Condition -> Condition)
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Condition -> Condition
NotCond)]
      , [ParsecT String () Identity (Condition -> Condition -> Condition)
-> Assoc -> Operator String () Identity Condition
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (String -> Parser ()
reserved String
"AND" Parser ()
-> ParsecT String () Identity (Condition -> Condition -> Condition)
-> ParsecT String () Identity (Condition -> Condition -> Condition)
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Condition -> Condition -> Condition)
-> ParsecT String () Identity (Condition -> Condition -> Condition)
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Condition -> Condition -> Condition
AndCond) Assoc
AssocLeft]
      , [ParsecT String () Identity (Condition -> Condition -> Condition)
-> Assoc -> Operator String () Identity Condition
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (String -> Parser ()
reserved String
"OR" Parser ()
-> ParsecT String () Identity (Condition -> Condition -> Condition)
-> ParsecT String () Identity (Condition -> Condition -> Condition)
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Condition -> Condition -> Condition)
-> ParsecT String () Identity (Condition -> Condition -> Condition)
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Condition -> Condition -> Condition
OrCond) Assoc
AssocLeft]
      ]
    
    term :: Parser Condition
term = Parser Condition -> Parser Condition
forall a. Parser a -> Parser a
parens Parser Condition
parseCondition
       Parser Condition -> Parser Condition -> Parser Condition
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Condition -> Parser Condition
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser Condition
parseAmountBetween
       Parser Condition -> Parser Condition -> Parser Condition
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Condition -> Parser Condition
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser Condition
parseAmountComparison
       Parser Condition -> Parser Condition -> Parser Condition
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Condition -> Parser Condition
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser Condition
parseHasDiagnosis
       Parser Condition -> Parser Condition -> Parser Condition
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Condition -> Parser Condition
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser Condition
parseHasProcedure
       Parser Condition -> Parser Condition -> Parser Condition
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Condition -> Parser Condition
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser Condition
parsePlaceOfService
       Parser Condition -> Parser Condition -> Parser Condition
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Condition -> Parser Condition
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser Condition
parseClaimType

parens :: Parser a -> Parser a
parens :: forall a. Parser a -> Parser a
parens = TokenParser () -> forall a. Parser a -> Parser a
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
P.parens TokenParser ()
lexer

-- | Parse amount comparison (e.g., claim.amount > 50000)
parseAmountComparison :: Parser Condition
parseAmountComparison :: Parser Condition
parseAmountComparison = do
  String -> Parser ()
reserved String
"claim"
  String
_ <- Parser String
dot
  String -> Parser ()
reserved String
"amount"
  CompOp
op <- Parser CompOp
parseCompOp
  Double
value <- Parser Double -> Parser Double
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser Double
float Parser Double -> Parser Double -> Parser Double
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Integer -> Double) -> Parser Integer -> Parser Double
forall a b.
(a -> b)
-> ParsecT String () Identity a -> ParsecT String () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Double
forall a. Num a => Integer -> a
fromInteger Parser Integer
natural
  Condition -> Parser Condition
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Condition -> Parser Condition) -> Condition -> Parser Condition
forall a b. (a -> b) -> a -> b
$ CompOp -> Double -> Condition
CompareAmount CompOp
op Double
value

-- | Parse amount between (e.g., claim.amount BETWEEN 0 AND 100)
parseAmountBetween :: Parser Condition
parseAmountBetween :: Parser Condition
parseAmountBetween = do
  String -> Parser ()
reserved String
"claim"
  String
_ <- Parser String
dot
  String -> Parser ()
reserved String
"amount"
  String -> Parser ()
reserved String
"BETWEEN"
  Double
low <- Parser Double -> Parser Double
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser Double
float Parser Double -> Parser Double -> Parser Double
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Integer -> Double) -> Parser Integer -> Parser Double
forall a b.
(a -> b)
-> ParsecT String () Identity a -> ParsecT String () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Double
forall a. Num a => Integer -> a
fromInteger Parser Integer
natural
  String -> Parser ()
reserved String
"AND"
  Double
high <- Parser Double -> Parser Double
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser Double
float Parser Double -> Parser Double -> Parser Double
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Integer -> Double) -> Parser Integer -> Parser Double
forall a b.
(a -> b)
-> ParsecT String () Identity a -> ParsecT String () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Double
forall a. Num a => Integer -> a
fromInteger Parser Integer
natural
  Condition -> Parser Condition
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Condition -> Parser Condition) -> Condition -> Parser Condition
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Condition
AmountBetween Double
low Double
high

-- | Parse has diagnosis code (e.g., claim.has_diagnosis "S06")
parseHasDiagnosis :: Parser Condition
parseHasDiagnosis :: Parser Condition
parseHasDiagnosis = do
  String -> Parser ()
reserved String
"claim"
  String
_ <- Parser String
dot
  String -> Parser ()
reserved String
"has_diagnosis"
  String
code <- Parser String
stringLiteral
  Condition -> Parser Condition
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Condition -> Parser Condition) -> Condition -> Parser Condition
forall a b. (a -> b) -> a -> b
$ String -> Condition
CheckDiagnosis String
code

-- | Parse has procedure code (e.g., claim.has_procedure "99221")
parseHasProcedure :: Parser Condition
parseHasProcedure :: Parser Condition
parseHasProcedure = do
  String -> Parser ()
reserved String
"claim"
  String
_ <- Parser String
dot
  String -> Parser ()
reserved String
"has_procedure"
  String
code <- Parser String
stringLiteral
  Condition -> Parser Condition
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Condition -> Parser Condition) -> Condition -> Parser Condition
forall a b. (a -> b) -> a -> b
$ String -> Condition
CheckProcedure String
code

-- | Parse place of service (e.g., claim.place_of_service = "23")
parsePlaceOfService :: Parser Condition
parsePlaceOfService :: Parser Condition
parsePlaceOfService = do
  String -> Parser ()
reserved String
"claim"
  String
_ <- Parser String
dot
  String -> Parser ()
reserved String
"place_of_service"
  String -> Parser ()
reservedOp String
"="
  String
pos <- Parser String
stringLiteral
  Condition -> Parser Condition
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Condition -> Parser Condition) -> Condition -> Parser Condition
forall a b. (a -> b) -> a -> b
$ String -> Condition
CheckPlaceOfService String
pos

-- | Parse claim type (e.g., claim.type = "Inpatient")
parseClaimType :: Parser Condition
parseClaimType :: Parser Condition
parseClaimType = do
  String -> Parser ()
reserved String
"claim"
  String
_ <- Parser String
dot
  String -> Parser ()
reserved String
"type"
  String -> Parser ()
reservedOp String
"="
  String
ct <- Parser String
stringLiteral
  Condition -> Parser Condition
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Condition -> Parser Condition) -> Condition -> Parser Condition
forall a b. (a -> b) -> a -> b
$ String -> Condition
CheckClaimType String
ct

-- | Parse comparison operator
parseCompOp :: Parser CompOp
parseCompOp :: Parser CompOp
parseCompOp = 
  (String -> Parser ()
reservedOp String
">=" Parser () -> Parser CompOp -> Parser CompOp
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CompOp -> Parser CompOp
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return CompOp
Gte)
  Parser CompOp -> Parser CompOp -> Parser CompOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reservedOp String
"<=" Parser () -> Parser CompOp -> Parser CompOp
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CompOp -> Parser CompOp
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return CompOp
Lte)
  Parser CompOp -> Parser CompOp -> Parser CompOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reservedOp String
">" Parser () -> Parser CompOp -> Parser CompOp
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CompOp -> Parser CompOp
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return CompOp
Gt)
  Parser CompOp -> Parser CompOp -> Parser CompOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reservedOp String
"<" Parser () -> Parser CompOp -> Parser CompOp
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CompOp -> Parser CompOp
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return CompOp
Lt)
  Parser CompOp -> Parser CompOp -> Parser CompOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reservedOp String
"=" Parser () -> Parser CompOp -> Parser CompOp
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CompOp -> Parser CompOp
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return CompOp
Eq)

-- | Parse an action
parseAction :: Parser Action
parseAction :: Parser Action
parseAction = 
  (String -> Parser ()
reserved String
"APPROVE" Parser () -> Parser Action -> Parser Action
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Action -> Parser Action
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Action
ApproveClaim)
  Parser Action -> Parser Action -> Parser Action
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"REJECT" Parser () -> Parser Action -> Parser Action
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Action
RejectClaim (String -> Action) -> Parser String -> Parser Action
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
stringLiteral)
  Parser Action -> Parser Action -> Parser Action
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"REQUIRE_REVIEW" Parser () -> Parser Action -> Parser Action
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Action
RequireReview (String -> Action) -> Parser String -> Parser Action
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
stringLiteral)

-- | Parse multiple rules from a file
parseRules :: String -> Either ParseError [ParsedRule]
parseRules :: String -> Either ParseError [ParsedRule]
parseRules String
input = Parsec String () [ParsedRule]
-> String -> String -> Either ParseError [ParsedRule]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (Parser ParsedRule -> Parsec String () [ParsedRule]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser ParsedRule
parseRule Parsec String () [ParsedRule]
-> Parser () -> Parsec String () [ParsedRule]
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) String
"" String
input

-- | Convert a parsed external DSL rule to an internal DSL rule
convertToInternalRule :: ParsedRule -> Rule ValidationResult
convertToInternalRule :: ParsedRule -> Rule ValidationResult
convertToInternalRule ParsedRule
pr = 
  case ParsedRule -> Maybe (Condition, Action)
elseAction ParsedRule
pr of
    Maybe (Condition, Action)
Nothing -> Rule Bool
-> Rule ValidationResult
-> Rule ValidationResult
-> Rule ValidationResult
T.If (Condition -> Rule Bool
convertCondition (ParsedRule -> Condition
conditions ParsedRule
pr)) (Action -> Rule ValidationResult
convertAction (ParsedRule -> Action
action ParsedRule
pr)) Rule ValidationResult
T.approve
    Just (Condition
elseCond, Action
elseAct) -> 
      Rule Bool
-> Rule ValidationResult
-> Rule ValidationResult
-> Rule ValidationResult
T.If (Condition -> Rule Bool
convertCondition (ParsedRule -> Condition
conditions ParsedRule
pr)) 
           (Action -> Rule ValidationResult
convertAction (ParsedRule -> Action
action ParsedRule
pr))
           (Rule Bool
-> Rule ValidationResult
-> Rule ValidationResult
-> Rule ValidationResult
T.If (Condition -> Rule Bool
convertCondition Condition
elseCond) (Action -> Rule ValidationResult
convertAction Action
elseAct) Rule ValidationResult
T.approve)

-- | Convert a parsed condition to an internal rule condition
convertCondition :: Condition -> Rule Bool
convertCondition :: Condition -> Rule Bool
convertCondition Condition
cond = case Condition
cond of
  CompareAmount CompOp
op Double
value -> 
    let amt :: Decimal
amt = Word8 -> Double -> Decimal
forall i r. (Integral i, RealFrac r) => Word8 -> r -> DecimalRaw i
realFracToDecimal Word8
2 Double
value
        epsilon :: Decimal
epsilon = Word8 -> Double -> Decimal
forall i r. (Integral i, RealFrac r) => Word8 -> r -> DecimalRaw i
realFracToDecimal Word8
2 (Double
0.01 :: Double)
    in case CompOp
op of
      CompOp
Gt -> Decimal -> Rule Bool
T.greaterThan Decimal
amt
      CompOp
Lt -> Decimal -> Rule Bool
T.lessThan Decimal
amt
      CompOp
Eq -> Decimal -> Rule Bool
T.AmountGreaterThan Decimal
amt Rule Bool -> Rule Bool -> Rule Bool
`T.And` Decimal -> Rule Bool
T.AmountLessThan (Decimal
amt Decimal -> Decimal -> Decimal
forall a. Num a => a -> a -> a
+ Decimal
epsilon)
      CompOp
Gte -> Decimal -> Rule Bool
T.greaterThan Decimal
amt Rule Bool -> Rule Bool -> Rule Bool
`T.Or` (Decimal -> Rule Bool
T.AmountGreaterThan Decimal
amt Rule Bool -> Rule Bool -> Rule Bool
`T.And` Decimal -> Rule Bool
T.AmountLessThan (Decimal
amt Decimal -> Decimal -> Decimal
forall a. Num a => a -> a -> a
+ Decimal
epsilon))
      CompOp
Lte -> Decimal -> Rule Bool
T.lessThan Decimal
amt Rule Bool -> Rule Bool -> Rule Bool
`T.Or` (Decimal -> Rule Bool
T.AmountGreaterThan Decimal
amt Rule Bool -> Rule Bool -> Rule Bool
`T.And` Decimal -> Rule Bool
T.AmountLessThan (Decimal
amt Decimal -> Decimal -> Decimal
forall a. Num a => a -> a -> a
+ Decimal
epsilon))
  AmountBetween Double
low Double
high -> Decimal -> Decimal -> Rule Bool
T.between (Word8 -> Double -> Decimal
forall i r. (Integral i, RealFrac r) => Word8 -> r -> DecimalRaw i
realFracToDecimal Word8
2 Double
low) (Word8 -> Double -> Decimal
forall i r. (Integral i, RealFrac r) => Word8 -> r -> DecimalRaw i
realFracToDecimal Word8
2 Double
high)
  CheckDiagnosis String
code -> Text -> Rule Bool
T.hasDx (String -> Text
pack String
code)
  CheckProcedure String
code -> Text -> Rule Bool
T.hasPx (String -> Text
pack String
code)
  CheckPlaceOfService String
p -> Text -> Rule Bool
T.pos (String -> Text
pack String
p)
  CheckClaimType String
ct -> ClaimType -> Rule Bool
T.isType (String -> ClaimType
convertClaimType String
ct)
  AndCond Condition
c1 Condition
c2 -> Condition -> Rule Bool
convertCondition Condition
c1 Rule Bool -> Rule Bool -> Rule Bool
`T.And` Condition -> Rule Bool
convertCondition Condition
c2
  OrCond Condition
c1 Condition
c2 -> Condition -> Rule Bool
convertCondition Condition
c1 Rule Bool -> Rule Bool -> Rule Bool
`T.Or` Condition -> Rule Bool
convertCondition Condition
c2
  NotCond Condition
c -> Rule Bool -> Rule Bool
T.Not (Condition -> Rule Bool
convertCondition Condition
c)

-- | Convert a parsed action to an internal rule action
convertAction :: Action -> Rule ValidationResult
convertAction :: Action -> Rule ValidationResult
convertAction Action
act = case Action
act of
  Action
ApproveClaim -> Rule ValidationResult
T.approve
  RejectClaim String
msg -> Text -> Rule ValidationResult
T.reject (String -> Text
pack String
msg)
  RequireReview String
msg -> Text -> Rule ValidationResult
T.needsReview (String -> Text
pack String
msg)

-- | Convert a claim type string to ClaimType
convertClaimType :: String -> ClaimType
convertClaimType :: String -> ClaimType
convertClaimType String
"Inpatient" = ClaimType
Inpatient
convertClaimType String
"Outpatient" = ClaimType
Outpatient
convertClaimType String
"Professional" = ClaimType
Professional
convertClaimType String
_ = ClaimType
Professional  -- default