Researchers are not usually able to state formally the design of a clinical trial. We will soon see clinical trials possibly written by large language models, of drugs possibly designed by unexplainable artificial intelligence: developing clinical trials is a business that moves large quantities of money and it is difficult to safeguard. It becomes critical to be able to impose a structure to these trials, a structure that helps us align them with the public interest.
This repository is an experiment on structuring a clinical trial as an element of a free monad: it tries to convert the problem of designing clinical trials into a software engineering problem. Not because we will run a trial as if it were a computer program, but because we want a structured logical description of the trial that is more resilient to reality than any software that implements it. We need a rich expressive language and a way of handling this structure; hiding or ignoring structure has, so far, only led to poor software.
Errors are modularly handled by monad morphisms. An interpretation into the IO monad is provided, but it is not the final goal of this description.
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Use newtype instead of data" #-}
{-# HLINT ignore "Use if" #-}
module ProtocolsRunOnTrials where
import Control.Monad.Free
import Control.Monad
import Control.Monad.Loops
import Data.List (isInfixOf)
import Data.Maybe (maybeToList)
-- Forms as a free monad.
type Form a = Free Question a
data Question y
= Consent { consent :: Maybe Bool -> y }
| DrugsTaken { nothing :: y , drug :: [Drug] -> y }
| AdverseEffectClass { aeMinor :: y, aeMajor :: y, aeNo :: y }
| AdverseEffectName { aeName :: AdverseEffect -> y }
| AdverseEffectNarrative { aeNarrative :: String -> y }
deriving (Functor)
data Drug = Loratadine | Montelukast | Cetirizine deriving Show
data AdverseEffectClass = AEMinor | AEMajor | AENone deriving Show
data AdverseEffect = Headache | Depression | Unclassified deriving Show
drugsForm :: Form [Drug]
drugsForm = ask $ DrugsTaken
{ drug = \d -> do
rest <- drugsForm
return (d ++ rest)
, nothing = return [] }
inclusionForm :: Form (Bool, [Drug])
inclusionForm = do
c <- askConsent
case c of
(Just True) -> do { d <- drugsForm ; return (True, d) }
(Just False) -> do { return (False,[]) }
Nothing -> do { return (False,[]) }
askAdverseEffectClass :: Form AdverseEffectClass
askAdverseEffectClass = liftF $ AdverseEffectClass AEMinor AEMajor AENone
askAdverseEffectName :: Form AdverseEffect
askAdverseEffectName = liftF $ AdverseEffectName id
askAdverseEffectNarrative :: Form String
askAdverseEffectNarrative = liftF $ AdverseEffectNarrative id
type Narrative = String
adverseEffectForm :: Form (AdverseEffectClass, Maybe (AdverseEffect, Narrative))
adverseEffectForm = do
aeclass <- askAdverseEffectClass
case aeclass of
AEMajor -> pure (AEMajor, Nothing)
AEMinor -> do
aename <- askAdverseEffectName
aenarrative <- askAdverseEffectNarrative
return (aeclass, Just (aename, aenarrative))
AENone -> pure (AENone, Nothing)
-- Clinical trial as a free monad
data Clinical y = InvalidBool (Bool -> y) | InvalidDrug ([Drug] -> y) | InvalidAdverseEffect (AdverseEffect -> y) | Concern String y | PutString String y | GetString (String -> y) deriving (Functor)
type ClinicalTrial a = Free Clinical a
-- Handling errors from the form during design of the clinical trial.
questionYesNo :: String -> ClinicalTrial (Maybe Bool)
questionYesNo questionString = do
putString questionString
s <- getString
case s of
"Yes" -> return (Just True)
"No" -> return (Just False)
_ -> return Nothing
runsForm :: Form a -> ClinicalTrial a
runsForm (Pure a) = pure a
runsForm (Free (Consent cmaybebool)) = do
b <- questionYesNo "Do you consent to participate in this study?"
runsForm (cmaybebool b)
runsForm (Free (DrugsTaken dtno dtls)) = do
putString "Are you taking any other drugs? If so, give the name."
drug <- getString
case drug of
"No" -> runsForm dtno
"Loratadine" -> runsForm (dtls [Loratadine])
"Montelukast" -> runsForm (dtls [Montelukast])
"Cetirizine" -> runsForm (dtls [Cetirizine])
_ -> do
d <- invalidDrug
runsForm (dtls d)
runsForm (Free (AdverseEffectClass aeminor aemajor aeno)) = do
b <- questionYesNo "Are you reporting an adverse event?"
case b of
Just True -> do
b <- iterateWhile (== Nothing) $ questionYesNo "Are you reporting a MAJOR/unexpected adverse event?"
case b of
Just True -> runsForm aemajor
Just False -> runsForm aeminor
Nothing -> do
concern "Possible adverse event was not reported. Question was not answered."
runsForm aeno
Just False -> runsForm aeno
Nothing -> runsForm aeno
runsForm (Free (AdverseEffectName aename)) = do
putString "What is the classification of the adverse event?"
classification <- getString
case classification of
"Headache" -> runsForm (aename Headache)
"Depression" -> runsForm (aename Depression)
_ -> runsForm (aename Unclassified)
runsForm (Free (AdverseEffectNarrative aenarrative)) = do
putString "Please describe the adverse event."
narrative <- getString
runsForm (aenarrative narrative)
exampleClinicalTrial :: ClinicalTrial (Bool, [Drug], [(AdverseEffect, String)])
exampleClinicalTrial = do
(consent, concomitantMedication) <- runsForm inclusionForm
if consent then do
(aeclass, maybeAdverseEffectAndNarrative) <- runsForm adverseEffectForm
aeList <- maybeToList <$> clinicalAdverseEventCollection
return (consent, concomitantMedication, aeList)
else
return (False, [], [])
clinicalAdverseEventCollection :: ClinicalTrial (Maybe (AdverseEffect, String))
clinicalAdverseEventCollection = do
(aeclass, maybeAdverseEffectAndNarrative) <- runsForm adverseEffectForm
case (aeclass, maybeAdverseEffectAndNarrative) of
(AEMajor, _) -> do
concern "Major adverse effect has been raised"
return $ Just (Unclassified, "")
(AEMinor, Just (Unclassified, aenarrative)) ->
if "Headache" `isInfixOf` aenarrative || "headache" `isInfixOf` aenarrative
then return $ Just (Headache, aenarrative)
else return $ Just (Unclassified, aenarrative)
(AEMinor, Just (aename, aenarrative)) -> do
return $ Just (aename, aenarrative)
(AEMinor, Nothing) -> do
return $ Just (Unclassified, "No description provided.")
(AENone, _) -> return Nothing
-- Handling errors from the form on execution.
interpretTrial :: ClinicalTrial a -> IO a
interpretTrial (Free (PutString s y)) = do
putStrLn s
interpretTrial y
interpretTrial (Free (GetString f)) = do
s <- getLine
interpretTrial (f s)
interpretTrial (Free (InvalidBool g)) = do
raise "missing boolean, set to False."
interpretTrial (g True)
interpretTrial (Free (InvalidDrug d)) = do
raise "missing drug, not registered in the list. Please ask the participant again."
interpretTrial (d [])
interpretTrial (Free (InvalidAdverseEffect a)) = do
raise "missing adverse effect. Recorded as unclassified. Please ask nurses for report."
interpretTrial (a Unclassified)
interpretTrial (Free (Concern s y)) = do
putStrLn $ "Clinical concern raised: " ++ s
interpretTrial y
interpretTrial (Pure a) = pure a
--Boilerplate
putString :: String -> ClinicalTrial ()
putString xs = liftF $ PutString xs ()
getString :: ClinicalTrial String
getString = liftF $ GetString id
invalidBool :: ClinicalTrial Bool
invalidBool = liftF $ InvalidBool id
invalidAdverseEffect :: ClinicalTrial AdverseEffect
invalidAdverseEffect = liftF $ InvalidAdverseEffect id
invalidDrug :: ClinicalTrial [Drug]
invalidDrug = liftF $ InvalidDrug id
askConsent :: Form (Maybe Bool)
askConsent = liftF $ Consent id
concern :: String -> ClinicalTrial ()
concern s = liftF $ Concern s ()
ask :: f (Free f y) -> Free f y
ask = Free
end :: Free f ()
end = Pure ()
raise :: String -> IO ()
raise s = putStrLn $ "#WARNING RAISED: " ++ sTags: clinical trial, Haskell, free monad.