moduleParse(DocTest(..),Interaction(..),getDocTests-- * exported for testing,parse)whereimportData.Char(isSpace)importData.ListimportData.Maybe(fromMaybe)importExtractdataDocTest=DocExample{moduleName::String,interactions::[Interaction]}deriving(Eq,Show)dataInteraction=Interaction{expression::String-- ^ example expression,result::[String]-- ^ expected result}deriving(Eq,Show)-- |-- Extract 'DocTest's from all given modules and all modules included by the-- given modules.getDocTests::[String]-- ^ List of GHC flags->[String]-- ^ File or module names->IO[DocTest]-- ^ Extracted 'DocTest'sgetDocTestsflagsmodules=domods<-extractflagsmodulesreturn(concatMapmoduleToDocTestmods)-- | Convert a `Module` to a list of `DocTest`s.moduleToDocTest::Module->[DocTest]moduleToDocTest(Modulenamedocs)=(map(DocExamplename).filter(not.null).mapparse)docs-- | Extract all interactions from given Haddock documentation.parse::String->[Interaction]parseinput=go(map(reverse.dropWhile((==)'\r').reverse)$linesinput)whereisPrompt=isPrefixOf">>>".dropWhileisSpaceisBlankLine=null.dropWhileisSpaceisEndOfInteractionx=isPromptx||isBlankLinexgo::[String]->[Interaction]goxs=casedropWhile(not.isPrompt)xsofprompt:rest->let(ys,zs)=breakisEndOfInteractionrestintoInteractionpromptys:gozs_->[]-- | Create an `Interaction`, strip superfluous whitespace as appropriate.toInteraction::String->[String]->InteractiontoInteractionxxs=Interaction(strip$drop3e)-- we do not care about leading and trailing-- whitespace in expressions, so drop themresult_where-- 1. drop trailing whitespace from the prompt, remember the prefix(prefix,e)=spanisSpacex-- 2. drop, if possible, the exact same sequence of whitespace-- characters from each result line---- 3. interpret lines that only contain the string "<BLANKLINE>" as an-- empty lineresult_=map(substituteBlankLine.tryStripPrefixprefix)xswheretryStripPrefixpreys=fromMaybeys$stripPrefixpreyssubstituteBlankLine"<BLANKLINE>"=""substituteBlankLineline=line-- | Remove leading and trailing whitespace.strip::String->Stringstrip=dropWhileisSpace.reverse.dropWhileisSpace.reverse