{-# 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
  { Claim -> Text
claimId :: Text
  , Claim -> Text
patientId :: Text
  , Claim -> Text
providerId :: Text
  , Claim -> Day
serviceDate :: Day
  , Claim -> Decimal
totalAmount :: Decimal
  , Claim -> [Text]
diagnosisCodes :: [Text]
  , Claim -> [Text]
procedureCodes :: [Text]
  , Claim -> Text
placeOfService :: Text
  , Claim -> ClaimType
claimType :: ClaimType
  } deriving (Int -> Claim -> ShowS
[Claim] -> ShowS
Claim -> String
(Int -> Claim -> ShowS)
-> (Claim -> String) -> ([Claim] -> ShowS) -> Show Claim
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Claim -> ShowS
showsPrec :: Int -> Claim -> ShowS
$cshow :: Claim -> String
show :: Claim -> String
$cshowList :: [Claim] -> ShowS
showList :: [Claim] -> ShowS
Show, Claim -> Claim -> Bool
(Claim -> Claim -> Bool) -> (Claim -> Claim -> Bool) -> Eq Claim
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Claim -> Claim -> Bool
== :: Claim -> Claim -> Bool
$c/= :: Claim -> Claim -> Bool
/= :: Claim -> Claim -> Bool
Eq)

-- | Types of healthcare claims
data ClaimType 
  = Inpatient 
  | Outpatient 
  | Professional
  deriving (Int -> ClaimType -> ShowS
[ClaimType] -> ShowS
ClaimType -> String
(Int -> ClaimType -> ShowS)
-> (ClaimType -> String)
-> ([ClaimType] -> ShowS)
-> Show ClaimType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClaimType -> ShowS
showsPrec :: Int -> ClaimType -> ShowS
$cshow :: ClaimType -> String
show :: ClaimType -> String
$cshowList :: [ClaimType] -> ShowS
showList :: [ClaimType] -> ShowS
Show, ClaimType -> ClaimType -> Bool
(ClaimType -> ClaimType -> Bool)
-> (ClaimType -> ClaimType -> Bool) -> Eq ClaimType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClaimType -> ClaimType -> Bool
== :: ClaimType -> ClaimType -> Bool
$c/= :: ClaimType -> ClaimType -> Bool
/= :: ClaimType -> ClaimType -> Bool
Eq)

-- | Result of claim validation
data ValidationResult 
  = Valid 
  | Invalid Text
  deriving (Int -> ValidationResult -> ShowS
[ValidationResult] -> ShowS
ValidationResult -> String
(Int -> ValidationResult -> ShowS)
-> (ValidationResult -> String)
-> ([ValidationResult] -> ShowS)
-> Show ValidationResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValidationResult -> ShowS
showsPrec :: Int -> ValidationResult -> ShowS
$cshow :: ValidationResult -> String
show :: ValidationResult -> String
$cshowList :: [ValidationResult] -> ShowS
showList :: [ValidationResult] -> ShowS
Show, ValidationResult -> ValidationResult -> Bool
(ValidationResult -> ValidationResult -> Bool)
-> (ValidationResult -> ValidationResult -> Bool)
-> Eq ValidationResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValidationResult -> ValidationResult -> Bool
== :: ValidationResult -> ValidationResult -> Bool
$c/= :: ValidationResult -> ValidationResult -> Bool
/= :: ValidationResult -> ValidationResult -> Bool
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 :: Decimal -> Rule Bool
greaterThan = Decimal -> Rule Bool
AmountGreaterThan

-- | Smart constructor for amount less than
lessThan :: Decimal -> Rule Bool
lessThan :: Decimal -> Rule Bool
lessThan = Decimal -> Rule Bool
AmountLessThan

-- | Smart constructor for amount between range
between :: Decimal -> Decimal -> Rule Bool
between :: Decimal -> Decimal -> Rule Bool
between = Decimal -> Decimal -> Rule Bool
AmountBetween

-- | Smart constructor for has diagnosis code
hasDx :: Text -> Rule Bool
hasDx :: Text -> Rule Bool
hasDx = Text -> Rule Bool
HasDiagnosisCode

-- | Smart constructor for has procedure code
hasPx :: Text -> Rule Bool
hasPx :: Text -> Rule Bool
hasPx = Text -> Rule Bool
HasProcedureCode

-- | Smart constructor for claim type check
isType :: ClaimType -> Rule Bool
isType :: ClaimType -> Rule Bool
isType = ClaimType -> Rule Bool
IsClaimType

-- | Smart constructor for place of service check
pos :: Text -> Rule Bool
pos :: Text -> Rule Bool
pos = Text -> Rule Bool
PlaceOfServiceIs

-- | Smart constructor for reject action
reject :: Text -> Rule ValidationResult
reject :: Text -> Rule ValidationResult
reject = Text -> Rule ValidationResult
Reject

-- | Smart constructor for approve action
approve :: Rule ValidationResult
approve :: Rule ValidationResult
approve = Rule ValidationResult
Approve

-- | Smart constructor for review action
needsReview :: Text -> Rule ValidationResult
needsReview :: Text -> Rule ValidationResult
needsReview = Text -> Rule ValidationResult
RequireReview