count   :: Eq a => a -> [a] -> Int
count x =  length . filter (==x)

cost :: Operation  a -> Integer
cost (Removed Arm)   =  5000
cost (Attached Arm)  = 15000
cost (Removed Hand)  =  2000
cost (Attached Hand) =  8000
cost (Removed Leg)   = 12000
cost (Attached Leg)  = 20000

type Cost             = Integer
type SSN              = Text
data Limb             = Arm | Hand | Leg deriving (Show,Eq)
data PatientStatus    = NewPatient                                    |
                        PatientAdmitted Integer [Operation Limb]      |
                        PatientReleased                               |
                        PatientDeceased
                    deriving (Show,Eq)
data Operation a      = Removed a | Attached a deriving (Show,Eq)
data Event a          = Operation a | Release | Deceased deriving (Show,Eq)
data Action           = SendBill | SendCondolences

instance MealyInstance SSN PatientStatus (Event Limb) Action

transition (NewPatient, op@(Operation a)) = PatientAdmitted (cost op) [op]

transition (PatientAdmitted bill oes, Removed l)
    | count (Removed l) oes > 1 = error "Cannot remove limb that's not there anymore!"
    | otherwise                 = let newbill = bill + cost (Removed l) in
        (PatientAdmitted newbill $ Removed l : oes, [SendCondolences])

transition (PatientAdmitted bill oes, Attached l)
	| isNothing (find (Removed l) oes) = error "Cannot attach limb, there is no space!"
	| otherwise                        = let newbill = bill + cost (Removed l) in
	    (PatientAdmitted newbill (Attached l) : oes, [])

transition (PatientAdmitted bill _oes, Release)  = (PatientReleased, [SendBill bill])
transition (PatientAdmitted bill _oes, Deceased) = (PatientDeceased, [SendCondolences, SendBill bill])

transition (NewPatient,      _)                  = error "Patients are neither allowed to leave nor to die here before an operation"
transition (PatientDeceased, _)                  = error "Operations on dead patients are not billable"


effects :: Msg a -> IO Bool
effects SendCondolences    = putStrLn "not implemented" >> return True
effects SendBill bill      = charge bill :: IO Bool