packages feed

claims-x12-dsl (empty) → 0.1.0.0

raw patch · 13 files changed

+1128/−0 lines, 13 filesdep +Decimaldep +QuickCheckdep +basesetup-changed

Dependencies added: Decimal, QuickCheck, base, claims-x12-dsl, containers, hspec, parsec, text, time

Files

+ CHANGELOG.md view
@@ -0,0 +1,11 @@+# Changelog for `claims-x12-dsl`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## Unreleased++## 0.1.0.0 - YYYY-MM-DD
+ LICENSE view
@@ -0,0 +1,26 @@+Copyright 2026 Author: Charles E. O'Riley++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1.  Redistributions of source code must retain the above copyright notice, this+    list of conditions and the following disclaimer.++2.  Redistributions in binary form must reproduce the above copyright notice,+    this list of conditions and the following disclaimer in the documentation+    and/or other materials provided with the distribution.++3.  Neither the name of the copyright holder nor the names of its contributors+    may be used to endorse or promote products derived from this software+    without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,259 @@+# Healthcare Claims X12 Processing DSL++A Domain-Specific Language (DSL) for healthcare claims validation and X12 processing, implemented in Haskell.++## Overview++This project provides a type-safe, composable DSL for defining business rules for healthcare claims validation. It features both an internal DSL (embedded in Haskell) and an external DSL (text-based syntax for business analysts).++## Features++- **Type-Safe Internal DSL**: Uses GADTs to ensure rule correctness at compile time+- **Business-Friendly External DSL**: SQL-like syntax that non-programmers can read and write+- **Comprehensive Validation**: Support for amount checks, diagnosis codes, procedure codes, place of service, and claim types+- **Composable Rules**: Combine simple rules into complex validation logic using `AND`, `OR`, and `NOT`+- **Full Test Coverage**: Comprehensive test suite using Hspec++## Project Structure++```+claims-x12-dsl/+├── src/+│   ├── Claims/+│   │   ├── Types.hs           # Core domain types and Rule GADT+│   │   ├── Interpreter.hs     # Rule evaluation engine+│   │   ├── Rules.hs           # Example business rules+│   │   ├── Parser.hs          # External DSL parser (Parsec)+│   │   └── Parser/+│   │       └── AST.hs         # Abstract syntax tree for external DSL+│   └── Lib.hs                 # Main library exports+├── app/+│   └── Main.hs                # Example application+├── test/+│   └── Spec.hs                # Test suite+├── examples/+│   └── sample-rules.dsl       # Example external DSL rules+└── package.yaml               # Project dependencies+```++## Getting Started++### Prerequisites++You'll need Stack installed. If you don't have it:++**macOS:**+```bash+curl -sSL https://get.haskellstack.org/ | sh+```++**Linux:**+```bash+curl -sSL https://get.haskellstack.org/ | sh+```++**Windows:**+Download the installer from [haskellstack.org](https://docs.haskellstack.org/en/stable/install_and_upgrade/)++### Installation++1. **Clone or navigate to the project:**+   ```bash+   cd /path/to/claims-x12-dsl+   ```++2. **Build the project:**+   ```bash+   stack build+   ```+   +   This will:+   - Download and install the correct GHC version (9.6.6) if needed+   - Install all dependencies+   - Compile the library and executable+   - First build takes ~60 seconds; subsequent builds are much faster++3. **Verify the build:**+   ```bash+   stack test+   ```+   +   You should see:+   ```+   22 examples, 0 failures+   Finished in 0.0036 seconds+   ```++### Running the Application++**Run the example application:**+```bash+stack run+```++This validates a sample $75,000 inpatient claim and displays results:+```+Healthcare Claims X12 Processing DSL+====================================++Validating example claim:+Claim ID: "CLM001"+Amount: $75000.00+Type: Inpatient++Validation Results:+-------------------+Rule 1: FAIL - "Review Required: High value claim exceeds $50,000"+Rule 2: PASS+Rule 3: PASS+Rule 4: PASS+Rule 5: PASS+```++### Running Tests++**Run all tests:**+```bash+stack test+```++**Run tests with detailed output:**+```bash+stack test --test-arguments="--format=progress"+```++**Run tests with coverage:**+```bash+stack test --coverage+```++### Interactive Development++**Start a REPL (GHCi):**+```bash+stack ghci+```++Then you can interactively test the DSL:+```haskell+ghci> :load src/Claims/Types.hs+ghci> :load src/Claims/Interpreter.hs+ghci> import Data.Decimal+ghci> import Data.Time+-- Create a claim and test rules interactively+```++## Usage++### Internal DSL (Haskell)++```haskell+import Claims.Types+import Claims.Interpreter+import Data.Decimal (realFracToDecimal)+import Data.Time (fromGregorian)++-- Define a claim+claim = Claim+  { claimId = "CLM001"+  , patientId = "PAT12345"+  , providerId = "PRV98765"+  , serviceDate = fromGregorian 2025 1 5+  , totalAmount = realFracToDecimal 2 75000+  , diagnosisCodes = ["I21.0", "I25.10"]+  , procedureCodes = ["99223", "93000"]+  , placeOfService = "21"+  , claimType = Inpatient+  }++-- Define a rule+highValueRule :: Rule ValidationResult+highValueRule = +  If (greaterThan 50000)+    (needsReview "High value claim exceeds $50,000")+    approve++-- Evaluate the rule+result = eval claim highValueRule+```++### External DSL (Business Analyst Syntax)++Create a rules file (e.g., `rules.dsl`):++```+RULE HighValueReview+DESCRIPTION "Flag high-value claims for manual review"+WHEN+  claim.amount > 50000+THEN+  REQUIRE_REVIEW "Claim exceeds high-value threshold"+END++RULE EmergencyRoomValidation+DESCRIPTION "Validate ER claims have appropriate diagnoses"+WHEN+  claim.place_of_service = "23" AND+  NOT (claim.has_diagnosis "S06" OR claim.has_diagnosis "I21")+THEN+  REJECT "Emergency room claim missing emergency diagnosis"+END+```++Parse and use the rules:++```haskell+import Claims.Parser++rulesText <- readFile "rules.dsl"+case parseRules rulesText of+  Left err -> print err+  Right parsedRules -> do+    let internalRules = map convertToInternalRule parsedRules+    let results = validateClaim claim internalRules+    print results+```++## Built-in Business Rules++The library includes several example business rules:++1. **High Value Claims Review**: Claims exceeding $50,000 require manual review+2. **Emergency Room Validation**: ER claims must have emergency diagnosis codes+3. **Inpatient Admission**: Inpatient claims must include admission procedure codes+4. **Complex Professional Claims**: Multi-condition validation for professional claims+5. **Outpatient Surgery Minimum**: Outpatient surgeries must meet minimum amounts++## External DSL Syntax++### Conditions++- Amount comparisons: `claim.amount > 50000`, `claim.amount BETWEEN 0 AND 100`+- Code checks: `claim.has_diagnosis "I21"`, `claim.has_procedure "99223"`+- Claim properties: `claim.type = "Inpatient"`, `claim.place_of_service = "23"`+- Logical operators: `AND`, `OR`, `NOT`++### Actions++- `APPROVE`: Automatically approve the claim+- `REJECT "message"`: Reject the claim with a reason+- `REQUIRE_REVIEW "message"`: Flag for manual review++## Dependencies++- **base**: Core Haskell library+- **text**: Efficient text handling+- **time**: Date/time support+- **Decimal**: Precise decimal arithmetic for currency+- **parsec**: Parser combinator library for external DSL+- **containers**: Data structures+- **hspec**: Testing framework+- **QuickCheck**: Property-based testing++## License++BSD-3-Clause++## Author++Based on the Healthcare Claims X12 Processing DSL specification.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import Claims.Types+import Claims.Interpreter+import Claims.Rules+import Data.Time (fromGregorian)+import Data.Decimal (realFracToDecimal)++-- | Example claim from the requirements document+exampleClaim :: Claim+exampleClaim = Claim+  { claimId = "CLM001"+  , patientId = "PAT12345"+  , providerId = "PRV98765"+  , serviceDate = fromGregorian 2025 1 5+  , totalAmount = realFracToDecimal 2 (75000 :: Double)+  , diagnosisCodes = ["I21.0", "I25.10"]+  , procedureCodes = ["99223", "93000"]+  , placeOfService = "21"+  , claimType = Inpatient+  }++main :: IO ()+main = do+  putStrLn "Healthcare Claims X12 Processing DSL"+  putStrLn "===================================="+  putStrLn ""+  +  putStrLn "Validating example claim:"+  putStrLn $ "Claim ID: " ++ show (claimId exampleClaim)+  putStrLn $ "Amount: $" ++ show (totalAmount exampleClaim)+  putStrLn $ "Type: " ++ show (claimType exampleClaim)+  putStrLn ""+  +  let results = validateClaim exampleClaim allRules+  +  putStrLn "Validation Results:"+  putStrLn "-------------------"+  mapM_ printResult $ zip [1..] results+  +  where+    printResult (n, Valid) = +      putStrLn $ "Rule " ++ show (n :: Int) ++ ": PASS"+    printResult (n, Invalid msg) = +      putStrLn $ "Rule " ++ show (n :: Int) ++ ": FAIL - " ++ show msg
+ claims-x12-dsl.cabal view
@@ -0,0 +1,91 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.38.1.+--+-- see: https://github.com/sol/hpack++name:           claims-x12-dsl+version:        0.1.0.0+synopsis:       Type-safe DSL for healthcare claims validation and X12 processing+description:    A type-safe, composable DSL for healthcare claims validation with both internal (Haskell) and external (text-based) syntax. Features GADT-based rules, comprehensive validation support, and business-friendly rule definitions.+category:       Healthcare+homepage:       https://github.com/nagashi/claims-x12-dsl#readme+bug-reports:    https://github.com/nagashi/claims-x12-dsl/issues+author:         Charles Ellis O'Riley Jr.+maintainer:     ceoriley@gmail.com+copyright:      2026 Charles Ellis O'Riley Jr.+license:        BSD-3-Clause+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/nagashi/claims-x12-dsl++library+  exposed-modules:+      Claims.Interpreter+      Claims.Parser+      Claims.Parser.AST+      Claims.Rules+      Claims.Types+      Lib+  other-modules:+      Paths_claims_x12_dsl+  autogen-modules:+      Paths_claims_x12_dsl+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+  build-depends:+      Decimal ==0.5.*+    , base >=4.7 && <5+    , containers >=0.6 && <0.8+    , parsec ==3.1.*+    , text >=1.2 && <2.2+    , time >=1.9 && <1.15+  default-language: Haskell2010++executable claims-x12-dsl-exe+  main-is: Main.hs+  other-modules:+      Paths_claims_x12_dsl+  autogen-modules:+      Paths_claims_x12_dsl+  hs-source-dirs:+      app+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      Decimal ==0.5.*+    , base >=4.7 && <5+    , claims-x12-dsl+    , containers >=0.6 && <0.8+    , parsec ==3.1.*+    , text >=1.2 && <2.2+    , time >=1.9 && <1.15+  default-language: Haskell2010++test-suite claims-x12-dsl-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_claims_x12_dsl+  autogen-modules:+      Paths_claims_x12_dsl+  hs-source-dirs:+      test+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      Decimal ==0.5.*+    , QuickCheck >=2.14 && <2.16+    , base >=4.7 && <5+    , claims-x12-dsl+    , containers >=0.6 && <0.8+    , hspec >=2.7 && <2.12+    , parsec ==3.1.*+    , text >=1.2 && <2.2+    , time >=1.9 && <1.15+  default-language: Haskell2010
+ src/Claims/Interpreter.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}++module Claims.Interpreter+  ( eval+  , validateClaim+  ) where++import Claims.Types++-- | Evaluate a rule against a claim+eval :: Claim -> Rule a -> a+eval claim rule = case rule of+  AmountGreaterThan amt -> totalAmount claim > amt+  AmountLessThan amt -> totalAmount claim < amt+  AmountBetween low high -> totalAmount claim >= low && totalAmount claim <= high+  +  HasDiagnosisCode code -> code `elem` diagnosisCodes claim+  HasProcedureCode code -> code `elem` procedureCodes claim+  +  IsClaimType ct -> claimType claim == ct+  PlaceOfServiceIs p -> placeOfService claim == p+  +  And r1 r2 -> eval claim r1 && eval claim r2+  Or r1 r2 -> eval claim r1 || eval claim r2+  Not r -> not (eval claim r)+  +  Reject msg -> Invalid msg+  Approve -> Valid+  RequireReview msg -> Invalid ("Review Required: " <> msg)+  +  If cond thenRule elseRule ->+    if eval claim cond+      then eval claim thenRule+      else eval claim elseRule++-- | Validate a claim against a list of rules+validateClaim :: Claim -> [Rule ValidationResult] -> [ValidationResult]+validateClaim claim rules = map (eval claim) rules
+ src/Claims/Parser.hs view
@@ -0,0 +1,228 @@+{-# 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 = P.makeTokenParser 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 = P.reserved lexer++reservedOp :: String -> Parser ()+reservedOp = P.reservedOp lexer++identifier :: Parser String+identifier = P.identifier lexer++stringLiteral :: Parser String+stringLiteral = P.stringLiteral lexer++float :: Parser Double+float = P.float lexer++natural :: Parser Integer+natural = P.natural lexer++whiteSpace :: Parser ()+whiteSpace = P.whiteSpace lexer++dot :: Parser String+dot = P.dot lexer++-- | Parse a complete rule+parseRule :: Parser ParsedRule+parseRule = do+  whiteSpace+  reserved "RULE"+  name <- identifier+  reserved "DESCRIPTION"+  desc <- stringLiteral+  reserved "WHEN"+  cond <- parseCondition+  reserved "THEN"+  act <- parseAction+  elseAct <- optionMaybe parseElseWhen+  reserved "END"+  return $ ParsedRule name desc cond act elseAct++-- | Parse ELSE WHEN clause+parseElseWhen :: Parser (Condition, Action)+parseElseWhen = do+  reserved "ELSE"+  reserved "WHEN"+  cond <- parseCondition+  reserved "THEN"+  act <- parseAction+  return (cond, act)++-- | Parse a condition expression+parseCondition :: Parser Condition+parseCondition = buildExpressionParser table term+  where+    table = +      [ [Prefix (reserved "NOT" >> return NotCond)]+      , [Infix (reserved "AND" >> return AndCond) AssocLeft]+      , [Infix (reserved "OR" >> return OrCond) AssocLeft]+      ]+    +    term = parens parseCondition+       <|> try parseAmountBetween+       <|> try parseAmountComparison+       <|> try parseHasDiagnosis+       <|> try parseHasProcedure+       <|> try parsePlaceOfService+       <|> try parseClaimType++parens :: Parser a -> Parser a+parens = P.parens lexer++-- | Parse amount comparison (e.g., claim.amount > 50000)+parseAmountComparison :: Parser Condition+parseAmountComparison = do+  reserved "claim"+  _ <- dot+  reserved "amount"+  op <- parseCompOp+  value <- try float <|> fmap fromInteger natural+  return $ CompareAmount op value++-- | Parse amount between (e.g., claim.amount BETWEEN 0 AND 100)+parseAmountBetween :: Parser Condition+parseAmountBetween = do+  reserved "claim"+  _ <- dot+  reserved "amount"+  reserved "BETWEEN"+  low <- try float <|> fmap fromInteger natural+  reserved "AND"+  high <- try float <|> fmap fromInteger natural+  return $ AmountBetween low high++-- | Parse has diagnosis code (e.g., claim.has_diagnosis "S06")+parseHasDiagnosis :: Parser Condition+parseHasDiagnosis = do+  reserved "claim"+  _ <- dot+  reserved "has_diagnosis"+  code <- stringLiteral+  return $ CheckDiagnosis code++-- | Parse has procedure code (e.g., claim.has_procedure "99221")+parseHasProcedure :: Parser Condition+parseHasProcedure = do+  reserved "claim"+  _ <- dot+  reserved "has_procedure"+  code <- stringLiteral+  return $ CheckProcedure code++-- | Parse place of service (e.g., claim.place_of_service = "23")+parsePlaceOfService :: Parser Condition+parsePlaceOfService = do+  reserved "claim"+  _ <- dot+  reserved "place_of_service"+  reservedOp "="+  pos <- stringLiteral+  return $ CheckPlaceOfService pos++-- | Parse claim type (e.g., claim.type = "Inpatient")+parseClaimType :: Parser Condition+parseClaimType = do+  reserved "claim"+  _ <- dot+  reserved "type"+  reservedOp "="+  ct <- stringLiteral+  return $ CheckClaimType ct++-- | Parse comparison operator+parseCompOp :: Parser CompOp+parseCompOp = +  (reservedOp ">=" >> return Gte)+  <|> (reservedOp "<=" >> return Lte)+  <|> (reservedOp ">" >> return Gt)+  <|> (reservedOp "<" >> return Lt)+  <|> (reservedOp "=" >> return Eq)++-- | Parse an action+parseAction :: Parser Action+parseAction = +  (reserved "APPROVE" >> return ApproveClaim)+  <|> (reserved "REJECT" >> RejectClaim <$> stringLiteral)+  <|> (reserved "REQUIRE_REVIEW" >> RequireReview <$> stringLiteral)++-- | Parse multiple rules from a file+parseRules :: String -> Either ParseError [ParsedRule]+parseRules input = parse (many parseRule <* eof) "" input++-- | Convert a parsed external DSL rule to an internal DSL rule+convertToInternalRule :: ParsedRule -> Rule ValidationResult+convertToInternalRule pr = +  case elseAction pr of+    Nothing -> T.If (convertCondition (conditions pr)) (convertAction (action pr)) T.approve+    Just (elseCond, elseAct) -> +      T.If (convertCondition (conditions pr)) +           (convertAction (action pr))+           (T.If (convertCondition elseCond) (convertAction elseAct) T.approve)++-- | Convert a parsed condition to an internal rule condition+convertCondition :: Condition -> Rule Bool+convertCondition cond = case cond of+  CompareAmount op value -> +    let amt = realFracToDecimal 2 value+        epsilon = realFracToDecimal 2 (0.01 :: Double)+    in case op of+      Gt -> T.greaterThan amt+      Lt -> T.lessThan amt+      Eq -> T.AmountGreaterThan amt `T.And` T.AmountLessThan (amt + epsilon)+      Gte -> T.greaterThan amt `T.Or` (T.AmountGreaterThan amt `T.And` T.AmountLessThan (amt + epsilon))+      Lte -> T.lessThan amt `T.Or` (T.AmountGreaterThan amt `T.And` T.AmountLessThan (amt + epsilon))+  AmountBetween low high -> T.between (realFracToDecimal 2 low) (realFracToDecimal 2 high)+  CheckDiagnosis code -> T.hasDx (pack code)+  CheckProcedure code -> T.hasPx (pack code)+  CheckPlaceOfService p -> T.pos (pack p)+  CheckClaimType ct -> T.isType (convertClaimType ct)+  AndCond c1 c2 -> convertCondition c1 `T.And` convertCondition c2+  OrCond c1 c2 -> convertCondition c1 `T.Or` convertCondition c2+  NotCond c -> T.Not (convertCondition c)++-- | Convert a parsed action to an internal rule action+convertAction :: Action -> Rule ValidationResult+convertAction act = case act of+  ApproveClaim -> T.approve+  RejectClaim msg -> T.reject (pack msg)+  RequireReview msg -> T.needsReview (pack msg)++-- | Convert a claim type string to ClaimType+convertClaimType :: String -> ClaimType+convertClaimType "Inpatient" = Inpatient+convertClaimType "Outpatient" = Outpatient+convertClaimType "Professional" = Professional+convertClaimType _ = Professional  -- default
+ src/Claims/Parser/AST.hs view
@@ -0,0 +1,39 @@+module Claims.Parser.AST+  ( ParsedRule(..)+  , Condition(..)+  , Action(..)+  , CompOp(..)+  ) where++-- | A parsed rule from the external DSL+data ParsedRule = ParsedRule+  { ruleName :: String+  , ruleDescription :: String+  , conditions :: Condition+  , action :: Action+  , elseAction :: Maybe (Condition, Action)+  } deriving (Show, Eq)++-- | Condition expressions in the external DSL+data Condition+  = CompareAmount CompOp Double+  | AmountBetween Double Double+  | CheckDiagnosis String+  | CheckProcedure String+  | CheckPlaceOfService String+  | CheckClaimType String+  | AndCond Condition Condition+  | OrCond Condition Condition+  | NotCond Condition+  deriving (Show, Eq)++-- | Comparison operators+data CompOp = Gt | Lt | Eq | Gte | Lte+  deriving (Show, Eq)++-- | Actions that can be taken on a claim+data Action+  = RejectClaim String+  | ApproveClaim+  | RequireReview String+  deriving (Show, Eq)
+ src/Claims/Rules.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE OverloadedStrings #-}++module Claims.Rules+  ( -- * Business Rules+    highValueClaimRule+  , erClaimRule+  , inpatientRule+  , complexRule+  , outpatientSurgeryRule+  , allRules+  ) where++import Claims.Types++-- | Rule 1: High-Value Claims Review+-- Business Logic: Any claim exceeding $50,000 requires manual review+highValueClaimRule :: Rule ValidationResult+highValueClaimRule = +  If (greaterThan 50000)+    (needsReview "High value claim exceeds $50,000")+    approve++-- | Rule 2: Emergency Room Validation+-- Business Logic: Emergency room claims (POS 23) must have appropriate +-- emergency diagnosis codes (head injury S06 or heart attack I21)+erClaimRule :: Rule ValidationResult+erClaimRule =+  If (pos "23" `And` Not (hasDx "S06" `Or` hasDx "I21"))+    (reject "ER claim without emergency diagnosis code")+    approve++-- | Rule 3: Inpatient Admission Codes+-- Business Logic: Inpatient claims must include one of the standard +-- admission procedure codes+inpatientRule :: Rule ValidationResult+inpatientRule =+  If (isType Inpatient `And` Not (hasPx "99221" `Or` hasPx "99222" `Or` hasPx "99223"))+    (reject "Inpatient claim missing admission procedure code")+    approve++-- | Rule 4: Complex Combination Rule+-- Business Logic: Professional claims over $10,000 in office settings +-- are handled differently based on whether they're preventive care +-- (which should be rejected) or other services (which need review)+complexRule :: Rule ValidationResult+complexRule =+  If (isType Professional `And` greaterThan 10000 `And` pos "11")+    (If (hasDx "Z00.00" `Or` hasDx "Z00.01")+      (reject "Preventive care should not exceed $10,000 in office setting")+      (needsReview "High-value professional claim in office"))+    approve++-- | Rule 5: Outpatient Surgery Validation+-- Business Logic: Outpatient surgical procedures (POS 24) should not +-- have amounts below $100, which likely indicates a billing error+outpatientSurgeryRule :: Rule ValidationResult+outpatientSurgeryRule =+  If (isType Outpatient `And` pos "24" `And` between 0 100)+    (reject "Outpatient surgical claim amount too low")+    approve++-- | All business rules combined+allRules :: [Rule ValidationResult]+allRules = +  [ highValueClaimRule+  , erClaimRule+  , inpatientRule+  , complexRule+  , outpatientSurgeryRule+  ]
+ src/Claims/Types.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}++module Claims.Types+  ( -- * Core Domain Types+    Claim(..)+  , ClaimType(..)+  , ValidationResult(..)+    -- * Rule Types+  , Rule(..)+    -- * Smart Constructors+  , greaterThan+  , lessThan+  , between+  , hasDx+  , hasPx+  , isType+  , pos+  , reject+  , approve+  , needsReview+  ) where++import Data.Text (Text)+import Data.Time (Day)+import Data.Decimal (Decimal)++-- | Represents a healthcare claim+data Claim = Claim+  { claimId :: Text+  , patientId :: Text+  , providerId :: Text+  , serviceDate :: Day+  , totalAmount :: Decimal+  , diagnosisCodes :: [Text]+  , procedureCodes :: [Text]+  , placeOfService :: Text+  , claimType :: ClaimType+  } deriving (Show, Eq)++-- | Types of healthcare claims+data ClaimType +  = Inpatient +  | Outpatient +  | Professional+  deriving (Show, Eq)++-- | Result of claim validation+data ValidationResult +  = Valid +  | Invalid Text+  deriving (Show, Eq)++-- | Rule expression GADT for type-safe DSL+data Rule a where+  -- Predicates+  AmountGreaterThan :: Decimal -> Rule Bool+  AmountLessThan :: Decimal -> Rule Bool+  AmountBetween :: Decimal -> Decimal -> Rule Bool+  +  HasDiagnosisCode :: Text -> Rule Bool+  HasProcedureCode :: Text -> Rule Bool+  +  IsClaimType :: ClaimType -> Rule Bool+  PlaceOfServiceIs :: Text -> Rule Bool+  +  -- Logical operators+  And :: Rule Bool -> Rule Bool -> Rule Bool+  Or :: Rule Bool -> Rule Bool -> Rule Bool+  Not :: Rule Bool -> Rule Bool+  +  -- Actions+  Reject :: Text -> Rule ValidationResult+  Approve :: Rule ValidationResult+  RequireReview :: Text -> Rule ValidationResult+  +  -- Control flow+  If :: Rule Bool -> Rule ValidationResult -> Rule ValidationResult -> Rule ValidationResult++-- | Smart constructor for amount greater than+greaterThan :: Decimal -> Rule Bool+greaterThan = AmountGreaterThan++-- | Smart constructor for amount less than+lessThan :: Decimal -> Rule Bool+lessThan = AmountLessThan++-- | Smart constructor for amount between range+between :: Decimal -> Decimal -> Rule Bool+between = AmountBetween++-- | Smart constructor for has diagnosis code+hasDx :: Text -> Rule Bool+hasDx = HasDiagnosisCode++-- | Smart constructor for has procedure code+hasPx :: Text -> Rule Bool+hasPx = HasProcedureCode++-- | Smart constructor for claim type check+isType :: ClaimType -> Rule Bool+isType = IsClaimType++-- | Smart constructor for place of service check+pos :: Text -> Rule Bool+pos = PlaceOfServiceIs++-- | Smart constructor for reject action+reject :: Text -> Rule ValidationResult+reject = Reject++-- | Smart constructor for approve action+approve :: Rule ValidationResult+approve = Approve++-- | Smart constructor for review action+needsReview :: Text -> Rule ValidationResult+needsReview = RequireReview
+ src/Lib.hs view
@@ -0,0 +1,17 @@+module Lib+  ( -- * Core Types+    module Claims.Types+    -- * Interpreter+  , module Claims.Interpreter+    -- * Rules+  , module Claims.Rules+    -- * Parser+  , parseRule+  , parseRules+  , convertToInternalRule+  ) where++import Claims.Types+import Claims.Interpreter+import Claims.Rules+import Claims.Parser (parseRule, parseRules, convertToInternalRule)
+ test/Spec.hs view
@@ -0,0 +1,181 @@+{-# LANGUAGE OverloadedStrings #-}++import Test.Hspec+import Test.QuickCheck+import Claims.Types+import Claims.Interpreter+import Claims.Rules+import Claims.Parser+import Claims.Parser.AST+import Data.Time (fromGregorian)+import Data.Decimal (realFracToDecimal)+import Data.Text (Text)++main :: IO ()+main = hspec $ do+  describe "Claims.Interpreter" $ do+    it "evaluates amount greater than correctly" $ do+      let claim = testClaim { totalAmount = realFracToDecimal 2 60000 }+      eval claim (greaterThan 50000) `shouldBe` True+      eval claim (greaterThan 70000) `shouldBe` False+    +    it "evaluates amount less than correctly" $ do+      let claim = testClaim { totalAmount = realFracToDecimal 2 40000 }+      eval claim (lessThan 50000) `shouldBe` True+      eval claim (lessThan 30000) `shouldBe` False+    +    it "evaluates amount between correctly" $ do+      let claim = testClaim { totalAmount = realFracToDecimal 2 50 }+      eval claim (between 0 100) `shouldBe` True+      eval claim (between 60 100) `shouldBe` False+    +    it "evaluates diagnosis code check correctly" $ do+      let claim = testClaim { diagnosisCodes = ["I21.0", "I25.10"] }+      eval claim (hasDx "I21.0") `shouldBe` True+      eval claim (hasDx "S06") `shouldBe` False+    +    it "evaluates procedure code check correctly" $ do+      let claim = testClaim { procedureCodes = ["99223", "93000"] }+      eval claim (hasPx "99223") `shouldBe` True+      eval claim (hasPx "99221") `shouldBe` False+    +    it "evaluates claim type correctly" $ do+      let claim = testClaim { claimType = Inpatient }+      eval claim (isType Inpatient) `shouldBe` True+      eval claim (isType Outpatient) `shouldBe` False+    +    it "evaluates place of service correctly" $ do+      let claim = testClaim { placeOfService = "21" }+      eval claim (pos "21") `shouldBe` True+      eval claim (pos "23") `shouldBe` False+    +    it "evaluates AND correctly" $ do+      let claim = testClaim { totalAmount = realFracToDecimal 2 60000, claimType = Inpatient }+      eval claim (greaterThan 50000 `And` isType Inpatient) `shouldBe` True+      eval claim (greaterThan 50000 `And` isType Outpatient) `shouldBe` False+    +    it "evaluates OR correctly" $ do+      let claim = testClaim { claimType = Inpatient }+      eval claim (isType Inpatient `Or` isType Outpatient) `shouldBe` True+      eval claim (isType Professional `Or` isType Outpatient) `shouldBe` False+    +    it "evaluates NOT correctly" $ do+      let claim = testClaim { claimType = Inpatient }+      eval claim (Not (isType Outpatient)) `shouldBe` True+      eval claim (Not (isType Inpatient)) `shouldBe` False+  +  describe "Claims.Rules" $ do+    it "highValueClaimRule triggers for claims over $50,000" $ do+      let claim = testClaim { totalAmount = realFracToDecimal 2 75000 }+      eval claim highValueClaimRule `shouldBe` Invalid "Review Required: High value claim exceeds $50,000"+    +    it "highValueClaimRule approves claims under $50,000" $ do+      let claim = testClaim { totalAmount = realFracToDecimal 2 40000 }+      eval claim highValueClaimRule `shouldBe` Valid+    +    it "erClaimRule rejects ER claims without emergency diagnosis" $ do+      let claim = testClaim { placeOfService = "23", diagnosisCodes = ["Z00.00"] }+      eval claim erClaimRule `shouldBe` Invalid "ER claim without emergency diagnosis code"+    +    it "erClaimRule approves ER claims with emergency diagnosis" $ do+      let claim = testClaim { placeOfService = "23", diagnosisCodes = ["I21"] }+      eval claim erClaimRule `shouldBe` Valid+    +    it "inpatientRule rejects inpatient claims without admission code" $ do+      let claim = testClaim { claimType = Inpatient, procedureCodes = ["93000"] }+      eval claim inpatientRule `shouldBe` Invalid "Inpatient claim missing admission procedure code"+    +    it "inpatientRule approves inpatient claims with admission code" $ do+      let claim = testClaim { claimType = Inpatient, procedureCodes = ["99223", "93000"] }+      eval claim inpatientRule `shouldBe` Valid+    +    it "outpatientSurgeryRule rejects low-value outpatient surgery claims" $ do+      let claim = testClaim { claimType = Outpatient, placeOfService = "24", totalAmount = realFracToDecimal 2 50 }+      eval claim outpatientSurgeryRule `shouldBe` Invalid "Outpatient surgical claim amount too low"+    +    it "outpatientSurgeryRule approves normal outpatient surgery claims" $ do+      let claim = testClaim { claimType = Outpatient, placeOfService = "24", totalAmount = realFracToDecimal 2 500 }+      eval claim outpatientSurgeryRule `shouldBe` Valid+  +  describe "Claims.Parser" $ do+    it "parses a simple APPROVE rule" $ do+      let input = unlines+            [ "RULE SimpleApprove"+            , "DESCRIPTION \"Always approve\""+            , "WHEN"+            , "  claim.amount < 1000"+            , "THEN"+            , "  APPROVE"+            , "END"+            ]+      case parseRules input of+        Left err -> expectationFailure $ "Parse error: " ++ show err+        Right [rule] -> do+          Claims.Parser.AST.ruleName rule `shouldBe` "SimpleApprove"+          ruleDescription rule `shouldBe` "Always approve"+          Claims.Parser.AST.action rule `shouldBe` ApproveClaim+        Right _ -> expectationFailure "Expected exactly one rule"+    +    it "parses a REJECT rule with amount comparison" $ do+      let input = unlines+            [ "RULE HighValueReject"+            , "DESCRIPTION \"Reject high value claims\""+            , "WHEN"+            , "  claim.amount > 100000"+            , "THEN"+            , "  REJECT \"Amount too high\""+            , "END"+            ]+      case parseRules input of+        Left err -> expectationFailure $ "Parse error: " ++ show err+        Right [rule] -> do+          Claims.Parser.AST.action rule `shouldBe` RejectClaim "Amount too high"+        Right _ -> expectationFailure "Expected exactly one rule"+    +    it "parses a rule with AND condition" $ do+      let input = unlines+            [ "RULE ComplexRule"+            , "DESCRIPTION \"Complex condition\""+            , "WHEN"+            , "  claim.amount > 5000 AND claim.place_of_service = \"23\""+            , "THEN"+            , "  REQUIRE_REVIEW \"Needs review\""+            , "END"+            ]+      case parseRules input of+        Left err -> expectationFailure $ "Parse error: " ++ show err+        Right [rule] -> do+          case Claims.Parser.AST.conditions rule of+            AndCond _ _ -> return ()+            _ -> expectationFailure "Expected AND condition"+        Right _ -> expectationFailure "Expected exactly one rule"+    +    it "parses a rule with diagnosis code check" $ do+      let input = unlines+            [ "RULE DiagnosisCheck"+            , "DESCRIPTION \"Check diagnosis\""+            , "WHEN"+            , "  claim.has_diagnosis \"I21\""+            , "THEN"+            , "  APPROVE"+            , "END"+            ]+      case parseRules input of+        Left err -> expectationFailure $ "Parse error: " ++ show err+        Right [rule] -> do+          Claims.Parser.AST.conditions rule `shouldBe` CheckDiagnosis "I21"+        Right _ -> expectationFailure "Expected exactly one rule"++-- | Test claim helper+testClaim :: Claim+testClaim = Claim+  { claimId = "TEST001"+  , patientId = "PAT001"+  , providerId = "PRV001"+  , serviceDate = fromGregorian 2025 1 1+  , totalAmount = realFracToDecimal 2 1000+  , diagnosisCodes = []+  , procedureCodes = []+  , placeOfService = "11"+  , claimType = Professional+  }